Returning functions that are partly evaluated

Question

I have some performance issues when calling

Table[{h, Slow1[h, n]}, {n, nlist}, {h, 0.1, 10, 0.5}];

for a given list

nlist={37,288,5300}

with

Slow1[strength_,numberOfBathSpins_] := 
 Module[{Encapsulate, a, HzScalarProduct, normMatrix, h=strength},
  Encapsulate[x_] := {x};
  a = Encapsulate /@ 
    Prepend[Table[-1/16 J[j, 0], {j, 1, numberOfBathSpins}], 
     1/16 S[0]];
  HzScalarProduct[l_, p_] := 
   If[l == p, 
    2/64 S[l]^2 + 3/64 (numberOfBathSpins - 1) Q[l] - h/8 S[l] + h^2/
     4, 1/16 J[p, l] (S[p] - S[l]) - 
     3/64 (numberOfBathSpins - 3) J[p, l]^2];
  normMatrix = 
   Table[HzScalarProduct[l, p], {l, 0, numberOfBathSpins}, {p, 0, 
     numberOfBathSpins}];
  Flatten[Transpose[a].Inverse[normMatrix].a][[1]] 
  ]

Above all the problem is that the size of the vector

a

as well as the size of the matrix

normMatrix

depend on the input parameter "numberOfBathSpins". The table creation requires evaluating the whole matrix multiplication time and again. I would like to give back a list of functions with

funList={Slow1[h,37], Slow1[h,288], Slow1[h,5300]}

that I can use in order to plot the dependence of "h" for three different "numberOfBathSpins". The problem is connected to the last line within the Slow1-function. Mathematica needs too long to calculate the

Inverse[normMatrix]

symbolically. I tried to

Inverse[normMatrix]/.h->strength

This works fast and satisfactory but I don't know how to give back the whole expression without inserting a specific "h" in order for me to evaluate the expression afterwards with the function list "funList".

Answer 1

One way to improve the performance of your code is to remove definitions of auxiliary functions from the bodies of function definitions. Such auxiliary functions are redefined every time the function is called. This is demonstrated by

f[] := Module[{g}, g[] := SymbolName[g]; g[]]
Table[f[], {4}]

{"g$11401", "g$11402", "g$11403", "g$11404"}

In your case, for example, I would define HzScalarProduct as a top-level helper like so:

HzScalarProduct[l_, p_, spins_] := 
  If[l == p, 
    2/64 S[l]^2 + 3/64 (spins - 1) Q[l] - h/8 S[l] + h^2/4, 
    1/16 J[p, l] (S[p] - S[l]) - 3/64 (spins - 3) J[p, l]^2]

and call it with HzScalarProduct[l, p, numberOfBathSpins].

Also, compare

AbsoluteTiming[Encapsulate[x_] := {x}; 
  Encapsulate /@ Prepend[Table[i, {i, 1000000}], 0];]

{0.716317, Null}

AbsoluteTiming[Prepend[Table[{i}, {i, 1000000}], {0}];]

{0.224965, Null}