# How to improve the speed of tables in Mathematica?

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.

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.

• 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.
– Syed
Commented Oct 29, 2023 at 15:24
• @Syed Thank you, now I have load the code. Commented Oct 29, 2023 at 15:42
• 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}}]]; Commented Oct 29, 2023 at 18:15
• @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. Commented Oct 30, 2023 at 3:01

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


  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.

• Thank you very much! Commented Oct 30, 2023 at 11:58