Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

got "Map" to work finally.

• To: mathgroup at smc.vnet.net
• Subject: [mg48113] got "Map" to work finally.
• From: sean_incali at yahoo.com (sean kim)
• Date: Thu, 13 May 2004 00:09:08 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

hello Group, 

i finally got the Map to work properly as I wished. 

i have defined a function that solves, and plots two systems of ODE's
and i have mapped that function to a lists of parameters.

so the general construct is 
 
sol[{np1_, nc0_}] :=
  Module[{}, 
       odesystems...
       parameters...
       initial conditions...
       NDSOlve...
       functions for plotting...
         plotgraph[sol_labbel_]:= 
           Module[{},
                plot the graphs];
         plotzoom[sol_, label_] := 
            Module[{}
                plot the graphs but zoom in];
       DisplayTogetherArray[plotgraph, plotzoom]
         ];

now i define the list to map above sol function over as... 

prob = Table[i, {i, 0.1, 0.5, 0.05}];
init = Table[j, {j, 1, 5, 1}];
iplist = Partition[Outer[List, prob, init] // Flatten, 2];
Map[sol, iplist];


now the problem is to label the graphs with the elements of iplist
which are...

iplist = {{0.1, 1}, {0.1, 2}, {0.1, 3}, {0.1, 4}, {0.1, 5}, {0.15, 1},
{0.15, 2}, {0.15, 3}, {0.15, 4}, {0.15, 5}, {0.2, 1}, {0.2, 2}, {0.2,
3}, {0.2, 4}, {0.2, 5}, {0.25, 1}, {0.25, 2}, {0.25, 3}, {0.25, 4},
{0.25, 5}, {0.3, 1}, {0.3, 2}, {0.3, 3}, {0.3, 4}, {0.3, 5}, {0.35,
1}, {0.35, 2}, {0.35, 3}, {0.35, 4}, {0.35, 5}, {0.4, 1}, {0.4, 2},
{0.4, 3}, {0.4, 4}, {0.4, 5}, {0.45, 1}, {0.45, 2}, {0.45, 3}, {0.45,
4}, {0.45, 5}, {0.5, 1}, {0.5, 2}, {0.5, 3}, {0.5, 4}, {0.5, 5}}


I want to label and show each graphs the sol function and map
generates with each of the elements from the iplist.  like...

prob 0.1, init 1 for the first graph, 
then prob 0.1, init 2, for the second graph, 
then prob 0.1, init 3, for the third graph,
....
prob 0.5, init3,
prob 0.5, init4,
prob 0.5, init5.

how do I do that? 

Also as many of you wil notice immediately, I'm using two modules in a
Module, is that ok to do that? it seems like Mathematica isn't complaining.


below is the actual code i used. 


In[169]:=

ClearAll["Global`*"]
Off[General::"spell1"]
Off[General::"spell"]

<<Graphics`Graphics`
<<Graphics`Legend`
<<Graphics`Colors`

sol[{np1_,nc0_}]:= Module[{}, 

odesys = {
c11'[t]==k0 c0-p1 k1 c11[t]-p2 k2 c11[t], 
c12'[t]==2 p1 k1 c11[t]-p1 k1 c12[t]-p2 k2 c12[t], 
c13'[t]==2 p1 k1 c12[t]-p1 k1 c13[t]-p2 k2 c13[t], 
c14'[t]==2 p1 k1 c13[t]-p1 k1 c14[t]-p2 k2 c14[t], 
c15'[t]==2 p1 k1 c14[t]-kdeg1 c15[t], 
c2'[t]==2 p2 k2 c11[t]+2 p2 k2 c12[t]+2 p2 k2 c13[t]+2 p2 k2 c14[t]-k3
c2[t],
c3'[t]==k3 c2[t]-kdeg c3[t]
};

modesys = {
c11'[t]==k0 c0-p1 k1 c11[t]-p2 k2 c11[t], 
c12'[t]==2 p1 k1 c11[t]-p1 k1 c12[t]-p2 k2 c12[t], 
c13'[t]==2 p1 k1 c12[t]-p1 k1 c13[t]-p2 k2 c13[t], 
c14'[t]==2 p1 k1 c13[t]-p1 k1 c14[t]-p2 k2 c14[t], 
c15'[t]==2 p1 k1 c14[t]-kdeg1 c15[t], 
c2'[t]==2 p2 k2 c11[t]+2 p2 k2 c12[t]+2 p2 k2 c13[t]+2 p2 k2 c14[t]+
k22 c2[t]-k3 c2[t],
c3'[t]==k3 c2[t]-kdeg c3[t]};
      
var ={c11[t],c12[t],c13[t],c14[t],c15[t],c2[t],c3[t]};
np= {k0-> 1/6, k1-> 1, k2-> 1, k3-> 1, kdeg-> 1/4,kdeg1-> 1/4};
npm = {k0-> 1/6, k1-> 1, k2-> 1/2, k3-> 2, kdeg-> 1/4,kdeg1-> 1/4,
k22-> 1};
      
nodesys = odesys/.np;
nodesysm = modesys/.npm;
      
p1=np1;
p2=1-p1;
c0= nc0;
      
ics = {c11[0]==0, c12[0]==0,c13[0]==0,c14[0]==0, c15[0]==0,c2[0]==0,
c3[0]==0};
icsd = {c11[t]==0, c12[t]==0,c13[t]==0,c14[t]==0, c15[t]==0,c2[t]==0,
c3[t]==0};
      
sys = Join[nodesys, ics];
sysm =  Join[nodesysm, ics];
      
soln = NDSolve[sys, {c11[t],c12[t],c13[t],c14[t],c15[t],c2[t],c3[t]},
{t, 0, 20}];
solnm = NDSolve[sysm,
{c11[t],c12[t],c13[t],c14[t],c15[t],c2[t],c3[t]}, {t, 0, 20}];
      
plotgraph[sol_, label_]:= Module[{},

Plot[Evaluate[{c0, c11[t],c12[t],c13[t],c14[t],c15[t],
c11[t]+c12[t]+c13[t]+c14[t]+c15[t],c2[t],c3[t]}/.sol],{t, 0, 20},
PlotRange -> {0, 10}, PlotLabel -> label, 
PlotStyle -> {
{AbsoluteThickness[1.5], RGBColor[0,0,0], Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0,0,1], Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.3,0.5,1],
Dashing[{0.01}]},{AbsoluteThickness[1.5], RGBColor[0.5,0.5,1],
Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.7,0.5,1], Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.9,0.5,1], Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.9,0.5,0.5]},
{AbsoluteThickness[1.5], RGBColor[1,0,0.5]}, 
{AbsoluteThickness[1.5], RGBColor[0.8,0,0.8]} }, 
PlotLegend -> {"c0", c11,c12,c13,c14,c15,c1tot,c2,c3}, 
LegendPosition ->{1.0,-.5}, LegendShadow ->{.001,-.001}]
];
      
