Re: plot thousands(?) of trajectories in single graph.
- To: mathgroup at smc.vnet.net
- Subject: [mg50596] Re: [mg50489] plot thousands(?) of trajectories in single graph.
- From: sean kim <sean_incali at yahoo.com>
- Date: Sat, 11 Sep 2004 06:45:14 -0400 (EDT)
- Reply-to: sean_incali at yahoo.com
- Sender: owner-wri-mathgroup at wolfram.com
Hi Bob.
I have tried this for few times now, but I just can;t
seem to get the array thing to work...
it will display blank graphics...
DisplayTogetherArray[
Partition[
Table[
Plot[
Evaluate[ndsoln[[k]]],
{t, 0, 250},
PlotRange -> All,
PlotStyle -> ps[[k]],
PlotLabel -> StyleForm[ expr[[k]],
FontColor -> ps[[k]],
FontFamily -> "Helvetica",
FontWeight -> "Bold",
FontSize -> 12]], {k, 4}], 2],
ImageSize -> 500];
I tought I wold be clever and do Show...
but that just brings back two blank graphics.
Show[
DisplayTogetherArray[
Partition[
Table[
Plot[
Evaluate[ndsoln[[k]]],
{t, 0, 250},
PlotRange -> All,
PlotStyle -> ps[[k]],
PlotLabel -> StyleForm[ expr[[k]],
FontColor -> ps[[k]],
FontFamily -> "Helvetica",
FontWeight -> "Bold",
FontSize -> 12]], {k, 4}], 2],
ImageSize -> 500];
]
So I thought I need to add displayfunction statements
Show[
DisplayTogetherArray[ Partition[ Table[ Plot[
Evaluate[ndsoln[[k]]], {t, 0, 250}, PlotRange -> All,
PlotStyle -> ps[[k]], DisplayFunction -> Identity,
PlotLabel -> StyleForm[ expr[[k]], FontColor ->
ps[[k]], FontFamily -> "Helvetica", FontWeight ->
"Bold", FontSize -> 12], DisplayFunction ->
$DisplayFunction], {k, 4}], 2], ImageSize -> 500]
];
still nothing...
Maybe it's some type of modification setting you have
that i don't?
thanks in advance for any insights
sean
--- Bob Hanlon <hanlonr at cox.net> wrote:
> I recommend that you break it into an array of four
> plots. Increase the value
> of n for more cases of each plot.
>
> Needs["Graphics`"];
>
> n=20;
> expr={a[t],b[t],x[t],y[t]};
> ps = {RGBColor[0,0,0],RGBColor[.7,0,0],
> RGBColor[0,.7,0],RGBColor[0,0,.7]};
> ndsoln = Transpose[
> Table[(
> k1=Random[Real,{1/10,5/10}];
> k2=Random[Real,{1/20,5/20}];
> expr /.NDSolve[{
> a'[t]==-k1 a[t] x[t],
> b'[t]==-k2 b[t] y[t],
> x'[t]==-k1 a[t] x[t]+k2 b[t] y[t],
> y'[t]==k1 a[t] x[t]-k2 b[t] y[t],
> a[0]==1,
> b[0]==1,
> x[0]==1,
> y[0]==0},
> {a,b,x,y},
> {t,0,250}][[1]]),
> {k,n}]];
> DisplayTogetherArray[
> Partition[
> Table[
> Plot[
> Evaluate[ndsoln[[k]]],
> {t,0,250},
> PlotRange->All,
> PlotStyle->ps[[k]],
> PlotLabel->StyleForm[
> expr[[k]],
> FontColor->ps[[k]],
> FontFamily->"Helvetica",
> FontWeight->"Bold",
> FontSize->12]],
> {k,4}],
> 2],
> ImageSize->500];
>
>
> Bob Hanlon
>
> >
> > From: sean kim <sean_incali at yahoo.com>
To: mathgroup at smc.vnet.net
> > Date: 2004/09/07 Tue AM 05:43:50 EDT
> > To: mathgroup at smc.vnet.net
> > Subject: [mg50596] [mg50489] plot thousands(?) of
> trajectories in single graph.
> >
> > hello group,
> >
> > I have a routein that solves a system of odes over
> a
> > parameter space thousands of times while randomly
> > varying the values.
> >
> > What I would like to do is take a variable and the
> > resulting solutions(however many routine has
> generated
> > over the course of evaluation) and plot them on
> single
> > graph.
> >
> > So you will get rather messy graph, but
> nonetheless
> > shows possible trajectories given system can
> yield.
> >
> > How do I go about doing this?
> >
> > I thought i could save the interpolating functions
> and
> > then evaluate thousands at the end of a routine
> and
> > show together. But How do I save the interpolating
> > function?
> >
> > or do I plot with inside the module with
> > DisplayFunction-> Identity and then save the plot
> and
> > DisplayTogether the thousands of graphs at the end
> of
> > the routine.
> >
> > if doing thousands isn't possible, is it possible
> to
> > show hundreds of trajectories?
> >
> > thanks in advance for any insights.
> >
> >
> > sean
> >
> > code below is a example skeletal code for running
> > hundred random solutions of an ode system.
> >
> >
> > Do[
> > Module[{},
> > k1 = Random[Real, {1/10, 5/10}];
> > k2 = Random[Real, {1/20, 5/20}];
> > ndsolution =
> > NDSolve[{a'[t] == -k1 a[t] x[t], b'[t] == -k2
> b[t]
> > y[t], x'[t] == -k1 a[t] x[t] + k2 b[t] y[t], y'[t]
> ==
> > k1 a[t] x[t] - k2 b[t] y[t], a[0] == 1, b[0] ==
> 1,
> > x[0] == 1, y[0] == 0},{a, b, x, y}, {t, 0,
> 250}][[1]];
> > Plot[Evaluate[{a[t], b[t], x[t], y[t]} /.
> ndsolution],
> > {t, 0, 250}, PlotRange -> All, PlotStyle ->
> > {{AbsoluteThickness[2], RGBColor[0, 0, 0]},
> > {AbsoluteThickness[2], RGBColor[.7, 0, 0]},
> > {AbsoluteThickness[2], RGBColor[0, .7, 0]},
> > {AbsoluteThickness[2], RGBColor[0, 0, .7]}}, Axes
> ->
> > False, Frame -> True, PlotLabel -> StyleForm[A
> > StyleForm[" B", FontColor -> RGBColor[.7, 0, 0]]
> > StyleForm[" X", FontColor -> RGBColor[0, .7,
> > 0]]StyleForm[" Y", FontColor -> RGBColor[0, 0,
> .7]],
> > FontFamily -> "Helvetica", FontWeight -> "Bold"]];
> > ]
> > ,{i, 100}]
> >
> >
> >
> >
> >
> > _______________________________
> > Do you Yahoo!?
> > Win 1 of 4,000 free domain names from Yahoo! Enter
> now.
> > http://promotions.yahoo.com/goldrush
> >
> >
>
>
_______________________________
Do you Yahoo!?
Shop for Back-to-School deals on Yahoo! Shopping.
http://shopping.yahoo.com/backtoschool