Message Boards Message Boards

0
|
456 Views
|
5 Replies
|
1 Total Likes
View groups...
Share
Share this post:

Code takes a lot of time to run

Fernando Silva
Posted 22 days ago

Hi, I am having a problem with my code. In this step

For[i = 3, i <= 2+ imax, i++, 
 Yp[i, x_] = Join[Yp[i - 1, x], {yp1[i, x]}]; Print[I];]

when imax=15, the code takes a lot of time to run. I already tried to use Append, Table, and AppendTo, but the code shows an error. Does anyone have some suggestions?

I am not an expert in Wolfram, so any help is welcome.
POSTED BY: Fernando Silva
5 Replies
Sort By:
Eric Rimbey
Eric Rimbey
Posted 22 days ago

It's pretty much impossible to know why your code is slow when you haven't provided all of the definitions necessary to run it. However, here are a few things to consider. In this line

Yp[i, x_] = Join[Yp[i - 1, x], {yp1[i, x]}]

you are using Set (that's what the = is), which means that the right hand side is evaluated each time through the loop. That suggests that yp1 is the part that's taking a lot of time.

Without knowing the rest of your code, I can't know for sure if the following suggestion will work, but it looks to me like your entire loop could be replaced with a single SetDelayed definition (I'll use YpAlt to distinguish it from your original):

YpAlt[k_, x_] := Table[yp1[i, x], {i, 3, k}]

If yp1 is indeed a bottleneck, you might want to add memoization:

YpAlt[k_, x_] := YpAlt[k, x] = Table[yp1[i, x], {i, 3, k}]
POSTED BY: Eric Rimbey
Fernando Silva
Fernando Silva
Posted 22 days ago

Dear Erick Rimbey, thank you for the answer

I didn't include the entire code because I was afraid of being rude, since the code is a bit long. But below is the entire code;

kp = 1
kn = 1
\[Delta] = 1
ap = -1
an = -1
imax = 15

multiTaylor[f_, {vars_?VectorQ, pt_?VectorQ, n_Integer?NonNegative}] := 
 Sum[Nest[(vars - pt) . # &, (D[f, {vars, \[FormalK]}] /. 
      Thread[vars -> pt]), \[FormalK]]/\[FormalK]!, {\[FormalK], 0, n}, 
  Method -> "Procedural"]

Subfamily 8

Xpsub[x_, y_] = 1 + 3 x + y + x^2;
Ypsub[x_, y_] = -x - 2 x y + x^2 - 3 y;
Xnsub[x_, y_] = -1 + 2 x^2 - x;
Ynsub[x_, y_] = -x + x^2 + y;

Perturbed

Xp[x_, y_] = Xpsub[x, y] + \[CapitalLambda][1] x;
Yp[x_, y_] = Ypsub[x, y];
Xn[x_, y_] = Xnsub[x, y];
Yn[x_, y_] = Ynsub[x, y];

Canonic

ffp = Factor[(Yp[x, 0] + x Xp[x, 0])/(x^2 Xp[x, 0])];
ffn = Factor[(-Yn[x, 0] + x Xn[x, 0])/(x^2 Xn[x, 0])];
ggp = Factor[(Xp[x t, 0] Yp[x t, y t] - 
      Xp[x t, y t] Yp[x t, 0])/(y t Xp[x t, y t] Xp[x t, 0])];
ggn = (-Xn[x t, 0] Yn[x t, y t] + 
     Xn[x t, y t] Yn[x t, 0])/(y t Xn[x t, y t] Xn[x t, 0]);

V = Table[\[CapitalLambda][i], {i, 1, 8}]

V0 = Table[V[[i]] -> 0, {i, 1, 8}]

fp0[x_] = 
  Expand[Normal[
    Series[(ffp /. V0) + (D[ffp, {V}] /. V0) . 
       V + (D[ffp, {V, 2}] /. V0) . V . V/2, {x, 0, imax - 1}]]];