plotzoom[sol_, label_]:= Module[{},

Plot[Evaluate[{c0, c11[t],c12[t],c13[t],c14[t],c15[t],
c11[t]+c12[t]+c13[t]+c14[t]+c15[t],c2[t],c3[t]}/.sol],{t, 0, 20},
PlotRange ->  {{0, 7}, {0, 5}}, PlotLabel-> label, 
PlotStyle -> {
{AbsoluteThickness[1.5],RGBColor[0,0,0], Dashing[{0.01}]},
{AbsoluteThickness[1.5],RGBColor[0,0,1], Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.3,0.5,1], Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.5,0.5,1],
Dashing[{0.01}]},{AbsoluteThickness[1.5], RGBColor[0.7,0.5,1],
Dashing[{0.01}]},
{AbsoluteThickness[1.5], RGBColor[0.9,0.5,1], Dashing[{0.01}]}, 
{AbsoluteThickness[1.5],RGBColor[0.9,0.5,0.5]}, 
{AbsoluteThickness[1.5], RGBColor[1,0,0.5]}, 
{AbsoluteThickness[1.5], RGBColor[0.8,0,0.8]}}, 
PlotLegend -> {"c0", c11,c12,c13,c14,c15,c1tot,c2,c3}, 
LegendPosition ->{1.0,-.5},LegendShadow ->{.001,-.001}]
];
      
DisplayTogetherArray[
{plotgraph[soln, "system1 "], plotgraph[solnm, "system2"]}, 
{plotzoom[soln, "system1"], plotzoom[solnm, "system2"]}, 
ImageSize-> 1000];
      
];

prob = Table[i,{i,0.1, 0.5, 0.05}];
init = Table[j,{j, 1, 5, 1}];
iplist = Partition[Outer[List, prob, init]//Flatten, 2]
Map[sol, iplist];