Making a slow code with symbolic manipulations faster

I have a code with symbolic manipulations. It works fine but very slow (e.g. for w=14 it's reasonably fast but I want it to work for w=40, say.). I don't have good understanding of what operations make a Mathematica code slow. Here is a baby version of the code. Suggestions will be appreciated.

(I have used =!= symbol in this code. Does it make the code slower?)

 $Assumptions = a > 0 && z > 0; ch[h_, z_] := (z^(h + 1/2) - z^(-h - 1/2))/(z^(1/2) - z^(-(1/2))) Z[q_, z_] := (q^(1/2) (1 - q^2))/((1 - q) (1 - q z) (1 - q z^-1)) w = 14; prim = 0; poly = Series[(Exp[Sum[1/n Z[a^2^n, z^n], {n, 1, 2 w}]] - 1 - Z[a^2, z] - Sum[ (a^2^(l + 1) ch[l, z] - a^(2 (l + 2)) ch[l - 1, z])/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1)), {l, 2, w, 2}] - Expand[y prim] /. {y^x_ -> ch[x - 1, z]/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1))} /. {y -> ch[0, z]/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1))}), {a, 0, w}] // Simplify // Normal; prim = 0; For[p = 2, p <= w, p++, polyz = Coefficient[poly, a, p]; hpow = Exponent[polyz, z]; While[(hpow != 0) && (polyz =!= 0), hcoeff = Coefficient[polyz, z, hpow]; prim = prim + a^p hcoeff y^hpow; poly = Series[(Exp[Sum[1/n Z[a^2^n, z^n], {n, 1, 2 w}]] - 1 - Z[a^2, z] - Sum[ (a^2^(l + 1) ch[l, z] - a^(2 (l + 2)) ch[l - 1, z])/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1)), {l, 2, w, 2}] - Expand[y prim] /. {y^x_ -> ch[x - 1, z]/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1))} /. {y -> ch[0, z]/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1))}), {a, 0, w}] // Simplify // Normal; polyz = Coefficient[poly, a, p]; hpow = Exponent[polyz, z] ]; prim = prim + a^p polyz; ]; Print["Prim = ", Collect[prim /. {y -> z}, a]];  • I think you'll get better suggestions if you explain what the code does. As it stands now, it is very hard to guess your intent behind the code. And I think =!= is the least of your problems - SameQ essentially only needs to compare two expressions. Jun 10, 2018 at 16:55 • I would evaluate this one expression at a time. This will give you a clue about which evaluation is time consuming. Jun 10, 2018 at 22:04 • @mikado the second expression is far more time consuming than the first one. Jun 10, 2018 at 22:07 • Mathematica interprets a^2^n as a^(2^n). Do you actually mean that, or (a^2)^n? Jun 11, 2018 at 12:03 • Yes. I noticed that. It should be a^{2n}. Jun 11, 2018 at 12:09 1 Answer The following reduces the AbsoluteTiming of the calculation a factor of five on my computer. $Assumptions = a > 0 && z > 0;
ch[h_, z_] = (z^(h + 1) - z^(-h))/(z - 1) ;
Z[q_, z_] = (q^(1/2) (1 + q))/((1 - q z) (1 - q z^-1));
w = 14;
t1 = Simplify[Series[Exp[Sum[1/n Z[a^2^n, z^n], {n, 1, 2 w}]] - 1 - Z[a^2, z] -
Sum[ (a^2^(l + 1) ch[l, z] - a^(2 (l + 2)) ch[l - 1, z])/((1 - a^2) (1 - a^2 z)
(1 - a^2 z^-1)), {l, 2, w, 2}], {a, 0,  w}], a > 0 && z > 0]; // AbsoluteTiming

prim =  0; poly = t1;
Do[polyz = Coefficient[poly, a, p]; hpow = Exponent[polyz, z];
While[(hpow != 0) && (polyz =!= 0),
hcoeff = Coefficient[polyz, z, hpow]; prim = prim + a^p hcoeff y^hpow;
poly = Simplify[t1 - Series[
Expand[y prim] /. {y^x_ -> ch[x - 1, z]/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1)),
y ->  ch[0, z]/((1 - a^2) (1 - a^2 z) (1 - a^2 z^-1))}, {a,  0,  w}],
a > 0 && z > 0] // Normal ;
polyz = Coefficient[poly, a, p]; hpow = Exponent[polyz, z]];
prim = prim + a^p polyz;, {p, 2, w}] // AbsoluteTiming

Collect[prim /. {y -> z}, a]


The most substantive change is to move the two Sums, now designated t1, out of the While loop and then Simplify it. Replacing SetDelayed by Set in the definitions of the two functions and simplifying them by hand also helps a bit. Note that the time required to compute t1 exceeds the time required to compute the entire Do loop and increases rapidly with w. So, further improvements in speed are to be achieved by optimizing the t1 computation.

• Thanks @bbgodfrey! It's faster than before. Jun 11, 2018 at 12:12