Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

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

Search the Archive

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];


  • Prev by Date: Re: FindRoot cannot find obvious solution
  • Next by Date: reviving mathematica afte update to SuSE Linux 9.1
  • Previous by thread: got "Map" to work finally.
  • Next by thread: Maclaurin Series