Making ReplaceAll faster

Question

I have a list of functions ncalc that is calculated by

V[0][0] = {29.51, 26.98, 3.3256}; 
V[0][1] = {26.1194, 27.8766, 4.38633};
V[0][2] = {22.7297, 28.7663, 5.46013}; 
V[0][3] = {19.356, 29.6368, 6.59183};
V[0][4] = {16.0138, 30.4773, 7.82627};
V[0][5] = {12.7187, 31.2773, 9.20761}; 
V[0][6] = {9.48858, 32.0269, 10.7647};
V[0][7] = {6.34382, 32.7172, 12.5112};
V[0][8] = {3.30487, 33.3392, 14.46}; 
V[0][9] = {0.392168, 33.8839, 16.624};
V[1][0] = {30.3599, 30.4283, 3.35809}; 
V[1][1] = {26.9964, 31.2994, 4.52292};
V[1][2] = {23.6302, 32.1648, 5.69061}; 
V[1][3] = {20.3785, 32.9881, 6.86898};
V[1][4] = {16.9578, 33.8333, 8.21633};
V[1][5] = {13.6854, 34.614, 9.66453}; 
V[1][6] = {10.4785, 35.3459, 11.2789};
V[1][7] = {7.35433, 36.0215, 13.0703};
V[1][8] = {4.3304, 36.6335, 15.0487}; 
V[1][9] = {1.42411, 37.1742, 17.2242};
V[2][0] = {31.1995, 33.8811, 3.36074}; 
V[2][1] = {27.8651, 34.7249, 4.63509};
V[2][2] = {24.5225, 35.5668, 5.89674}; 
V[2][3] = {21.1919, 36.3939, 7.19607};
V[2][4] = {17.8938, 37.1933, 8.58349};
V[2][5] = {14.648, 37.9522, 10.1083}; 
V[2][6] = {11.4705, 38.662, 11.7962};
V[2][7] = {8.37303, 39.3187, 13.649};
V[2][8] = {5.36728, 39.9182, 15.6675}; 
V[2][9] = {2.46482, 40.4566, 17.8526};
umax = 9;
vmax = 2;
Subscript[\[CapitalDelta], b] = 0.4;
layer = 5;
Do[Dizin[i + 1] = Array[V[i], umax + 1, 0], {i, 0, vmax}]
PTS = Array[Dizin, vmax + 1, 1];
hazır = BSplineFunction[PTS];
vektörler = hazır["Knots"];
dereceler = hazır["Degree"];
degree1 = dereceler[[2]];
degree2 = dereceler[[1]];
knot = vektörler[[2]];
knots = vektörler[[1]];
nodenum = (umax + 1)*(vmax + 1);
elnum = umax*vmax;
Do[Subscript[Subscript[w, i], j] = 1, {i, 0, umax}, {j, 0, vmax}]
Do[Subscript[N, i, 4] = 
  PiecewiseExpand[BSplineBasis[{degree1, knot}, i, u], 
   0 <= u <= 1], {i, 0, umax}]
Do[Subscript[K, i, 4] = 
  PiecewiseExpand[BSplineBasis[{degree2, knots}, i, v], 
   0 <= v <= 1], {i, 0, vmax}]
Subscript[S, uv] = (\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \(vmax\)]\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 0\), \(umax\)]
\*SubscriptBox[\(K\), \(i, 4\)] 
\*SubscriptBox[\(N\), \(j, 4\)] 
\*SubscriptBox[
SubscriptBox[\(w\), \(j\)], \(i\)] \(V[i]\)[j]\)\))/(\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \(vmax\)]\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 0\), \(umax\)]
\*SubscriptBox[\(K\), \(i, 4\)] 
\*SubscriptBox[\(N\), \(j, 4\)] 
\*SubscriptBox[
SubscriptBox[\(w\), \(j\)], \(i\)]\)\));
thick = Subscript[\[CapitalDelta], b]/(layer - 1);
Subscript[S, u] =D[Subscript[S, uv], u];
Subscript[S, v] = D[Subscript[S, uv], v];
unit = Norm[Cross[Subscript[S, u], Subscript[S, v]]];
ncalc = ((Cross[Subscript[S, u], Subscript[S, v]]/unit));

Utilizing ReplaceAll I am trying to solve ncalc equation

Do[u[i] = i/umax, {i, 0, umax}]
Do[v[i] = (i - 1)/vmax, {i, 0, vmax + 1}]
SetSharedFunction[n];
ParallelDo[
     n[((vmax + 1)*i) + j] = (ncalc /. {u -> u[i], v -> v[j]}), {j, 
      1, (vmax + 1)}, {i, 0, umax}]

umax and vmax describe the points that end of the surface. if i want to describe the surface with alot more points umax and vmax increase...the amount of ncalc data and n change with umax and vmax if umax=16 vmax=72 ;

