0
$\begingroup$

I want to calculate Lyapunov exponents for by varying two parameters so that I can get density plot. I am using the code:

GramSchmidt[w_?MatrixQ] := 
 Module[{v = ConstantArray[0, Length[w]]}, 
  Table[v[[n]] = 
    w[[n]] - 
     Sum[(v[[i]] . w[[n]]/v[[i]] . v[[i]])*v[[i]], {i, n - 1}], {n, 
    Length[w]}];
  v]
LyapunovExponents[eqnsin_List, icsin : ({__Rule} | _Association), 
   nlein_Integer : 0, opts___?OptionQ] := 
  Module[{(*options*)tstep, maxsteps, ndsolveopts, logbase, showplot, 
    plotexponents, plotopts,(*other variables*)\[Delta], neq, nle, 
    vars, rhs, jac, eqns, unks, ics, cum, res, edat, state, newstate, 
    sol, W, norms},(*parse options*)
   tstep = Evaluate[TStep /. Flatten[{opts, Options[LyapunovExponents]}]];
   maxsteps = 
    Evaluate[MaxSteps /. Flatten[{opts, Options[LyapunovExponents]}]];
   ndsolveopts = 
    Evaluate[NDSolveOpts /. Flatten[{opts, Options[LyapunovExponents]}]];
   logbase = 
    Evaluate[LogBase /. Flatten[{opts, Options[LyapunovExponents]}]];
   showplot = 
    Evaluate[ShowPlot /. Flatten[{opts, Options[LyapunovExponents]}]];
   plotexponents = 
    Evaluate[
     PlotExponents /. Flatten[{opts, Options[LyapunovExponents]}]];
   plotopts = 
    Evaluate[PlotOpts /. Flatten[{opts, Options[LyapunovExponents]}]];
   neq = Length[eqnsin];
   If[nlein == 0, nle = neq, 
    nle = nlein];(*how many exponents*)(*extract vars and right hand s\
ides from eqnsin*)vars = eqnsin[[All, 1, 0, 1]];
   rhs = eqnsin[[All, 2]];
   (*jacobian matrix*)jac = D[rhs, {Replace[vars, {x_ -> x[t]}, 1]}];
   eqns = 
    Join[eqnsin, 
     Flatten[Table[\[Delta][i, j]'[
         t] == (jac . Table[\[Delta][i, j][t], {i, neq}])[[i]], {j, 
        nle}, {i, neq}]]];
   unks = Join[vars, Flatten[Table[\[Delta][i, j], {j, nle}, {i, neq}]]];
   ics = 
    Join[Table[var[0] == (var /. icsin), {var, vars}], 
     Flatten[Table[\[Delta][i, j][0] == 
        IdentityMatrix[neq][[i, j]], {j, nle}, {i, neq}]]];
   cum = Table[0, {nle}];
   state = 
    First@NDSolve`ProcessEquations[Flatten[Join[eqns, ics]], unks, t, 
      Evaluate[Sequence @@ ndsolveopts]];
   (*main loop*)
   edat = Table[newstate = First@NDSolve`Reinitialize[state, ics];
     NDSolve`Iterate[newstate, c tstep];
     sol = NDSolve`ProcessSolutions[newstate];
     W = 
      GramSchmidt[
       Evaluate[
        Table[\[Delta][i, j][c tstep], {j, nle}, {i, neq}] /. sol]];
     norms = Map[Norm, W];
     (*update running vector magnitudes*)
     cum = cum + Log[logbase, norms];
     ics = 
      Join[Table[var[c tstep] == (var[c tstep] /. sol), {var, vars}], 
       Flatten[Table[\[Delta][i, j][c tstep] == (W/norms)[[j, i]], {j,
           nle}, {i, neq}]]];
     cum/(c tstep), {c, maxsteps}];
   If[showplot, 
    Print[ListPlot[Transpose[edat][[plotexponents]], 
      Evaluate[Sequence @@ plotopts]]]];
   Return[cum/(maxsteps tstep)]];
Options[LyapunovExponents] = {NDSolveOpts -> {}, TStep -> 1, 
  MaxSteps -> 10^4(*10^4*), LogBase -> E, ShowPlot -> False, 
  PlotExponents -> 1(*{1,2,3}*), PlotOpts -> {}};
eqns1 = Table[a*x[t] - a*y[t] - y[t]*z[t], {a, 0, 2, 1}];
eqns2 = Table[-5* z[t] + d*x[t] + x[t]*y[t], {d, 0, 2, 1}];
eqns = {x'[t] == eqns1[[#]], 
   y'[t] == -1.67*y[t] + x[t]*z[t], {z'[t] == eqns2[[#]] & /@ 
     Range[1, Length[eqns2]]}} & /@ Range[1, Length[eqns1]]
ics = {x -> -1.0, y -> -1.0, z -> -1.0};
CA = Table[d, {d, 0, 2, 1}]
BA = Table[{a, CA}, {a, 0, 2, 1}]

AB = LyapunovExponents[eqns[[#]], ics, ShowPlot -> False] & /@ 
  Range[1, Length[eqns]]

LYa = {CA[[#]], BA[[#]], AB[[#, 1]], AB[[#, 2]], AB[[#, 3]]} & /@ 
  Range[1, Length[eqns]]
DensityPlot[LYa[[All, {1, 3}]][d, a], {d, 0, 2}, {a, 0, 2}, 
 PlotLegends -> Automatic]

I am not getting where I am doing mistakes. This code gives error.

$\endgroup$
3
  • 3
    $\begingroup$ This is not a site for "My code doesn't work... fix it for me." $\endgroup$ Commented Jul 29 at 16:30
  • $\begingroup$ In the statement: vars = eqnsin[[All, 1, 0, 1]]; eqnsin has dimension: 3 and can not be indexed with 4 indices. $\endgroup$ Commented Jul 30 at 7:20
  • $\begingroup$ Thank you very much both of you for your valuable comments. I got it where was the exact problem in my code and trying to resolve . $\endgroup$ Commented Jul 31 at 0:12

0

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.