fn0[x_] = 
  Expand[Normal[
    Series[(ffn /. V0) + (D[ffn, {V}] /. V0) . 
       V + (D[ffn, {V, 2}] /. V0) . V . V/2, {x, 0, imax - 1}]]];

gp0[x_, y_] = 
  Sum[Expand[(D[Factor[(ggp /. V0)], {t, i}]/i! /. 
       t -> 0) + (D[Factor[(D[ggp, {V}] /. V0) . V], {t, i}]/i! /. 
       t -> 0) + (D[Factor[(D[ggp, {V, 2}] /. V0) . V . V/2], {t, i}]/i! /. 
       t -> 0)], {i, 0, imax - 1}];

gn0[x_, y_] = 
  Sum[Expand[(D[Factor[(ggn /. V0)], {t, i}]/i! /. 
       t -> 0) + (D[Factor[(D[ggn, {V}] /. V0) . V], {t, i}]/i! /. 
       t -> 0) + (D[Factor[(D[ggn, {V, 2}] /. V0) . V . V/2], {t, i}]/i! /. 
       t -> 0)], {i, 0, imax - 1}];

fp[x_] = fp0[x];
gp[x_, y_] = gp0[x, y];
fn[x_] = fn0[x];
gn[x_, y_] = gn0[x, y];

Functions y+

yp0[1, x_] = 
  multiTaylor[
   ap x^(2 kp - 1) + 
    x^(2 kp) fp[x], {{\[CapitalLambda][1], \[CapitalLambda][
      2], \[CapitalLambda][3], \[CapitalLambda][4], \[CapitalLambda][
      5], \[CapitalLambda][6], \[CapitalLambda][7], \[CapitalLambda][8]}, {0, 
     0, 0, 0, 0, 0, 0, 0}, 1}];

yp0[i_, x_] := 
 multiTaylor[\[Delta]^(i - 1) (ap (2 kp - 1)!/(2 kp - i)! x^(2 kp - i) + 
      Sum[Binomial[i - 1, l] (2 kp)!/(2 kp - l)! x^(2 kp - l) D[
         fp[x], {x, i - 1 - l}], {l, 0, i - 1}]) + 
   Sum[Sum[j Binomial[i - 1, l] \[Delta]^(i - l - 1) BellY[l, j, 
       Yp[l - j + 1, x]] (D[D[gp[x, y], {y, j - 1}], {x, i - 1 - l}] /. 
        y -> 0), {j, 1, l}], {l, 1, i - 1}], {{\[CapitalLambda][
     1], \[CapitalLambda][2], \[CapitalLambda][3], \[CapitalLambda][
     4], \[CapitalLambda][5], \[CapitalLambda][6], \[CapitalLambda][
     7], \[CapitalLambda][8]}, {0, 0, 0, 0, 0, 0, 0, 0}, 1}]

yp1[i_, x_] := 
 multiTaylor[\[Delta]^(i - 
       1) (Binomial[i - 1, 2 kp] (2 kp)! D[fp[x], {x, i - 1 - 2 kp}] + 
      Sum[Binomial[i - 1, l] (2 kp)!/(2 kp - l)! x^(2 kp - l) D[
         fp[x], {x, i - 1 - l}], {l, 0, 2 kp - 1}]) + 
   Sum[Sum[j Binomial[i - 1, l] \[Delta]^(i - l - 1) BellY[l, j, 
       Yp[l - j + 1, x]] (D[D[gp[x, y], {y, j - 1}], {x, i - 1 - l}] /. 
        y -> 0), {j, 1, l}], {l, 1, i - 1}], {{\[CapitalLambda][
     1], \[CapitalLambda][2], \[CapitalLambda][3], \[CapitalLambda][
     4], \[CapitalLambda][5], \[CapitalLambda][6], \[CapitalLambda][
     7], \[CapitalLambda][8]}, {0, 0, 0, 0, 0, 0, 0, 0}, 1}]

