0
$\begingroup$

enter image description here

As shown in the figure, I want to assign values to the defined very big function ff one by one, where ff has variables [t, x, v1, v2]. The speed of this Table operation is very slow, how can I improve the speed? (I tried changing the Table to ParallelTable, but the speed improvement was not significant). The speed of assigning values once is as follows.

enter image description here

CloseKernels[];
LaunchKernels[6];
rho1 = 0.;
rho2 = 0.;
sigma1 = 0.;
sigma2 = 0.;
kappa1 = 0.;
kappa2 = 0.;
tc = 0.;
r = 0.1;
theta1 = 0.1;
theta2 = 0.;
terminal = 1.;
deltatime = 0.004;
v10 = 0.1;
v20 = 0.2;
dimension = 4;
n = 1.;
dn = (2 n + 1)^dimension;(*和维数有关*)
dj = 10.;
dq = 10.;
collocation = Tuples[Table[(i)/(2 n), {i, 0, 2 n}], 4];
random1 = RandomReal[{-1, 1}, {dn, dj}];
random2 = RandomReal[{-1, 1}, {dn, dj}];
random3 = RandomReal[{-1, 1}, {dn, dj}];
random4 = RandomReal[{-1, 1}, {dn, dj}];
random5 = RandomReal[{-1, 1}, {dn, dj}];





omegapoint = 
Table[{RandomReal[{Max[collocation[[i]][[1]] - 1/(2 n), 0.], 
    Min[collocation[[i]][[1]] + 1/(2 n), 1.]}], 
    RandomReal[{Max[collocation[[i]][[2]] - 1/(2 n), 0.], 
    Min[collocation[[i]][[2]] + 1/(2 n), 1.]}], 
    RandomReal[{Max[collocation[[i]][[3]] - 1/(2 n), 0.], 
    Min[collocation[[i]][[3]] + 1/(2 n), 1.]}], 
    RandomReal[{Max[collocation[[i]][[4]] - 1/(2 n), 0.], 
    Min[collocation[[i]][[4]] + 1/(2 n), 1.]}]}, {i, 1, dn}, {q, 1, 
    dq}];

f[i_, j_, x_] := 
Piecewise[{{(1 + Sin[2 \[Pi] (x - collocation[[i]][[j]]) 2 n])/
    2, -5/4 <= (x - collocation[[i]][[j]]) 2 n <= -3/4}, {1, -3/
    4 <= (x - collocation[[i]][[j]]) 2 n <= 
    3/4}, {(1 - Sin[2 \[Pi] (x - collocation[[i]][[j]]) 2 n])/2, 
    3/4 <= (x - collocation[[i]][[j]]) 2 n <= 5/4}}];


psi[i_, t_, x_, v1_, v2_] := 
f[i, 1, t]*f[i, 2, x]*f[i, 3, v1]*f[i, 4, v2];
li[i_, t_, x_, v1_, 
v2_] := {(t - collocation[[i]][[1]]) 2 n, (x - 
    collocation[[i]][[2]]) 2 n, (v1 - 
    collocation[[i]][[3]]) 2 n, (v2 - collocation[[i]][[4]]) 2 n};
phi[i_, j_, t_, x_, v1_, v2_] := 
Tanh[{random1[[i, j]], random2[[i, j]], random3[[i, j]], 
    random4[[i, j]]} . li[i, t, x, v1, v2] + random5[[i, j]]];
df[t_, x_, v1_, v2_] := 
Table[phi[i, j, t, x, v1, v2]*psi[i, t, x, v1, v2], {i, 1, dn}, {j, 
    1, dj}] // Flatten;

dt = D[df[t, x, v1, v2], t];
dx = D[df[t, x, v1, v2], x];
dv1 = D[df[t, x, v1, v2], v1];
dv2 = D[df[t, x, v1, v2], v2];

dxx = D[D[df[t, x, v1, v2], x], x];
dxv1 = D[D[df[t, x, v1, v2], x], v1];
dxv2 = D[D[df[t, x, v1, v2], x], v2];
dv1v1 = D[D[df[t, x, v1, v2], v1], v1];
dv2v2 = D[D[df[t, x, v1, v2], v2], v2];
ff = dt + 0.5*(v1 + v2)*x^2*dxx + rho1 sigma1 x v1 dxv1 + 
rho2 sigma2 x v2 dxv2 + 0.5*sigma1^2 v1 dv1v1 + 
0.5*sigma2^2 v2 dv2v2 - r df[t, x, v1, v2] + r x dx + 
kappa1 (theta1 - v1) dv1 + kappa2 (theta2 - v2) dv2;