SetSharedFunction[n];
ParallelDo[
         n[((vmax + 1)*i) + j] = (ncalc /. {u -> u[i], v -> v[j]}), {j, 
          1, (vmax + 1)}, {i, 0, umax}]//AbsoluteTiming
{28321.709909, Null}

Is there a way to decrease the analysis time or make ReplaceAll faster?

Thanks for the help! But when I use your code I get the same timings. It is faster when it is used for umax=9 and vmax=2, but when it is used for umax=36 and vmax=8 I get the same results.

SetSharedFunction[n];
ParallelDo[
     n[((vmax + 1)*i) + j] = (ncalc /. {u -> u[i], v -> v[j]}), {j, 1, (vmax + 1)}, 
     {i, 0, umax}] // AbsoluteTiming

{1426.004146, Null}

(defs = ParallelTable[
     RuleDelayed[HoldPattern@Evaluate[n[((vmax + 1)*i) + j]], 
     Evaluate[ncalc /. {u -> u[i], v -> v[j]}]], {j, 1, (vmax + 1)},
     {i, 0, umax}]); // AbsoluteTiming

{1393.181685, Null}

Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. — bbgodfrey, May 21 '15 at 15:33
Related?: http://mathematica.stackexchange.com/questions/83891/why-is-block-significantly-faster-than-replaceall-for-inputting-variable-val -- Why do you think the slowness is due to ReplaceAll? It could be the large amount of data being shuttled between the kernels.... — Michael E2, May 21 '15 at 15:54
Just how is ncalc defined? It looks appropriate for Piecewise or Which, but it is not syntactically correct. — Michael E2, May 21 '15 at 20:53

score 6 · Answer 1 · answered May 21 '15 at 21:32

The OP's (current) definition of ncalc is unreadable and unsalvageable, so I made one up from pieces of the code.

ncalc = Piecewise[{
   {-21. + 294. u - 1029. u^2, u < 1/7},
   {2. v (131.25 - 367.5 u + 257.25 u^2), 5/7 < u < 6/7},
   {5.25, u == 6/7},
   {33.8811 v^2 , u > 1/7}},
  -1380.75 + 3160.5 u - 1800.75 u^2]

When you set shared variables or functions, you committing Mathematica to updating all kernels whenever one of them is changed. The symbol n is changed at each step in your loop, which is then communicated to all the other kernels. If you have eight kernels, you're doing eight times the work, plus the extra time spent communicating.

Functions are defined in terms of DownValues, which are rules of the form HoldPattern[pattern] :> value, where pattern is the pattern of the function call. It would be much better to create these replacement rules and then to define the function via DownValues.

Clear[u, v, n];
umax = 16; vmax = 72;
Do[u[i] = i/umax, {i, 0, umax}]
Do[v[i] = (i - 1)/vmax, {i, 0, vmax + 1}]
UnsetShared[n];
(defs = ParallelTable[RuleDelayed[
      HoldPattern@Evaluate[n[((vmax + 1)*i) + j]],
      Evaluate[ncalc /. {u -> u[i], v -> v[j]}]
      ], {j, 1, (vmax + 1)}, {i, 0, umax}]) // AbsoluteTiming // Short[#, 4] &
(*
  {0.044945 {{HoldPattern[n[1]]:>-21., HoldPattern[n[74]]:>-6.64453,
   HoldPattern[n[147]]:>-0.328125, <<12>>, HoldPattern[n[1096]]:>0.,
   HoldPattern[n[1169]]:>0.}, {<<1>>}, <<70>>, {<<1>>}}}
*)

DownValues[n] = defs;
?n
(* lots of definitions shown:
     n[1] = -21.
     ...
*)

Comparison with OP's:

Clear[u, v, n];
umax = 16; vmax = 72;
Do[u[i] = i/umax, {i, 0, umax}]
Do[v[i] = (i - 1)/vmax, {i, 0, vmax + 1}]
SetSharedFunction[n];
ParallelDo[
  n[((vmax + 1)*i) + j] := (ncalc /. {u -> u[i], v -> v[j]}), {j, 
   1, (vmax + 1)}, {i, 0, umax}] // AbsoluteTiming
(*  {2.36921, Null}  *)

If we make u and v five times bigger (each), the difference in timing becomes 0.46 sec. vs. 54. sec.

Caveat: The OP defines n in terms of Integer arguments. That means it is undefined for Real arguments. So n[1.] will return unevaluated. I suppose that is what is desired, but it is sometimes overlooked.

@user29637 Does my answer address the underlying problem? The actual ncalc does not seem to be an important part of the problem. Rather, it's the parallelization and the use of SetSharedFunction. — Michael E2, May 22 '15 at 10:43

Making ReplaceAll faster

1 Answers1