Yp[1, x_] = {yp0[1, x]};
For[i = 2, i <= 2 kp, i++, Yp[i, x_] = Join[Yp[i - 1, x], {yp0[i, x]}];]
For[i = 2 kp + 1, i <= 2 kp + imax, i++, 
 Yp[i, x_] = Join[Yp[i - 1, x], {yp1[i, x]}]; Print[i];]

For[i = 1, i <= imax, i++, yp[i, x_] = Yp[2 kp + imax, x][[i]]]

Functions y-

yn0[1, x_] = 
  multiTaylor[
   an x^(2 kn - 1) + 
    x^(2 kn) fn[x], {{\[CapitalLambda][1], \[CapitalLambda][
      2], \[CapitalLambda][3], \[CapitalLambda][4], \[CapitalLambda][
      5], \[CapitalLambda][6], \[CapitalLambda][7], \[CapitalLambda][8]}, {0, 
     0, 0, 0, 0, 0, 0, 0}, 1}];

yn0[i_, x_] := 
 multiTaylor[(-\[Delta])^(i - 1) (an (2 kn - 1)!/(2 kn - i)! x^(2 kn - i) + 
      Sum[Binomial[i - 1, l] (2 kn)!/(2 kn - l)! x^(2 kn - l) D[
         fn[x], {x, i - 1 - l}], {l, 0, i - 1}]) + 
   Sum[Sum[j Binomial[i - 1, l] (-\[Delta])^(i - 1 - l) BellY[l, j, 
       Yn[l - j + 1, x]] (D[D[gn[x, y], {y, j - 1}], {x, i - 1 - l}] /. 
        y -> 0), {j, 1, l}], {l, 1, i - 1}], {{\[CapitalLambda][
     1], \[CapitalLambda][2], \[CapitalLambda][3], \[CapitalLambda][
     4], \[CapitalLambda][5], \[CapitalLambda][6], \[CapitalLambda][
     7], \[CapitalLambda][8]}, {0, 0, 0, 0, 0, 0, 0, 0}, 1}]

yn1[i_, x_] := 
 multiTaylor[(-\[Delta])^(i - 
       1) (Binomial[i - 1, 2 kn] (2 kn)! D[fn[x], {x, i - 1 - 2 kn}] + 
      Sum[Binomial[i - 1, l] (2 kn)!/(2 kn - l)! x^(2 kn - l) D[
         fn[x], {x, i - 1 - l}], {l, 0, 2 kn - 1}]) + 
   Sum[Sum[j Binomial[i - 1, l] (-\[Delta])^(i - 1 - l) BellY[l, j, 
       Yn[l - j + 1, x]] (D[D[gn[x, y], {y, j - 1}], {x, i - 1 - l}] /. 
        y -> 0), {j, 1, l}], {l, 1, i - 1}], {{\[CapitalLambda][
     1], \[CapitalLambda][2], \[CapitalLambda][3], \[CapitalLambda][
     4], \[CapitalLambda][5], \[CapitalLambda][6], \[CapitalLambda][
     7], \[CapitalLambda][8]}, {0, 0, 0, 0, 0, 0, 0, 0}, 1}]

Yn[1, x_] = {yn0[1, x]};
For[i = 2, i <= 2 kn, i++, Yn[i, x_] = Join[Yn[i - 1, x], {yn0[i, x]}];]
For[i = 2 kn + 1, i <= 2 kn + imax, i++, 
 Yn[i, x_] = Join[Yn[i - 1, x], {yn1[i, x]}]; Print[i];]

For[i = 1, i <= imax, i++, yn[i, x_] = Yn[2 kn + imax, x][[i]]]

Coeficient \[Mu] + and \[Mu] -

\[Mu]p[n_] := 
 Expand[1/n! Sum[(-\[Delta])^j Binomial[n, j] D[yp[j, x], {x, n - j}] /. 
     x -> 0, {j, 1, n}]]

\[Mu]n[n_] := 
 Expand[1/n! Sum[\[Delta]^j Binomial[n, j] D[yn[j, x], {x, n - j}] /. 
     x -> 0, {j, 1, n}]]

Lyapunov