(*xVars=ToExpression[Table["x"<>ToString[i],{i,1,dn dj}]];*)
xdim = IntegerPart[dn dj];
omegapointbd1 = 
Table[{RandomReal[{Max[collocation[[i]][[1]] - 1/(2 n), 0.], 
Min[collocation[[i]][[1]] + 1/(2 n), 1]}], 0., 
RandomReal[{Max[collocation[[i]][[3]] - 1/(2 n), 0.], 
Min[collocation[[i]][[3]] + 1/(2 n), 1]}], 
RandomReal[{Max[collocation[[i]][[4]] - 1/(2 n), 0.], 
Min[collocation[[i]][[4]] + 1/(2 n), 1]}]}, {i, 1, dn}, {q, 1, 
dq}];
omegapointbd2 = 
Table[{RandomReal[{Max[collocation[[i]][[1]] - 1/(2 n), 0.], 
Min[collocation[[i]][[1]] + 1/(2 n), 1]}], 1., 
RandomReal[{Max[collocation[[i]][[3]] - 1/(2 n), 0.], 
Min[collocation[[i]][[3]] + 1/(2 n), 1]}], 
RandomReal[{Max[collocation[[i]][[4]] - 1/(2 n), 0.], 
Min[collocation[[i]][[4]] + 1/(2 n), 1]}]}, {i, 1, dn}, {q, 1, 
dq}];
omegapointbd3 = 
Table[{terminal, 
RandomReal[{Max[collocation[[i]][[2]] - 1/(2 n), 0.], 
Min[collocation[[i]][[2]] + 1/(2 n), 1]}], 
RandomReal[{Max[collocation[[i]][[3]] - 1/(2 n), 0.], 
Min[collocation[[i]][[3]] + 1/(2 n), 1]}], 
RandomReal[{Max[collocation[[i]][[4]] - 1/(2 n), 0.], 
Min[collocation[[i]][[4]] + 1/(2 n), 1]}]}, {i, 1, dn}, {q, 1, 
dq}];

max = ParallelTable[{ReplaceAll[
ff, {t -> omegapoint[[i, j]][[1]], x -> omegapoint[[i, j]][[2]],
v1 -> omegapoint[[i, j]][[3]], 
v2 -> omegapoint[[i, j]][[4]]}], 
ReplaceAll[
df[t, x, v1, v2], {t -> omegapointbd1[[i, j]][[1]], x -> 0., 
v1 -> omegapointbd1[[i, j]][[3]], 
v2 -> omegapointbd1[[i, j]][[4]]}], 
ReplaceAll[
df[t, x, v1, v2] - dx, {t -> omegapointbd2[[i, j]][[1]], 
x -> 1., v1 -> omegapointbd2[[i, j]][[3]], 
v2 -> omegapointbd2[[i, j]][[4]]}], 
ReplaceAll[
df[t, x, v1, v2], {t -> terminal, 
x -> omegapointbd3[[i, j]][[2]], 
v1 -> omegapointbd3[[i, j]][[3]], 
v2 -> omegapointbd3[[i, j]][[4]]}]}, {i, 1, dn}, {j, 1, 
dq}]; // AbsoluteTiming

This is the code. I would like to obtain the result when the parameters "dj" and "dq" are relatively large, but as mentioned above, the code runs very slowly.

$\endgroup$
4
  • 1
    $\begingroup$ Please load Mathematica code that we can copy/paste/execute in our own notebook sessions. It is difficult to suggest solutions without studying your code. Thanks. $\endgroup$
    – Syed
    Oct 29, 2023 at 15:24
  • $\begingroup$ @Syed Thank you, now I have load the code. $\endgroup$ Oct 29, 2023 at 15:42
  • $\begingroup$ As far as I see, the functions calling collocation[[i]][[[j]] are ineffictive. Use local constants f[i_, j_, x_] := With[{cij = collocation[[i, j]]}, Piecewise[{{(1 + Sin[2 [Pi] (x - cij) 2 n])/ 2, -5/4 <= (x - cij) 2 n <= -3/4}, {1, -3/4 <= (x - cij) 2 n <= 3/4}, {(1 - Sin[2 [Pi] (x - cij) 2 n])/2, 3/4 <= (x - cij) 2 n <= 5/4}}]]; $\endgroup$
    – Roland F
    Oct 29, 2023 at 18:15
  • $\begingroup$ @RolandF Sorry, the testing on my end is effective. For example, if dj=dq=5, I will obtain f[1, 1, x] and f[4, 1, x] as different functions, which means that i and j are valid in this function. $\endgroup$ Oct 30, 2023 at 3:01

1 Answer 1

1
$\begingroup$

At least the timing can be reduced by 1/5 by using functions instead of replacments inside the Table

 fff[t_, x_, v1_, v2_] = ff

Output cell

  ff /. {t :> omegapoint[[1, 1, 1]], x :> omegapoint[[1, 1, 2]], 
         v1 :> omegapoint[[1, 1, 3]], v2 :> omegapoint[[1, 2, 4]]}; // Timing

            {0.5, Null}

    fff @@ omegapoint[[1, 1]]; // Timing

             {0.109375, Null}

The other replacements can be reformulated as function evaluations, too.

Finally, a high speed module would use Compile with typed local arrays as data structures.

$\endgroup$
1
  • $\begingroup$ Thank you very much! $\endgroup$ Oct 30, 2023 at 11:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.