Re: got "Map" to work finally.
- To: mathgroup at smc.vnet.net
- Subject: [mg48128] Re: got "Map" to work finally.
- From: sean_incali at yahoo.com (sean kim)
- Date: Fri, 14 May 2004 00:12:26 -0400 (EDT)
- References: <c7utvb$qdk$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
actually, i answered my own question.
as the function was defined, it was as simple as changing the
plotLabel-> label to PlotLabel-> {label, np1, nc0}
that did the trick.
sean_incali at yahoo.com (sean kim) wrote in message news:<c7utvb$qdk$1 at smc.vnet.net>...
> 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];