\[Alpha]p[1] = -1;
Ap[1] = {\[Alpha]p[1]};
For[n = 2, n <= imax, 
 n++, \[Alpha]p[n] = 
  multiTaylor[
   Factor[(\[Mu]p[2 kp] (2 kp)!/(n + 2 kp - 1)! BellY[n + 2 kp - 1, 2 kp, 
         Join[Ap[n - 1], {0}]] + 
       Sum[\[Mu]p[i] i!/(n + 2 kp - 1)! BellY[n + 2 kp - 1, i, 
          Ap[n + 2 kp - i]], {i, 2 kp + 1, n + 2 kp - 1}] - \[Mu]p[
        n + 2 kp - 1])/(2 kp \[Mu]p[2 kp])], {{\[CapitalLambda][
      1], \[CapitalLambda][2], \[CapitalLambda][3], \[CapitalLambda][
      4], \[CapitalLambda][5], \[CapitalLambda][6], \[CapitalLambda][
      7], \[CapitalLambda][8]}, {0, 0, 0, 0, 0, 0, 0, 0}, 1}];
 Ap[n] = Join[Ap[n - 1], {n! \[Alpha]p[n]}]; Print[n];
 ]

\[Alpha]n[1] = -1;
An[1] = {\[Alpha]n[1]};
For[n = 2, n <= imax, 
 n++, \[Alpha]n[n] = 
  multiTaylor[ 
   Factor[(\[Mu]n[2 kn] (2 kn)!/(n + 2 kn - 1)! BellY[n + 2 kn - 1, 2 kn, 
         Join[An[n - 1], {0}]] + 
       Sum[\[Mu]n[i] i!/(n + 2 kn - 1)! BellY[n + 2 kn - 1, i, 
          An[n + 2 kn - i]], {i, 2 kn + 1, n + 2 kn - 1}] - \[Mu]n[
        n + 2 kn - 1])/(2 kn \[Mu]n[2 kn])], {{\[CapitalLambda][
      1], \[CapitalLambda][2], \[CapitalLambda][3], \[CapitalLambda][
      4], \[CapitalLambda][5], \[CapitalLambda][6], \[CapitalLambda][
      7], \[CapitalLambda][8]}, {0, 0, 0, 0, 0, 0, 0, 0}, 1}];
 An[n] = Join[An[n - 1], {n! \[Alpha]n[n]}]; Print[n];]

For[j = 1, j <= imax, j++, Lyap[j] = \[Delta] (\[Alpha]p[j] - \[Alpha]n[j])]
POSTED BY: Fernando Silva
Eric Rimbey
Eric Rimbey
Posted 22 days ago

You should either format the code to make it easy to copy-paste, or you should just upload a notebook with this code in it.
POSTED BY: Eric Rimbey
Fernando Silva
Fernando Silva
Posted 22 days ago

Dear Eric Rimbey,

The notebook is attached

Attachments:
Lyapunov.nb
POSTED BY: Fernando Silva
Updating Name
Updating Name
Posted 21 days ago

I have only lightly tested this, so I'm pretty sure it does what you want, but not absolutely certain. You should definitely do your own testing. Anyway, replace the For loops you're using to define Yp with the following (I changed Yp to Yp2 so I could test my implementation against yours):

Yp2[1, x_] = {yp0[1, x]};
Yp2[k_, x_] := (Yp2[k, x] = Table[yp0[i, x], {i, k}]) /; 2 <= k <= 2 kp
Yp2[k_, x_] := (Yp2[k, x] = Append[Yp2[k - 1, x], yp1[k, x]]) /; 2 kp < k

Since SetDelayed delays evaluation of the right hand side, this will be instantaneous, but the cost of evaluation will have to be paid when you want to call Yp2 with some arguments. My testing shows that this is still orders of magnitude faster than your For loops even before adding the memoization. With the memoization, we get another incremental speed-up (for secondary calls).

I didn't analyze any further than the "Functions y+" section, but I assume something similar could be done in other places in your notebook.
POSTED BY: Updating Name
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract