Re: Problem in plotting Bifurcation Diagram (ListPlot with
- To: mathgroup at smc.vnet.net
- Subject: [mg102441] Re: Problem in plotting Bifurcation Diagram (ListPlot with
- From: A <creativesolutionsnz at gmail.com>
- Date: Sun, 9 Aug 2009 18:19:04 -0400 (EDT)
- References: <200907290910.FAA19700@smc.vnet.net> <h4rpgo$lbf$1@smc.vnet.net>
On Aug 1, 4:59 pm, juan flores <juan... at gmail.com> wrote:
> On Jul 31, 4:52 am, AH <creativesolution... at gmail.com> wrote:
>
>
>
> > On Jul 30, 6:35 pm, DrMajorBob <btre... at austin.rr.com> wrote:
>
> > > MakeMapFunction is undefined, so of course the code doesn't work...
> > > although I get a different error.
>
> > > Also note, your semicolon after ListPlot will prevent display of the =
plot=
> > .
>
> > > Bobby
>
> > > On Wed, 29 Jul 2009 04:10:48 -0500, AH <creativesolution... at gmail.com=
> =
> > > wrote:
>
> > > > Hi
> > > > I have following piece of code:
> > > > -------------------------------------------------------------------=
----=
>
> > ---------------------------------
>
> > > > In[1]:=BifurcationDiagram[f_, {r_, rmin_, rmax_, rstep_}, {x_, x0=
_},
> > > > start_,
> > > > combine_] :=
> > > > Module[{R, temp, MapFunction},
> > > > R = Table[r, {r, rmin, rmax, rstep}]; (* T=
he r=
> > ange
> > > > of values of the parameter *)
> > > > MapFunction = MakeMapFunction[{r, x}, f];(=
*
> > > > Construct the iterating function *)
> > > > temp = Nest[MapFunction[R, #] &, x0 + 0.R,=
sta=
> > rt + 1];(* Starting
> > > > iterates \
> > > > *)
> > > > temp = NestList[MapFunction[R, #] &, temp,=
com=
> > bine - 1];(*
> > > > Subsequent \
> > > > iterates *)
> > > > temp = Map[ Union, Transpose[
> > > > temp] ]; (* Remove duplicate values from cycles=
*)
> > > > Flatten[ MapThread[Thread[{#1, #2}] &, {R, t=
emp}=
> > ], 1]
> > > > ];
>
> > > > In[2]:=ListPlot[BifurcationDiagram[(1 - r) x + (r(2858.16)/(x - 5=
00)
> > > > ^0.82) - 30000r, \
> > > > {r, 0.1, .2, .0001}, {x, 600}, 10000, 100], PlotStyle ->
> > > > AbsolutePointSize[0.0001]];
> > > > ------------------------------------------------------
> > > > The following errors are produced:
> > > > Graphics:: gptn : Coordiantes -30000.5+0.0169522 i {0.1,
> > > > -30000.5+0.0169522 i }....is not a floating pont. Is there any
> > > > possible solution to this problem ?
> > > > Best regards.
> > > > --------------------------------------------------------
>
> > > --
> > > DrMajor... at bigfoot.com
>
> > You can ignore MakeMapFunction.
> > In my case the only error is what that has been reported.
> > May be you can list the errors that you have got.
>
> > The main problem is that how to display deal with complex numbers while
> > plotting bifurcation diagrams.....Any idea will be very much
> > appreciated.
>
> > Also, the following link tells that ListPlot cannot be used for
> > complex numbers.http://www.stephenwolfram.com/publications/articles/com=
puting/92-desi...
> > -----------------------------------------------------------------------=
----=
> > -------------------------------------------------------------
>
> I find this post rather incomplete. Eventhough, I know what you are
> talking about.
>
> Complex roots of your ODE(s) correspond to double-period (or higher)
> bifurcation points. Read Strogatz. Now, ploting real roots, you get
> the usual bifurcation diagrams, just like the ones XppAuto produces.
> I recently plotted these bifurcation diagrams for one and two-
> parameter systems. You'll find the code at the end of the message
> (not showing the results. Evaluted and running in M 7.0.0 for Mac).
>
> I hope it helps.
>
> Cheers,
>
> Juan Flores
> -----
> one-parameter ODE
> -----
> f[x_, r_] := r x + x^3 - x^5
>
> Clear[NotComplexQ];
> NotComplexQ[c_Complex] := False;
> NotComplexQ[c_] := True
>
> CartProd[l_] := Outer[List, l[[1]], l[[2]]]
>
> ArreglaLista[l_] := Select[Map[(x /. #) &, Flatten[l]], NotComplexQ]
>
> Points = Flatten[
> Map[CartProd,
> Table[{{r}, ArreglaLista[NSolve[f[x, r] == 0, x]]}, {r, -1, 2,
> 0.05}]], 2]
>
> ListPlot[Points]
> -----
> two-parameter ODE
>
> Since the bifurcation diagram is not a funciont, ListPlot3D does not
> work, so I produce a little sphere for each point, and plot those.
> -----
> cubic ODE
> f[x_, r_, h_] := h + r x - x^3
>
> Clear[NotComplexQ];
> NotComplexQ[c_Complex] := False;
> NotComplexQ[c_] := True
>
> CartProd[l_] := Outer[List, l[[1]], l[[2]]]
>
> ArreglaLista[l_] := Select[Map[(x /. #) &, Flatten[l]], NotComplexQ]
>
> Arregla2[{l1_, l2_}] := Map[Join[l1, {#}] &, l2]
>
> kk = Flatten[
> Map[Arregla2,
> Map[{#[[1]], ArreglaLista[Flatten[#[[2]]]]} &,
> Flatten[Table[{{r, h}, NSolve[f[x, r, h] == 0, x]}, {r, -3, 3=
,
> 0.1}, {h, -3, 3, 0.1}], 1]]], 1]
>
> makeSphere[l_] := Sphere[l, 0.03]
>
> spheres = Map[makeSphere, kk]
>
> Graphics3D[spheres]
Thanks a lot Juan for the code.
I have tried and both of above scripts worked fine.
Then I have tried to replace the f[x_, r_] to my case, but no
bifurcation diagram
was produced. I am pasting the modification (copied as plain text):
f[x_,r_]:=(1-r)x+(r (2858.16)/(x-500)^0.82)-30000r
Clear[NotComplexQ];
NotComplexQ[c_Complex]:=False;
NotComplexQ[c_]:=True
CartProd[l_]:=Outer[List,l[[1]],l[[2]]]
ArreglaLista[l_]:=Select[Map[(x/.#)&,Flatten[l]],NotComplexQ]
Points=Flatten[Map[CartProd,Table[{{r},ArreglaLista[NSolve[f[x,r]
==0,x]]},{r,0.1, 0.2, 0.0001}]],600]
ListPlot[Points]
I will appreciate your help for fixing this problem ?
Best regards.
---------------------------------------------------------------------------=
----------