autocheck of had1.test ====================== Validation file hadold.test for HIERARCHICAL ADDRESSING IN bilo ------------------------------- displays (1.1), (1.2) and (2.3) ------------------------------- In[1]:= < exp[u + v]); then In[7]:= check[2.7] = (exp[a] exp[b] + exp[c] exp[d] /. r) === exp[a + b] + exp[c + d] Out[7]= True ---------------------------------------------------------------- display (2.8) ------------- In[8]:= Clear[u, v, b, c, d, e, f, g, x, y] In[9]:= check[2.8] = ((u^2 + 2 u v + v^2 == (b + c x + d x)/(e + f y + g y)) // inSuccession[toTheLhs[Factor], toTheRhs[toTheNumerator[collectProductsOf[x]], toTheDenominator[collectProductsOf[y]]]]) === (u + v)^2 == (b + (c + d)*x)/(e + (f + g)*y) Out[9]= True ---------------------------------------------------------------- display (2.9) and (2.10) ------------------------ In[10]:= Clear[x, y, z, f1, f2, fn, s] In[11]:= check[2.9] = inSuccession[f1, f2, dots, fn][s] === (s // f1 // f2 // dots // fn) Out[11]= True In[12]:= Clear[a, b, c, d, x, y, z] In[13]:= check[2.10] = (exp[x] (exp[y] + exp[z]) // inSuccession[Expand, r]) === exp[x + y] + exp[x + z] Out[13]= True ---------------------------------------------------------------- displays (3.2) and (3.3) ------------------------ The factorOut function imposes HoldForm to prevent, e.g. -(a-b) reverting to -a+b. Here it can be released, because the -1 factored from the numerator cancel. The display that follows shows (1) the initial result, (2) the effect of releasing hold, without visible effect (unless FullForm is used to display), (3) the formatted result, and (4) a "=== / True" verification. In[14]:= Clear[b, c, k, n, q, s, ss] In[15]:= transfm[3.2] = (c^(k-n) - b^(k-n)) q[n] / (k - n) -> (b^(k-n) - c^(k-n))q[n]/(n-k); In[16]:= format[3.2] = inSuccession[ toThe[c^_ + _][sortByPresence[c]], toThe[n-k][sortByPresence[n]]]; In[17]:= show[transfm[3.2] // format[3.2]] Out[17]= (HoldForm[c^(k - n) - b^(k - n)]*q[n])/(k - n) -> ((b^(k - n) - c^(k - n))*q[n])/HoldForm[n - k] In[18]:= show[transfm[3.2]] Out[18]= ((-b^(k - n) + c^(k - n))*q[n])/(k - n) -> ((b^(k - n) - c^(k - n))*q[n])/(-k + n) In[19]:= function[3.3] = toTheNumeratorAndDenominator[factorOut[-1]]; In[20]:= show[transfm[3.2][[1]] // function[3.3]] Out[20]= ((b^(k - n) - c^(k - n))*q[n])/HoldForm[-k + n] In[21]:= show[transfm[3.2][[1]] // function[3.3] // ReleaseHold // format[3.2][[1]]] Out[21]= ((b^(k - n) - c^(k - n))*q[n])/HoldForm[n - k] In[22]:= check[3.3] = (transfm[3.2][[1]] // function[3.3] // ReleaseHold) === transfm[3.2][[2]] Out[22]= True ---------------------------------------------------------------- displays (3.5)-(3.8) -------------------- In[23]:= Clear[z, i, n] In[24]:= eqn[3.5] = (sqrt[2/pi] z^(n+1/2)/bb[2n+1] i[n, z] == sqrt[2/pi] z^(n-3/2)/bb[2n-3] i[n-2, z] - sqrt[2/pi] (2n-1) z^(n-3/2)/bb[2n-1] i[n-1, z]); In[25]:= format[3.5] = inSuccession[ toEach[n + _ | 2n + _][sortByPresence[n]], to[Times][outermost][ collectivelyToFactorsThat[containAny[z^_, bb]][hold], sortByAbsence[i, hold, n], hold -> HoldForm ]]; In[26]:= show[eqn[3.5] // format[3.5]] Out[26]= HoldForm[sqrt[2/pi]* HoldForm[z^HoldForm[n + 1/2]/bb[HoldForm[2*n + 1]]]*i[n, z]] == HoldForm[sqrt[2/pi]*HoldForm[z^HoldForm[n - HoldForm[3/2]]/ bb[HoldForm[2*n - 3]]]*i[HoldForm[n - 2], z]] - HoldForm[sqrt[2/pi]*HoldForm[2*n - 1]* HoldForm[z^HoldForm[n - HoldForm[3/2]]/bb[HoldForm[2*n - 1]]]* i[HoldForm[n - 1], z]] In[27]:= show[eqn[3.5]] Out[27]= (z^(1/2 + n)*i[n, z]*sqrt[2/pi])/bb[1 + 2*n] == (z^(-3/2 + n)*i[-2 + n, z]*sqrt[2/pi])/bb[-3 + 2*n] - ((-1 + 2*n)*z^(-3/2 + n)*i[-1 + n, z]*sqrt[2/pi])/bb[-1 + 2*n] In[28]:= eqn[3.6] = z^2 i[n, z] == bb[2n+1]/bb[2n-3] i[n-2, z] - (2n-1)bb[2n+1]/bb[2n-1] i[n-1, z]; In[29]:= format[3.6] = inSuccession[toEachTerm[toEach[n + _ | 2n + _][sortByPresence[n]], collectivelyToFactorsThat[contain[bb]][HoldForm]]]; In[30]:= show[eqn[3.6] // format[3.6]] Out[30]= z^2*i[n, z] == HoldForm[bb[HoldForm[2*n + 1]]/ bb[HoldForm[2*n - 3]]]*i[HoldForm[n - 2], z] - HoldForm[2*n - 1]*HoldForm[bb[HoldForm[2*n + 1]]/bb[HoldForm[2*n - 1]]]* i[HoldForm[n - 1], z] In[31]:= show[eqn[3.6]] Out[31]= z^2*i[n, z] == (bb[1 + 2*n]*i[-2 + n, z])/bb[-3 + 2*n] - ((-1 + 2*n)*bb[1 + 2*n]*i[-1 + n, z])/bb[-1 + 2*n] In[32]:= function[3.7] = inSuccession[ toBothSides[times[z^(3/2-n) sqrt[pi/2] bb[2n+1]]], toTheRhs[Distribute], sqrtSimplify]; In[33]:= check[3.7] = eqn[3.6] === (eqn[3.5] // function[3.7]) Out[33]= True In[34]:= function[3.8] = toBothSides[times[z^(3/2-n) sqrt[pi/2] bb[2n+1]], Distribute, sqrtSimplify]; In[35]:= check[3.8] = eqn[3.6] === (eqn[3.5] // function[3.8]) Out[35]= True ---------------------------------------------------------------- displays (3.9)-(3.16) --------------------- In[36]:= Clear[u, v, a, b, exp, log] In[37]:= eqn[1] = u == exp[a]; In[38]:= eqn[2] = v == exp[b]; In[39]:= eqn[3] = exp[a + b] == exp[a] exp[b]; In[40]:= eqn[4] = log == InverseFunction[exp]; In[41]:= brule[4] === (log :> InverseFunction[exp]) Out[41]= True In[42]:= function[3.13] = localFunction = inSuccession[toBothSides[log], toTheRhs[brule[4]]]; In[43]:= check[3.14a] = (eqn[5] = eqn[1] // function[3.13]) === (log[u] == a) Out[43]= True In[44]:= check[3.14b] = (eqn[6] = eqn[2] // function[3.13]) === (log[v] == b) Out[44]= True In[45]:= check[3.15] = {bruleReverse[1], bruleReverse[2], bruleReverse[5], bruleReverse[6]} === {exp[a] :> u, exp[b] :> v, a :> log[u], b :> log[v]} Out[45]= True In[46]:= check[3.16] = (eqn[3] // inSuccession[toTheRhs[bruleReverse[1], bruleReverse[2]], toBothSides[log], toTheLhs[brule[4], bruleReverse[5], bruleReverse[6]], reverse]) === (log[u v] == log[u] + log[v]) Out[46]= True ---------------------------------------------------------------- displays (4.1)-(4.2) -------------------- In[47]:= eqn[4.1] = x f[n, x] == n f[n, x] + (n+1) f[n-1, x]; In[48]:= format[4.1] = inSuccession[toTheRhs[toEach[n+_][sortByPresence[n]], toEachTerm[sortByAbsence[f]]]]; In[49]:= show[eqn[4.1] // format[4.1]] Out[49]= x*f[n, x] == HoldForm[n*f[n, x]] + HoldForm[HoldForm[n + 1]*f[HoldForm[n - 1], x]] In[50]:= show[eqn[4.1]] Out[50]= x*f[n, x] == (1 + n)*f[-1 + n, x] + n*f[n, x] In[51]:= format[4.2] = toTheRhs[toEach[n+_][sortByPresence[n]], toEach[_ f[__]][sortByAbsence[f]], to[Plus][containing[HoldForm[n-2]], innermost][ sortByAbsence[-2]]]; In[52]:= eqn[4.2] = eqn[4.1] // toBothSides[times[x], Distribute, grule[4.1]]; In[53]:= eqn[4.2] === (x^2 f[n, x] == n (n f[n, x] + (n+1) f[n-1, x]) + (n+1)((n-1) f[n-1, x] + n f[n-2, x])) Out[53]= True In[54]:= show[eqn[4.2] // format[4.2]] Out[54]= x^2*f[n, x] == n*(HoldForm[n*f[n, x]] + HoldForm[HoldForm[n + 1]*f[HoldForm[n - 1], x]]) + HoldForm[n + 1]*HoldForm[HoldForm[HoldForm[n - 1]* f[HoldForm[n - 1], x]] + HoldForm[n*f[HoldForm[n - 2], x]]] In[55]:= show[eqn[4.2]] Out[55]= x^2*f[n, x] == (1 + n)*(n*f[-2 + n, x] + (-1 + n)*f[-1 + n, x]) + n*((1 + n)*f[-1 + n, x] + n*f[n, x]) In[56]:= format[4.3] = toTheRhs[toEach[_?IntegerQ + _][sortByPresence[n]], toEachTerm[sortByAbsence[f, 2n]], sortByAbsence[-2]]; In[57]:= eqn[4.3] = x^2 f[n, x] == n^2 f[n, x] + n(n+1) f[n-1, x] + (n-1)(n+1)f[n-1, x] + n(n+1) f[n-2, x]; In[58]:= show[eqn[4.3] // format[4.3]] Out[58]= x^2*f[n, x] == HoldForm[HoldForm[n^2*f[n, x]] + HoldForm[n*HoldForm[n + 1]*f[HoldForm[n - 1], x]] + HoldForm[HoldForm[n - 1]*HoldForm[n + 1]*f[HoldForm[n - 1], x]] + HoldForm[n*HoldForm[n + 1]*f[HoldForm[n - 2], x]]] In[59]:= show[eqn[4.3]] Out[59]= x^2*f[n, x] == n*(1 + n)*f[-2 + n, x] + (-1 + n)*(1 + n)*f[-1 + n, x] + n*(1 + n)*f[-1 + n, x] + n^2*f[n, x] In[60]:= function[4.4] = toTheRhs[toEachTerm[leftDistribution]]; In[61]:= check[4.4] = (eqn[4.2] // function[4.4]) === eqn[4.3] Out[61]= True ----------------------------------------------------------------------- displays (4.5) and (4.6) ------------------------ In[62]:= Clear[theta, a, b, c] In[63]:= eqn[4.5] = E[0, 3, theta] == -3/2 + 2(3/2 cos[theta] + 1/2) sin[theta/2] + P[2, cos[theta]] log[1+ csc[theta/2]]; In[64]:= format[4.5] = Module[{a, b, c}, toTheRhs[ a_ cos[b_] + c_ :> HoldForm[HoldForm[a] cos[b] + c], log[a_] P[b__] :> HoldForm[P[b] log[a]], sortByAbsence[log]]]; In[65]:= show[eqn[4.5] // format[4.5]] Out[65]= E[0, 3, theta] == HoldForm[-3/2 + 2*HoldForm[HoldForm[3/2]*cos[theta] + 1/2]*sin[theta/2] + HoldForm[P[2, cos[theta]]*log[1 + csc[theta/2]]]] In[66]:= show[eqn[4.5]] Out[66]= E[0, 3, theta] == -3/2 + log[1 + csc[theta/2]]*P[2, cos[theta]] + 2*(1/2 + (3*cos[theta])/2)*sin[theta/2] In[67]:= function[4.6] = toEachTermThat[doesNotContain[P]][ cos[theta] -> 1 - 2 sin[theta/2]^2, collectPowersOf[sin[theta/2]]]; In[68]:= eqn[4.6a] = eqn[4.5] // function[4.6]; In[69]:= format[4.6] = Module[{a, b}, inSuccession[ toTheRhs[log[a_] P[b__] :> HoldForm[P[b] log[a]], sortByAbsence[log]]]]; In[70]:= show[eqn[4.6a] // format[4.6]] Out[70]= E[0, 3, theta] == HoldForm[-3/2 + 2*sin[theta/2]*(1/2 + (3*(1 - 2*sin[theta/2]^2))/2) + HoldForm[P[2, cos[theta]]*log[1 + csc[theta/2]]]] In[71]:= show[eqn[4.6a]] Out[71]= E[0, 3, theta] == -3/2 + log[1 + csc[theta/2]]*P[2, cos[theta]] + 2*sin[theta/2]*(1/2 + (3*(1 - 2*sin[theta/2]^2))/2) In[72]:= eqn[4.6b] = eqn[4.6a] // toTheRhs[Expand, collectPowersOf[sin[theta/2]]]; In[73]:= show[eqn[4.6b] // format[4.6]] Out[73]= E[0, 3, theta] == HoldForm[-3/2 + 4*sin[theta/2] - 6*sin[theta/2]^3 + HoldForm[P[2, cos[theta]]*log[1 + csc[theta/2]]]] In[74]:= show[eqn[4.6b]] Out[74]= E[0, 3, theta] == -3/2 + log[1 + csc[theta/2]]*P[2, cos[theta]] + 4*sin[theta/2] - 6*sin[theta/2]^3 ----------------------------------------------------------------------- displays (4.7) and (4.8) ------------------------ The format gives the arrangement of the published equation, and is a rather awkward test of the sort functions. In[75]:= eqn[4.7] = E[3, -2, theta] == 1/4(1 - 7 cos[theta]^2) -3 cos[theta] sin[theta/2] - sin[theta/2] + 1/2 P[0, cos[theta]] + P[1, cos[theta]] - P[2, cos[theta]] log[sin[theta/2](1 + sin[theta/2])]; In[76]:= format[4.7] = toTheRhs[ toTerm[containing[log]][sortByAbsence[log]], toThe[1/4][hold], toThe[_ P[0, _]][toThe[1/2][hold]], toEach[hold[_] _][sortByPresence[hold]], sortByCriteria[containing[1/4], containing[-3], notContaining[P], containing[P[0, _]], containing[P[1, _]]], hold -> HoldForm]; In[77]:= show[eqn[4.7] // format[4.7]] Out[77]= E[3, -2, theta] == HoldForm[HoldForm[HoldForm[1/4]* (1 - 7*cos[theta]^2)] - 3*cos[theta]*sin[theta/2] - sin[theta/2] + HoldForm[HoldForm[1/2]*P[0, cos[theta]]] + P[1, cos[theta]] - HoldForm[P[2, cos[theta]]*log[sin[theta/2]*(1 + sin[theta/2])]]] In[78]:= show[eqn[4.7]] Out[78]= E[3, -2, theta] == (1 - 7*cos[theta]^2)/4 + P[0, cos[theta]]/2 + P[1, cos[theta]] - log[sin[theta/2]*(1 + sin[theta/2])]* P[2, cos[theta]] - sin[theta/2] - 3*cos[theta]*sin[theta/2] In[79]:= evaln[P][s_] := s /. P[n_, x_] -> LegendreP[n, x] In[80]:= function[4.8] = toEachTermThat[doesNotContain[log]][evaln[P]]; In[81]:= eqn[4.8a] = eqn[4.7] // function[4.8]; In[82]:= format[4.8] = toTheRhs[toTerm[containing[P]][sortByAbsence[log]], sortByAbsence[log]]; In[83]:= show[eqn[4.8a] // format[4.8]] Out[83]= E[3, -2, theta] == HoldForm[1/2 + cos[theta] + (1 - 7*cos[theta]^2)/4 - sin[theta/2] - 3*cos[theta]*sin[theta/2] - HoldForm[P[2, cos[theta]]*log[sin[theta/2]*(1 + sin[theta/2])]]] In[84]:= show[eqn[4.8a]] Out[84]= E[3, -2, theta] == 1/2 + cos[theta] + (1 - 7*cos[theta]^2)/4 - log[sin[theta/2]*(1 + sin[theta/2])]*P[2, cos[theta]] - sin[theta/2] - 3*cos[theta]*sin[theta/2] In[85]:= tidier = toTheRhs[ toTerms[notContaining[log]][ cos[theta] -> 1 - 2 sin[theta/2]^2], collectPowersOf[sin[theta/2]], Expand]; In[86]:= eqn[4.8b] = eqn[4.8a] // tidier; In[87]:= show[eqn[4.8b] // format[4.8]] Out[87]= E[3, -2, theta] == HoldForm[-4*sin[theta/2] + 5*sin[theta/2]^2 + 6*sin[theta/2]^3 - 7*sin[theta/2]^4 - HoldForm[P[2, cos[theta]]*log[sin[theta/2]*(1 + sin[theta/2])]]] In[88]:= show[eqn[4.8b]] Out[88]= E[3, -2, theta] == -(log[sin[theta/2]*(1 + sin[theta/2])]* P[2, cos[theta]]) - 4*sin[theta/2] + 5*sin[theta/2]^2 + 6*sin[theta/2]^3 - 7*sin[theta/2]^4 ----------------------------------------------------------------------- displays (4.10) to (4.13) ------------------------ In[89]:= Clear[s, a, b, r, X] In[90]:= eqn[4.10] = s == 192 b^4 - 48 b^2 (b r - 4) X + 4 (b^2 r^2 -10 b r +5) X^2 + 3 r^2 X^3; In[91]:= format[4.10] = toTheRhs[toEach[_Integer + _][sortByPresence[r^2, r]], toEachTerm[sortByAbsence[X]]]; In[92]:= show[eqn[4.10] // format[4.10]] Out[92]= s == HoldForm[192*b^4] - HoldForm[48*b^2*HoldForm[b*r - 4]*X] + HoldForm[4*HoldForm[b^2*r^2 - 10*b*r + 5]*X^2] + HoldForm[3*r^2*X^3] In[93]:= show[eqn[4.10]] Out[93]= s == 192*b^4 - 48*b^2*(-4 + b*r)*X + 4*(5 - 10*b*r + b^2*r^2)*X^2 + 3*r^2*X^3 In[94]:= eqn[4.11] = X == a^2 - b^2; In[95]:= show[eqn[4.11]] Out[95]= X == a^2 - b^2 In[96]:= eqn[4.12] = s == 20 a^4 +152 a^2 b^2 + 20 b^4 - 8 b (5a^2 + b^2) r X + (3 a^2 + b^2) r^2 X^2; In[97]:= show[eqn[4.12]] Out[97]= s == 20*a^4 + 152*a^2*b^2 + 20*b^4 - 8*b*(5*a^2 + b^2)*r*X + (3*a^2 + b^2)*r^2*X^2 In[98]:= function[4.13] = inSuccession[ Expand, toEachTermThat[matches[192*(_) | 20*(_)]][X -> (a^2 - b^2)], toEachTermThat[matches[-40*(_) | 3*(_)]][ X^n_ -> X^(n-1)(a^2 - b^2)], collectPowersOf[X], toEachTermThat[contains[X]][Factor], toEachTermThat[doesNotContain[X]][Expand]]; In[99]:= check[4.13] = eqn[4.12] === (eqn[4.10] //" toTheRhs[function[4.13]]) Out[99]= True ----------------------------------------------------------------------- displays (4.14) and (4.15) ------------------------ In[100]:= eqn[4.14] = s == 4 (5 a^4 + 38 a^2 b^2 + 5 b^4) - 8 b (5a^2 + b^2) r X + (3 a^2 + b^2) r^2 X^2; In[101]:= show[eqn[4.14]] Out[101]= s == 4*(5*a^4 + 38*a^2*b^2 + 5*b^4) - 8*b*(5*a^2 + b^2)*r*X + (3*a^2 + b^2)*r^2*X^2 In[102]:= function[4.15] = collectivelyToTheTermsThat[doNotContain[X]][Factor]; In[103]:= check[4.15] = eqn[4.14] === (eqn[4.12] // function[4.15]) Out[103]= True ----------------------------------------------------------------------- displays (4.16) and (4.17) -------------------------- In[104]:= show[eqn[4.3] // format[4.3]] Out[104]= x^2*f[n, x] == HoldForm[HoldForm[n^2*f[n, x]] + HoldForm[n*HoldForm[n + 1]*f[HoldForm[n - 1], x]] + HoldForm[HoldForm[n - 1]*HoldForm[n + 1]*f[HoldForm[n - 1], x]] + HoldForm[n*HoldForm[n + 1]*f[HoldForm[n - 2], x]]] In[105]:= eqn[4.16] = x^2 f[n, x] == n^2 f[n, x] +(n+1)(2n-1) f[n-1, x] + n(n+1) f[n-2, x]; In[106]:= show[eqn[4.16] // format[4.3]] Out[106]= x^2*f[n, x] == HoldForm[HoldForm[n^2*f[n, x]] + HoldForm[HoldForm[n + 1]*HoldForm[2*n - 1]*f[HoldForm[n - 1], x]] + HoldForm[n*HoldForm[n + 1]*f[HoldForm[n - 2], x]]] In[107]:= show[eqn[4.16]] Out[107]= x^2*f[n, x] == n*(1 + n)*f[-2 + n, x] + (1 + n)*(-1 + 2*n)*f[-1 + n, x] + n^2*f[n, x] In[108]:= function[4.17] = collectivelyToTheTermsThat[contain[n-1]][Factor]; In[109]:= check[4.17] = eqn[4.16] === (eqn[4.3] // function[4.17] ) Out[109]= True ----------------------------------------------------------------------- displays (4.18) and (4.19) -------------------------- In[110]:= Clear[z, i, n] In[111]:= format[4.18] = toBothSides[ toEach[_Integer + _][sortByPresence[n]], collectivelyToTheFactorsThat[doNotContain[i]][HoldForm]]; In[112]:= transfm[4.18] = (2n-1)(2n+1)/z^2 (i[n-2, z] - i[n-1, z]) -> (4n^2-1)/z^2 (i[n-2, z] - i[n-1, z]); In[113]:= show[transfm[4.18] // format[4.18]] Out[113]= HoldForm[(HoldForm[2*n - 1]*HoldForm[2*n + 1])/z^2]* (i[HoldForm[n - 2], z] - i[HoldForm[n - 1], z]) -> HoldForm[HoldForm[4*n^2 - 1]/z^2]* (i[HoldForm[n - 2], z] - i[HoldForm[n - 1], z]) In[114]:= show[transfm[4.18]] Out[114]= ((-1 + 2*n)*(1 + 2*n)*(i[-2 + n, z] - i[-1 + n, z]))/z^2 -> ((-1 + 4*n^2)*(i[-2 + n, z] - i[-1 + n, z]))/z^2 In[115]:= function[4.19] = collectivelyToTheFactorsThat[doNotContain[z]][Expand]; In[116]:= check[4.19] = (transfm[4.18][[1]] // function[4.19]) === transfm[4.18][[2]] Out[116]= True ----------------------------------------------------------------------- displays (4.20) to (4.22) -------------------------- In[117]:= Clear[alpha, beta] In[118]:= format[4.20] = inSuccession[ toEach[alpha _][sortByAbsence[alpha]], toTheLhs[ toEachTerm[ collectivelyToFactorsThat[ doNotContainAny[pi, alpha, beta]][HoldForm]], sortByPresence[1/4]], toTheRhs[ toEach[2j + _][numbersLast], sortByPresence[alpha]]]; In[119]:= transfm[4.20] = 2^(2j)/4 pi alpha + 2^(2j)/2 beta -> 2^(2j-2)pi alpha + 2^(2j-1) beta; In[120]:= show[transfm[4.20] // format[4.20]] Out[120]= HoldForm[HoldForm[HoldForm[2^(2*j)/4]*pi*alpha] + beta*HoldForm[2^(2*j)/2]] -> HoldForm[HoldForm[2^HoldForm[-2 + 2*j]*pi*alpha] + 2^HoldForm[-1 + 2*j]*beta] In[121]:= show[transfm[4.20]] Out[121]= (2^(2*j)*beta)/2 + (2^(2*j)*alpha*pi)/4 -> 2^(-1 + 2*j)*beta + 2^(-2 + 2*j)*alpha*pi In[122]:= rule[4.21] = powerDown = 2^(n_) :> 2 * 2^(n-1); In[123]:= show[rule[4.21]] Out[123]= 2^(n_) :> 2*2^(n - 1) In[124]:= function[4.22] = inSuccession[toTheTermThat[contains[pi]][powerDown^2], toTheTermThat[doesNotContain[pi]][powerDown]]; In[125]:= check[4.22] = (transfm[4.20][[1]] // function[4.22]) === transfm[4.20][[2]] Out[125]= True ----------------------------------------------------------------------- displays (4.23) and (4.24) -------------------------- In[126]:= Clear[x, theta] In[127]:= format[4.23] = inSuccession[sin[x_]^2 -> (sin^2)[x], toTheRhs[sortByAbsence[P]]]; In[128]:= transfm[4.23] = (1 - cos[theta]) P[n, cos[theta]] -> 2 (sin[theta/2])^2 P[n, cos[theta]]; In[129]:= show[transfm[4.23] // format[4.23]] Out[129]= (1 - cos[theta])*P[n, cos[theta]] -> HoldForm[2*(sin^2)[theta/2]*P[n, cos[theta]]] In[130]:= show[transfm[4.23]] Out[130]= (1 - cos[theta])*P[n, cos[theta]] -> 2*P[n, cos[theta]]*sin[theta/2]^2 In[131]:= function[4.24] = toTheFactorThat[doesNotContain[P]][ cos[x_] :> 1 - 2 sin[x/2] ^2]; In[132]:= check[4.24] = (transfm[4.23][[1]] // function[4.24]) === transfm[4.23][[2]] Out[132]= True ----------------------------------------------------------------------- display (4.26) to (4.29) ------------------------ In[133]:= check[4.26] = ({toEachTerm, toTheTerm} // Union) === {toTerms[]} Out[133]= True In[134]:= check[4.27] = ({toEachTermThat, toTheTermsThat, toTheTermThat, toTerms, toTerm} // Union)=== {toTerms} Out[134]= True In[135]:= check[4.28] = ({collectivelyToTheTermsThat, collectivelyToTerms} // Union) === {collectivelyToTermsThat} Out[135]= True In[136]:= exprn[4.29a] = s = a + b + c // numberTheTerms; In[137]:= check[4.29b] = s === term[1][a] + term[2][b] + term[3][c] Out[137]= True In[138]:= check[4.29c] = (s // unnumberTheTerms) === a + b + c Out[138]= True display (5.2) to (5.4) ------------------------ In[139]:= transfm[4.23] = (1 - cos[theta]) P[n, cos[theta]] -> 2 (sin[theta/2])^2 P[n, cos[theta]]; In[140]:= function[5.2] = toThe[1 - cos[theta]][cos[x_] :> 1 - 2 sin[x/2] ^2]; In[141]:= check[5.2] = (transfm[4.23][[1]] // function[5.2]) === transfm[4.23][[2]] Out[141]= True In[142]:= eqn[5.3] = x^2 L''[n, x] == -n(n+1) L[n+1, x] + n(3n+1) L[n, x] + n(1-3n) L[n-1, x] + n(n-1) L[n-2, x]; In[143]:= format[5.3] = toTheRhs[L[n+nu_., x_] -> L[n[nu], x], to[_Integer + _][notMatching[1-3n]][numbersLast], sortOnArgumentsOf[L][descending, right], n[0] :> n, n[nu_] :> n+nu ]; In[144]:= show[eqn[5.3] // format[5.3]] Out[144]= x^2*Derivative[2][L][n, x] == HoldForm[-(n*HoldForm[n + 1]*L[n + 1, x]) + n*HoldForm[3*n + 1]*L[n, x] + (1 - 3*n)*n*L[n - 1, x] + n*HoldForm[n - 1]*L[n - 2, x]] In[145]:= show[eqn[5.3]] Out[145]= x^2*Derivative[2][L][n, x] == (-1 + n)*n*L[-2 + n, x] + (1 - 3*n)*n*L[-1 + n, x] + n*(1 + 3*n)*L[n, x] - n*(1 + n)*L[1 + n, x] In[146]:= function[5.4] = toThe[1-3n][factorOut[-1]]; In[147]:= eqn[5.3a] = eqn[5.3] // function[5.4] // ReleaseHold; In[148]:= format[5.3a] = format /. notMatching[_] -> Null; In[149]:= show[eqn[5.3a] // format[5.3a]] Out[149]= format[x^2*Derivative[2][L][n, x] == (-1 + n)*n*L[-2 + n, x] - n*(-1 + 3*n)*L[-1 + n, x] + n*(1 + 3*n)*L[n, x] - n*(1 + n)*L[1 + n, x]] In[150]:= show[eqn[5.3a]] Out[150]= x^2*Derivative[2][L][n, x] == (-1 + n)*n*L[-2 + n, x] - n*(-1 + 3*n)*L[-1 + n, x] + n*(1 + 3*n)*L[n, x] - n*(1 + n)*L[1 + n, x] display (5.5) to (5.8) ------------------------ In[151]:= show[eqn[3.6] // format[3.6]] Out[151]= z^2*i[n, z] == HoldForm[bb[HoldForm[2*n + 1]]/ bb[HoldForm[2*n - 3]]]*i[HoldForm[n - 2], z] - HoldForm[2*n - 1]*HoldForm[bb[HoldForm[2*n + 1]]/bb[HoldForm[2*n - 1]]]* i[HoldForm[n - 1], z] In[152]:= eqn[5.5] = z^2 i[n, z] == (2n-1)(2n+1) i[n-2, z] - (2n-1)(2n+1) i[n-1, z]; In[153]:= format[5.5] = toEach[_Integer + _][sortByPresence[n]]; In[154]:= show[eqn[5.5] // format[5.5]] Out[154]= z^2*i[n, z] == HoldForm[2*n - 1]*HoldForm[2*n + 1]* i[HoldForm[n - 2], z] - HoldForm[2*n - 1]*HoldForm[2*n + 1]* i[HoldForm[n - 1], z] In[155]:= show[eqn[5.5]] Out[155]= z^2*i[n, z] == (-1 + 2*n)*(1 + 2*n)*i[-2 + n, z] - (-1 + 2*n)*(1 + 2*n)*i[-1 + n, z] In[156]:= exprn[5.6] = r = bb[n_] :> n*bb[n-2]; In[157]:= function[5.7] = toTheRhs[toEach[bb[2n+1]][r]," toThe[bb[2n-1]][r]]; In[158]:= exprn[5.8] = (2n+1) bb[2n-1]/bb[2n-3] i[n-2, z] - (2n-1) (2n+1) i[n-1, z]; In[159]:= format[5.8] = inSuccession[ toEach[_Integer + _][sortByPresence[n]], toTerm[containing[bb]][ collectivelyToFactors[notContaining[i]][ sortByAbsence[bb] ]]]; In[160]:= show[exprn[5.8] // format[5.8]] Out[160]= HoldForm[(HoldForm[2*n + 1]*bb[HoldForm[2*n - 1]])/ bb[HoldForm[2*n - 3]]]*i[HoldForm[n - 2], z] - HoldForm[2*n - 1]*HoldForm[2*n + 1]*i[HoldForm[n - 1], z] In[161]:= show[exprn[5.8]] Out[161]= ((1 + 2*n)*bb[-1 + 2*n]*i[-2 + n, z])/bb[-3 + 2*n] - (-1 + 2*n)*(1 + 2*n)*i[-1 + n, z] In[162]:= check[5.7a] = exprn[5.8] === (eqn[3.6][[2]] //" function[5.7][[1]]) Out[162]= True In[163]:= check[5.7b] = eqn[5.5] === (eqn[3.6] // function[5.7]) Out[163]= True display (5.9) to (5.13) ------------------------ In[164]:= Clear[a, u, v, w] In[165]:= eqn[5.9] = {u == e(r2 - r1 + r12), v == e(r1 -r2 + r12), w == 2e(r1 + r2 -r12)}; In[166]:= eqn[5.10] = psi == a[u, v, w] exp[-1/2(u+v+w)]; In[167]:= format[5.10] = toTheArgumentOfThe[exp][ toTheNumerator[factorOut[-1]], toThe[-1/2][HoldForm]]; In[168]:= show[eqn[5.10] // format[5.10]] Out[168]= psi == a[u, v, w]*exp[HoldForm[-1/2]*HoldForm[u + v + w]] In[169]:= show[eqn[5.10]] Out[169]= psi == a[u, v, w]*exp[(-u - v - w)/2] In[170]:= eqn[5.11] = psi == aBar[r1, r2, r12] * exp[-1/2(e (r2 -r1 + r12) + e (r1 - r2 + r12) + 2 e (r1 + r2 - r12))]; In[171]:= format[5.11] = toTheArgumentOfThe[exp][ toTheNumerator[factorOut[-1]], toThe[-1/2][hold], ReleaseHold, toEach[r1 + _][sortByAbsence[r12]], toThe[-r1 + _][sortByAbsence[r12, r1]], toThe[e _ + _][sortByPresence[-r1, -r2]], hold -> HoldForm]; In[172]:= show[eqn[5.11] // format[5.11]] Out[172]= psi == aBar[r1, r2, r12]* exp[HoldForm[-1/2]*HoldForm[e*HoldForm[r2 - r1 + r12] + e*HoldForm[r1 - r2 + r12] + 2*e*HoldForm[r1 + r2 - r12]]] In[173]:= show[eqn[5.11]] Out[173]= psi == aBar[r1, r2, r12]* exp[(-(e*(r1 + r12 - r2)) - 2*e*(r1 - r12 + r2) - e*(-r1 + r12 + r2))/2] In[174]:= eqn[5.12] = psi == aBar[r1, r2, r12] exp[-e r1 - e r2]; In[175]:= function[5.13] = toThe[exp][ExpandAll]; In[176]:= check[5.12] = eqn[5.12] === (eqn[5.11] // function[5.13]) Out[176]= True displays (5.14) to (5.17) ------------------------ In[177]:= show[eqn[3.5] // format[3.5]] Out[177]= HoldForm[sqrt[2/pi]* HoldForm[z^HoldForm[n + 1/2]/bb[HoldForm[2*n + 1]]]*i[n, z]] == HoldForm[sqrt[2/pi]*HoldForm[z^HoldForm[n - HoldForm[3/2]]/ bb[HoldForm[2*n - 3]]]*i[HoldForm[n - 2], z]] - HoldForm[sqrt[2/pi]*HoldForm[2*n - 1]* HoldForm[z^HoldForm[n - HoldForm[3/2]]/bb[HoldForm[2*n - 1]]]* i[HoldForm[n - 1], z]] In[178]:= eqn[5.14] = I[n+1/2, z] == I[n-3/2, z] - (2n-1)/z I[n-1/2, z]; In[179]:= format[5.14] = inSuccession[ toEach[_. n + _] [sortByPresence[n]], toThe[1/z _][ collectivelyToFactors[{2, 4}][HoldForm], sortByAbsence[I]]]; In[180]:= show[eqn[5.14] // format[5.14]] Out[180]= I[HoldForm[n + 1/2], z] == I[HoldForm[n - HoldForm[3/2]], z] - HoldForm[HoldForm[HoldForm[2*n - 1]/z]*I[HoldForm[n - HoldForm[1/2]], z]] In[181]:= show[eqn[5.14]] Out[181]= I[1/2 + n, z] == I[-3/2 + n, z] - ((-1 + 2*n)*I[-1/2 + n, z])/z In[182]:= eqn[5.15] = i[n, z] == z^-(n+1/2) sqrt[pi/2] bb[2n+1] I[n+1/2, z]; In[183]:= format[5.15] = toTheRhs[ toThe[z^_][ toThe[-n + _][factorOut[-1], toFactor[containing[n]][hold]], hold], ReleaseHold, toEach[_. n+_][numbersLast], sortByAbsence[I, bb], hold -> HoldForm]; In[184]:= show[eqn[5.15] // format[5.15]] Out[184]= i[n, z] == HoldForm[HoldForm[z^(-HoldForm[HoldForm[n + 1/2]])]* sqrt[pi/2]*bb[HoldForm[2*n + 1]]*I[HoldForm[n + 1/2], z]] In[185]:= show[eqn[5.15]] Out[185]= i[n, z] == z^(-1/2 - n)*I[1/2 + n, z]*bb[1 + 2*n]*sqrt[pi/2] In[186]:= eqn[5.16] = sqrt[2/pi] z^(n+1/2) / bb[2(n+1/2)] i[n, z] == sqrt[2/pi] z^(n-3/2) / bb[2(n-3/2)] i[n-2, z] - sqrt[2/pi] (2n-1) z^(n-3/2) / bb[2(n-1/2)] i[n-1, z]; In[187]:= format[5.16] = inSuccession[ toEach[_. n+_][numbersLast], toEach[z^_ _][ collectivelyToFactors[containingAny[bb, z^_]][HoldForm], sortByAbsence[i, z]]]; In[188]:= show[eqn[5.16] // format[5.16]] Out[188]= HoldForm[sqrt[2/pi]* HoldForm[z^HoldForm[n + 1/2]/bb[2*HoldForm[n + 1/2]]]*i[n, z]] == HoldForm[sqrt[2/pi]*HoldForm[z^HoldForm[n - HoldForm[3/2]]/ bb[2*HoldForm[n - HoldForm[3/2]]]]*i[HoldForm[n - 2], z]] - HoldForm[HoldForm[2*n - 1]*sqrt[2/pi]* HoldForm[z^HoldForm[n - HoldForm[3/2]]/ bb[2*HoldForm[n - HoldForm[1/2]]]]*i[HoldForm[n - 1], z]] In[189]:= show[eqn[5.16]] Out[189]= (z^(1/2 + n)*i[n, z]*sqrt[2/pi])/bb[2*(1/2 + n)] == (z^(-3/2 + n)*i[-2 + n, z]*sqrt[2/pi])/bb[2*(-3/2 + n)] - ((-1 + 2*n)*z^(-3/2 + n)*i[-1 + n, z]*sqrt[2/pi])/bb[2*(-1/2 + n)] In[190]:= function[5.17] = toEach[bb][ExpandAll]; In[191]:= check[5.17] = eqn[3.5] === (eqn[5.16] // function[5.17]) Out[191]= True displays (5.18) and (5.19) -------------------------- In[192]:= eqn[5.18] = sum[{l, m, n}, 0, infinity][ A[l, m, n] * (dots[1] + (4 e v^2 L[m, v] L[n, w] + dots[2]) * (-l L[l, u] + (u-1) L'[l, u]) + dots[3]) ] == 0 ; In[193]:= format[5.18] = toTheSummand[ toThe[u-1][numbersLast], toThe[dots[2] + _][sortByAbsence[dots]], toThe[dots[1] + _][sortByPresence[dots[1], dots[2], dots[3]], dots[_] :> dots]]; In[194]:= show[eqn[5.18] // format[5.18]] Out[194]= sum[{l, m, n}, 0, infinity][A[l, m, n]* HoldForm[dots + HoldForm[4*e*v^2*L[m, v]*L[n, w] + dots]* (-(l*L[l, u]) + HoldForm[u - 1]*Derivative[1][L][l, u]) + dots]] == 0 In[195]:= show[eqn[5.18]] Out[195]= sum[{l, m, n}, 0, infinity][A[l, m, n]* (dots[1] + dots[3] + (dots[2] + 4*e*v^2*L[m, v]*L[n, w])* (-(l*L[l, u]) + (-1 + u)*Derivative[1][L][l, u]))] == 0 In[196]:= function[5.19] = toThe[(_)*(u-1)][Expand]; In[197]:= eqn[5.18a] = eqn[5.18] // function[5.19]; In[198]:= show[eqn[5.18a] // format[5.18]] Out[198]= sum[{l, m, n}, 0, infinity][A[l, m, n]* HoldForm[dots + HoldForm[4*e*v^2*L[m, v]*L[n, w] + dots]* (-(l*L[l, u]) - Derivative[1][L][l, u] + u*Derivative[1][L][l, u]) + dots]] == 0 In[199]:= show[eqn[5.18a]] Out[199]= sum[{l, m, n}, 0, infinity][A[l, m, n]* (dots[1] + dots[3] + (dots[2] + 4*e*v^2*L[m, v]*L[n, w])* (-(l*L[l, u]) - Derivative[1][L][l, u] + u*Derivative[1][L][l, u]))] " == 0 display (5.20) -------------- In[200]:= Clear[p, k, s, t] In[201]:= exprn[5.20] = 1/t^3(p[1][t] + p[2][t] exp[-2t] + p[3][t] exp[-(k+2)t] + p[4][t] E1[(k+2)t] + p[5][t] exp[-2t]E1[(k-2)t] + p[6][t] exp[-2t] E1[k t] + p[7][t] exp[-2t]E1[(k+2)t] + p[8][t] log[k/(k-2)] + p[9][t] log[(k+2)/k]); In[202]:= format[5.20] = inSuccession[ t^n_?Negative -> hold[1/hold[t^-n]], hold -> HoldForm, toEach[k+_][numbersLast], toEach[t _][sortByAbsence[t]], toFactor[containing[p]][ toEachTerm[sortByPresence[p]], sortByPresence @@ Table[ p[i][t], {i, 9}] ]]; In[203]:= show[exprn[5.20] // format[5.20]] Out[203]= HoldForm[HoldForm[t^3]^(-1)]* HoldForm[p[1][t] + HoldForm[p[2][t]*exp[-HoldForm[2*t]]] + HoldForm[p[3][t]*exp[-HoldForm[HoldForm[k + 2]*t]]] + HoldForm[p[4][t]*E1[HoldForm[HoldForm[k + 2]*t]]] + HoldForm[p[5][t]*exp[-HoldForm[2*t]]*E1[HoldForm[HoldForm[k - 2]*t]]] + HoldForm[p[6][t]*exp[-HoldForm[2*t]]*E1[HoldForm[k*t]]] + HoldForm[p[7][t]*exp[-HoldForm[2*t]]*E1[HoldForm[HoldForm[k + 2]*t]]] + HoldForm[p[8][t]*log[k/HoldForm[k - 2]]] + HoldForm[p[9][t]*log[HoldForm[k + 2]/k]]] In[204]:= show[exprn[5.20]] Out[204]= (p[1][t] + exp[-2*t]*p[2][t] + exp[-((2 + k)*t)]*p[3][t] + E1[(2 + k)*t]*p[4][t] + exp[-2*t]*E1[(-2 + k)*t]*p[5][t] + exp[-2*t]*E1[k*t]*p[6][t] + exp[-2*t]*E1[(2 + k)*t]*p[7][t] + log[k/(-2 + k)]*p[8][t] + log[(2 + k)/k]*p[9][t])/t^3 In[205]:= function[5.21] = toEach[(_) + (_.) * t^n_.][collectPowersOf[t]]; In[206]:= eqn[5.21a] = (p[#][t] == a + b t + c t + d t^2 + e t^2)& /@ {1, 2, 3, 4, 5}; In[207]:= eqn[5.21b] = (p[#][t] == a + b t^2 + c t^2 + d t^3 + e t^3)& /@ {6, 7, 8, 9}; In[208]:= show[eqn[5.21a]] Out[208]= {p[1][t] == a + b*t + c*t + d*t^2 + e*t^2, p[2][t] == a + b*t + c*t + d*t^2 + e*t^2, p[3][t] == a + b*t + c*t + d*t^2 + e*t^2, p[4][t] == a + b*t + c*t + d*t^2 + e*t^2, p[5][t] == a + b*t + c*t + d*t^2 + e*t^2} In[209]:= show[eqn[5.21b]] Out[209]= {p[6][t] == a + b*t^2 + c*t^2 + d*t^3 + e*t^3, p[7][t] == a + b*t^2 + c*t^2 + d*t^3 + e*t^3, p[8][t] == a + b*t^2 + c*t^2 + d*t^3 + e*t^3, p[9][t] == a + b*t^2 + c*t^2 + d*t^3 + e*t^3} In[210]:= exprn[5.21c] = (exprn[5.20] /. brule[5.21a] /. brule[5.21b] // function[5.21]); In[211]:= format[5.21c] = inSuccession[ t^n_?Negative -> hold[1/hold[t^-n]], hold -> HoldForm, toFactor[containing[exp]][ collectivelyToTerms[notContainingAny[exp, log, E1]][ind], toEach[k+_][numbersLast], toEach[t _][sortByAbsence[t]]]]; In[212]:= show[exprn[5.21c] // format[5.21c]] Out[212]= HoldForm[HoldForm[t^3]^(-1)]* ((a + (b + c)*t^2 + (d + e)*t^3)*exp[-HoldForm[2*t]]*E1[HoldForm[k*t]] + (a + (b + c)*t^2 + (d + e)*t^3)*exp[-HoldForm[2*t]]* E1[HoldForm[HoldForm[k + 2]*t]] + exp[-HoldForm[2*t]]*(a + (d + e)*t^2 + HoldForm[(b + c)*t]) + exp[-HoldForm[HoldForm[k + 2]*t]]* (a + (d + e)*t^2 + HoldForm[(b + c)*t]) + exp[-HoldForm[2*t]]*E1[HoldForm[HoldForm[k - 2]*t]]* (a + (d + e)*t^2 + HoldForm[(b + c)*t]) + E1[HoldForm[HoldForm[k + 2]*t]]* (a + (d + e)*t^2 + HoldForm[(b + c)*t]) + ind[a + (d + e)*t^2 + HoldForm[(b + c)*t]] + (a + (b + c)*t^2 + (d + e)*t^3)*log[k/HoldForm[k - 2]] + (a + (b + c)*t^2 + (d + e)*t^3)*log[HoldForm[k + 2]/k]) In[213]:= show[exprn[5.21c]] Out[213]= (a + (b + c)*t + (d + e)*t^2 + (a + (b + c)*t + (d + e)*t^2)*exp[-2*t] + (a + (b + c)*t + (d + e)*t^2)*exp[-((2 + k)*t)] + (a + (b + c)*t + (d + e)*t^2)*exp[-2*t]*E1[(-2 + k)*t] + (a + (b + c)*t^2 + (d + e)*t^3)*exp[-2*t]*E1[k*t] + (a + (b + c)*t + (d + e)*t^2)*E1[(2 + k)*t] + (a + (b + c)*t^2 + (d + e)*t^3)*exp[-2*t]*E1[(2 + k)*t] + (a + (b + c)*t^2 + (d + e)*t^3)*log[k/(-2 + k)] + (a + (b + c)*t^2 + (d + e)*t^3)*log[(2 + k)/k])/t^3 In[214]:= check[5.21c] = Through[{Head, Length, #[[1]]&}[exprn[5.21c]]] === {Times, 2, 1/t^3} Out[214]= True In[215]:= exprn[5.21d] = exprn[5.21c][[2]] // collectivelyToTerms[notContainingAny[exp, log, E1]][ind]; In[216]:= check[5.21d] = Through[{Head, Length}[exprn[5.21d]]] === {Plus, 9} Out[216]= True display (5.22) -------------- In[217]:= format[4.20] = inSuccession[ toEach[alpha _][sortByAbsence[alpha]], toTheLhs[ toEachTerm[ collectivelyToFactorsThat[ doNotContainAny[pi, alpha, beta]][HoldForm]], sortByPresence[1/4]], toTheRhs[ toEach[2j + _][numbersLast], sortByPresence[alpha]]]; In[218]:= transfm[4.20] = 2^(2j)/4 pi alpha + 2^(2j)/2 beta -> 2^(2j-2)pi alpha + 2^(2j-1) beta ; In[219]:= show[transfm[4.20] // format[4.20]] Out[219]= HoldForm[HoldForm[HoldForm[2^(2*j)/4]*pi*alpha] + beta*HoldForm[2^(2*j)/2]] -> HoldForm[HoldForm[2^HoldForm[-2 + 2*j]*pi*alpha] + 2^HoldForm[-1 + 2*j]*beta] In[220]:= show[rule[4.21]] Out[220]= 2^(n_) :> 2*2^(n - 1) In[221]:= function[5.22] = inSuccession[toThe[(_) pi][powerDown^2], toThe[2^(2j)][powerDown]]; In[222]:= check[5.22] = (transfm[4.20][[1]] // function[5.22]) === transfm[4.20][[2]] Out[222]= True display (5.24) to (5.26) ------------------------ In[223]:= transfm[5.24] = sum[n, 0, infinity][a[n]P[n-1, x]] + sum[n, 0, infinity][b[n] P[n, x]] + sum[n, 0, infinity][c[n]P[n+1, x]] -> sum[n, 0, infinity][a[n+1]P[n, x]] + sum[n, 0, infinity][b[n] P[n, x]] + sum[n, 0, infinity][c[n-1] P[n, x]]; In[224]:= eqn[5.24a] = {a[0] == 0, c[-1] == 0}; In[225]:= function[5.26] = inSuccession[ toThe[sum][that[contains[a]]][reindex[n, n-1], leftExpand], toThe[sum][that[contains[c]]][reindex[n, n+1], leftExtend]]; In[226]:= check[5.26] = ((transfm[5.24][[1]] // function[5.26]) /. brule[5.24a]) === transfm[5.24][[2]] Out[226]= True display (5.27) to (5.29) ------------------------ In[227]:= transfm[5.27] = sum[n, 0, infinity][sum[m, 0, infinity][ sum[l, 0, infinity][ a[l, m, n] L[l, u]]]] -> sum[l, 0, infinity][L[l, u] sum[n, 0, infinity][ sum[m, 0, infinity][a[l, m, n]]]]; In[228]:= function[5.29] = inSuccession[to[sum][2][switchOrderOfSummation], to[sum][3][moveCoefficientLeft], to[sum][1][switchOrderOfSummation], to[sum][2][moveCoefficientLeft]]; In[229]:= check[5.27] = (transfm[5.27][[1]] // function[5.29]) === transfm[5.27][[2]] Out[229]= True display (5.30) to (5.32) ------------------------ In[230]:= check[5.30] = ({toEachLog, toTheLog} // Union) === {to[log][]} Out[230]= True In[231]:= check[5.31] = ({toEachLogThat, toTheLogsThat, toTheLogThat, toLogs} // Union) === {toLog} Out[231]= True Given In[232]:= exprn[5.31a] = s = log[a] + sin[x] + log[a + b] cos[x] + log[log[a]]; then In[233]:= check[5.31b] = (s // toEachLog[G]) === G[log[a]] + cos[x] G[log[a + b]] + G[log[G[log[a]]]] + sin[x] Out[233]= True In[234]:= check[5.31c] = (s // toEachLogThat[contains[a]][G]) === G[log[a]] + cos[x] G[log[a + b]] + G[log[G[log[a]]]] + sin[x] Out[234]= True display (6.6) and (6.7) ----------------------- In[235]:= transfm[6.6] = psi == aBar[r1, r2, r12] exp[-e r1 - e r2] -> psi == aBar[r1, r2, r12] exp[-e(r1 + r2)]; In[236]:= function[6.7] = toThe[exp][toTheArgument[Factor]]; In[237]:= check[6.7] = (transfm[6.6][[1]] // function[6.7]) === transfm[6.6][[2]] Out[237]= True display (6.8) and (6.9) ----------------------- In[238]:= transfm[6.8] = a sum[k, 0, infinity][ b sin[(2j - 2k) theta/2] + c sin[(2j -2k)(theta + pi)/2]] -> a sum[k, 0, infinity][ b sin[(j - k) theta] + c sin[(j - k) theta + (j - k)pi]]; In[239]:= show[transfm[6.8]] Out[239]= a*sum[k, 0, infinity][b*sin[((2*j - 2*k)*theta)/2] + c*sin[((2*j - 2*k)*(pi + theta))/2]] -> a*sum[k, 0, infinity][b*sin[(j - k)*theta] + c*sin[(j - k)*pi + (j - k)*theta]] In[240]:= function[6.9] = inSuccession[ toThe[sin][that[doesNotContain[pi]]][toTheArgument[Factor]], toThe[sin][that[contains[pi]]][ toTheArgument[Factor, leftDistribution]]]; In[241]:= check[6.9] = (transfm[6.8][[1]] // function[6.9]) === transfm[6.8][[2]] Out[241]= True display (6.12) and (6.13) ----------------------- The functions toTheLhs, toTheRhs and toBothSides have been elaborated since the ``hadold'' account was written. To show that the definitions given there work, define In[242]:= stmt[6.13a] = toTheLhsDemo[action___] := toThe[relHeads][toArguments[1][inSuccession[action]]] In[243]:= stmt[6.13b] = toTheRhsDemo[action___] := toThe[relHeads][toArguments[2][inSuccession[action]]] In[244]:= stmt[6.13c] = toBothSidesDemo[action___] := toThe[relHeads][toArguments[{1, 2}][inSuccession[action]]] In[245]:= check[6.12] = relHeads === (Greater | GreaterEqual | Equal | LessEqual | Less | Unequal | Rule | RuleDelayed) Out[245]= True In[246]:= check[6.13d] = (f[a == b] // toTheLhsDemo[F]) === f[F[a] == b] Out[246]= True In[247]:= check[6.13e] = (a != b // toBothSidesDemo[#+x&]) === a + x != b + x Out[247]= True displays(6.14) and (6.15) ----------------------- In[248]:= check[6.14] = {toEachTermThat, toEachFactorThat} === {toTerms, toFactors} Out[248]= True In[249]:= check[6.15] = {toEachTerm, toEachFactor} === {toTerms[], toFactors[]} Out[249]= True In[250]:= check[6.15a] = ((s = # // Definition // ToString // (StringReplace[#, "bilo`Private`" -> ""]&))& /@ {toTerms, toFactors}; ; Print[s]) toFactors[innermost, selector___][action___][t_] :=" to[Times][innermost][toArguments[selector][action]][t]"n" "ntoFactors[selector___][action___][t_] := Module[{f$, n$, s$}," to[Times][outermost][toArguments[selector][action]][t] /." (f$_)[factorPiece[n$_][s$_]] :> factorPiece[n$][f$[s$]]] display (6.16) -------------- In[251]:= check[6.16] = ( (a*(b+c*(d+e)) == f[x] + g[a+h[b+c]]) // toEachTerm[F] ) == ( a*(F[b] + F[c*(d+e)]) == F[f[x]] + F[g[a + h[b+c]]] ) Out[251]= True displays (6.17) and (6.18) -------------------------- In[252]:= stmt[6.17] = toVectorElements[selector___][action___] := toThe[vector][toArguments[selector][inSuccession[action]]] In[253]:= check[6.17] = (vector[a, b, c, d, e] // toVectorElements[matching[b | d]][F]) === vector[a, F[b], c, F[d], e] Out[253]= True In[254]:= stmt[6.18] = toEachSummandThat[selector___][action___] := to[sum][selector][toTheArgument[inSuccession[action]]] In[255]:= check[6.18a] = (sum[m, 0, infinity][f] * sum[n, 0, infinity][g] // toEachSummandThat[contains[m]][G]) === sum[m, 0, infinity][G[f]] sum[n, 0, infinity][g] Out[255]= True In[256]:= (s = Definition[toTheNumerator] // InputForm // ToString // (StringReplace[#, "bilo`Private`" -> ""]&); Print[s]) toTheNumerator[action___][t_] :=" inSuccession[action][Numerator[t]]/Denominator[t] displays (6.20) --------------- In[257]:= (s = Definition[swapArguments] // InputForm // ToString // (StringReplace[#, "bilo`Private`" -> ""]&); Print[s]) swapArguments[q1_, q2_][s_] := s[[Join[Range[1, q1 - 1], {q2}, Range[q1 + 1," q2 - 1], {q1}, Range[q2 + 1, Length[s]]]]] In[258]:= check[6.20] = (f[a, b, C, d, e, f, G, h, i, j] // swapArguments[3, 7]) === f[a, b, G, d, e, f, C, h, i, j] Out[258]= True displays (6.21) to (6.25) ------------------------- In[259]:= check[6.21a] = (f[1, 2, 3, 4, 5, 6, 7, 8, 9] // collectivelyToArguments[PrimeQ[#]&][G]) === f[G[2, 3, 5, 7], 1, 4, 6, 8, 9] Out[259]= True In[260]:= check[6.21b] = (f[x[1], x[2], x[3], x[4], x[5], x[6], x[7], x[8], x[9]] // collectivelyToArguments[(#[[1]] // PrimeQ)&][G]) === f[G[x[2], x[3], x[5], x[7]], x[1], x[4], x[6], x[8], x[9]] Out[260]= True In[261]:= check[6.22a] = (f[1, 2, 3, 4] // toTheArgumentList[Reverse]) === f[{4, 3, 2, 1}] Out[261]= True In[262]:= check[6.22b] = (f[1, 2, 3, 4] // toTheArgumentList[Reverse, Apply[Sequence, #]&]) === f[4, 3, 2, 1] Out[262]= True In[263]:= check[6.23] = (f[1, 2, 3, 4, 5, 6, 7, 8, 9] // collectivelyToConsecutiveArguments[3, 6][G]) === f[1, 2, G[3, 4, 5, 6], 7, 8, 9] Out[263]= True In[264]:= check[6.24] = (Range[1, 20] // partInTwo[PrimeQ[#]&]) === {{2, 3, 5, 7, 11, 13, 17, 19}, {1, 4, 6, 8, 9, 10, 12, 14, 15, 16, 18, 20}} Out[264]= True In[265]:= check[6.25] = (Range[1, 20] // partByCriteria[IntegerQ[#/3]&, IntegerQ[#/7]&]) === {{3, 6, 9, 12, 15, 18}, {7, 14}, {1, 2, 4, 5, 8, 10, 11, 13, 16, 17, 19, 20}} Out[265]= True displays (7.1) and (7.2) ------------------------ In[266]:= exprn[7.1d] = (3 + (-1 - 2k^2) sin[x]^2) sin[x] /(3 d^3); In[267]:= show[exprn[7.1d]] Out[267]= (sin[x]*(3 + (-1 - 2*k^2)*sin[x]^2))/(3*d^3) In[268]:= function[7.2] = toTheCoefficientOfThe[sin[x]^2] [factorOut[-1]]; In[269]:= exprn[7.1e] = exprn[7.1d] // function[7.2]; In[270]:= format[7.1] = toTheNumerator[sortByPresence[k]]; In[271]:= show[exprn[7.1e] // format[7.1]] Out[271]= HoldForm[(3 - HoldForm[1 + 2*k^2]*sin[x]^2)*sin[x]]/(3*d^3) In[272]:= show[exprn[7.1e]] Out[272]= (sin[x]*(3 - HoldForm[1 + 2*k^2]*sin[x]^2))/(3*d^3) displays (7.4) to (7.6) ------------------------ In[273]:= eqn[7.4a] = J1 == integral[V][exp[-alpha ra - beta rb]]; In[274]:= eqn[7.4b] = J1 == 8 pi/(beta^3 (kappa^2 - 1)^3 tau) * ((kappa^3 tau - kappa tau - 4 kappa) exp[-tau] + (kappa^2 tau - tau + 4) exp[-kappa tau]); In[275]:= format[7.4b] = Module[{a, hold}, toTheRhs[ collectivelyToFactorsThat[doNotContain[exp]][hold], toTheArgumentOfThe[hold][ toThe[_ - 1][numbersLast], sortByAbsence[tau]], toThe[_ + a_ * (_)^3][sortByPresence[3, tau]], toThe[_ + a_ * (_)^2][sortByPresence[2, tau]], toTheFactorThat[contains[exp]][ toEachTerm[sortByAbsence[exp]], sortByPresence[exp[-tau]]], sortByPresence[hold], hold -> HoldForm ]]; In[276]:= show[eqn[7.4b] // format[7.4b]] Out[276]= J1 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^3*HoldForm[kappa^2 - 1]^3*tau)]]* HoldForm[HoldForm[HoldForm[kappa^3*tau - kappa*tau - 4*kappa]* exp[-tau]] + HoldForm[HoldForm[kappa^2*tau - tau + 4]* exp[-(kappa*tau)]]]] In[277]:= show[eqn[7.4b]] Out[277]= J1 == (8*pi*((-4*kappa - kappa*tau + kappa^3*tau)*exp[-tau] + (4 - tau + kappa^2*tau)*exp[-(kappa*tau)]))/ (beta^3*(-1 + kappa^2)^3*tau) In[278]:= check[7.4b] = (eqn[7.4b] // format[7.4b]) === pfmtd[7.4b] Out[278]= True In[279]:= eqn[7.5] = J1 == 8 pi/(beta^3 (kappa^2 - 1)^3 tau) * ((tau(kappa^3 - kappa) - 4 kappa) exp[-tau] + (tau(kappa^2 - 1) + 4) exp[-kappa tau]); In[280]:= format[7.5] = Module[{a, hold}, toTheRhs[ collectivelyToFactorsThat[doNotContain[exp]][hold], toTheArgumentOfThe[hold][ toThe[_ - 1][numbersLast], sortByAbsence[tau]], toTheFactorThat[contains[exp]][ toEachTerm[ toTheFactorThat[contains[kappa]][ toEachTermThat[contains[kappa^_]][ toTheFactorThat[contains[kappa]][ sortByPresence[kappa^_]] ], sortByPresence[tau]], sortByAbsence[exp]]], sortByPresence[hold], hold -> HoldForm ]]; In[281]:= show[eqn[7.5] // format[7.5]] Out[281]= J1 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^3*HoldForm[kappa^2 - 1]^3*tau)]]* (HoldForm[HoldForm[tau*HoldForm[kappa^3 - kappa] - 4*kappa]*exp[-tau]] + HoldForm[HoldForm[tau*HoldForm[kappa^2 - 1] + 4]* HoldForm[exp[-(kappa*tau)]]])] In[282]:= show[eqn[7.5]] Out[282]= J1 == (8*pi*((-4*kappa + (-kappa + kappa^3)*tau)*exp[-tau] + (4 + (-1 + kappa^2)*tau)*exp[-(kappa*tau)]))/ (beta^3*(-1 + kappa^2)^3*tau) In[283]:= check[7.5] = (eqn[7.5] // format[7.5]) === pfmtd[7.5] Out[283]= True In[284]:= function[7.6] = toTheCoefficientOfEach[exp][collectPowersOf[tau]]; In[285]:= check[7.6] = (eqn[7.4b] // function[7.6]) === eqn[7.5] Out[285]= True displays (7.7) to (7.9) ------------------------ In[286]:= eqn[7.7] = J1 == 8 pi/(beta^3 (kappa^2 - 1)^3 tau) * ((tau kappa (kappa - 1)(kappa + 1) - 4 kappa) exp[-tau] + (tau(kappa - 1)(kappa + 1) + 4) exp[-kappa tau]); In[287]:= format[7.7] = Module[{a, hold}, toTheRhs[ collectivelyToFactorsThat[doNotContain[exp]][hold], toTheArgumentOfThe[hold][ toThe[_ - 1][numbersLast], sortByAbsence[tau]], toTheFactorThat[contains[exp]][ toEach[kappa + _][sortByPresence[kappa]], toEachTerm[ toTheFactorThat[contains[kappa]][ toEachTermThat[contains[tau]][sortByPresence[tau]], sortByPresence[tau]], sortByAbsence[exp]]], sortByPresence[hold], hold -> HoldForm ]]; In[288]:= show[eqn[7.7] // format[7.7]] Out[288]= J1 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^3*HoldForm[kappa^2 - 1]^3*tau)]]* (HoldForm[HoldForm[HoldForm[tau*kappa*HoldForm[kappa - 1]* HoldForm[kappa + 1]] - 4*kappa]*exp[-tau]] + HoldForm[HoldForm[HoldForm[tau*HoldForm[kappa - 1]* HoldForm[kappa + 1]] + 4]*HoldForm[exp[-(kappa*tau)]]])] In[289]:= show[eqn[7.7]] Out[289]= J1 == (8*pi*((-4*kappa + (-1 + kappa)*kappa*(1 + kappa)*tau)* exp[-tau] + (4 + (-1 + kappa)*(1 + kappa)*tau)*exp[-(kappa*tau)]))/ (beta^3*(-1 + kappa^2)^3*tau) In[290]:= check[7.7] = (eqn[7.7] // format[7.7]) === pfmtd[7.7] Out[290]= True In[291]:= function[7.8] = toEachCoefficientOf[tau][Factor]; In[292]:= check[7.7] = (eqn[7.5] // function[7.8]) === eqn[7.7] Out[292]= True In[293]:= function[7.9] = toEachCoefficientOf[tau^n_.][factorIfPossible]; In[294]:= eqn[7.9a] = eqn[7.5] // function[7.9]; In[295]:= format[7.9a] = toTheRhs[ toEach[kappa + _][numbersLast], to[tau _][(Length[#] == 4)&][sortByPresence[tau]], toTheCoefficientOfEach[exp][sortByPresence[tau]], to[Plus][containing[exp]][ toEachTerm[sortByAbsence[exp]], sortByPresence[exp[-tau]]], toTheDenominator[sortByAbsence[tau]], collectivelyToFactorsThat[doNotContain[exp]][ hold], sortByPresence[hold], hold -> HoldForm]; In[296]:= show[eqn[7.9a] // format[7.9a]] Out[296]= J1 == HoldForm[HoldForm[(8*pi)/ HoldForm[beta^3*HoldForm[kappa - 1]^3*HoldForm[kappa + 1]^3*tau]]* HoldForm[HoldForm[HoldForm[HoldForm[tau*kappa*HoldForm[kappa - 1]* HoldForm[kappa + 1]] - 4*kappa]*exp[-tau]] + HoldForm[HoldForm[tau*HoldForm[kappa - 1]*HoldForm[kappa + 1] + 4]* exp[-(kappa*tau)]]]] In[297]:= show[eqn[7.9a]] Out[297]= J1 == (8*pi*((-4*kappa + (-1 + kappa)*kappa*(1 + kappa)*tau)* exp[-tau] + (4 + (-1 + kappa)*(1 + kappa)*tau)*exp[-(kappa*tau)]))/ (beta^3*(-1 + kappa)^3*(1 + kappa)^3*tau) In[298]:= check[7.9a] = (eqn[7.9a] // format[7.9a]) === pfmtd[7.9a] Out[298]= True displays (7.10) and (7.11) ------------------------ In[299]:= eqn[7.10] = sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][ c[n-2] L[n-2, w] + c[n-1] L[n-1, w] + c[n] L[n, w] + c[n+1] L[n+1, w] + c[n+2] L[n+2, w] ]]] == 0; In[300]:= format[7.10] = toSummand[3][ c[n+nu_.] -> c[n[nu]], toEach[_+_Integer][numbersLast], sortOnArgumentsOf[c][ascending, right], n[0] :> n, n[nu_] :> n+nu ]; In[301]:= show[eqn[7.10] // format[7.10]] Out[301]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][Hold" Form[c[n - 2]*L[HoldForm[n - 2], w] + c[n - 1]*L[HoldForm[n - 1], w] + c[n]*L[n, w] + c[n + 1]*L[HoldForm[n + 1], w] + c[n + 2]*L[HoldForm[n + 2], w]]]]] =" = 0 In[302]:= show[eqn[7.10]] Out[302]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][c [-2 + n]*L[-2 + n, w] + c[-1 + n]*L[-1 + n, w] + c[n]*L[n, w] + c[1 + n]*L[1 + n, w] + c[2 + n]*L[2 + n, w]]]] == 0 In[303]:= check[7.10] = (eqn[7.10] // format[7.10]) === pfmtd[7.10] Out[303]= True In[304]:= eqn[7.10a] = c[n-2] = a L[l, u] L[m, v] + b L[l-1, u] L[m+1, v]; In[305]:= eqn[7.10b] = eqn[7.10] /. brule[7.10a] // ExpandAll; In[306]:= show[eqn[7.10b] // format[7.10]] Out[306]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][Hold" Form[c[n - 1]*L[HoldForm[n - 1], w] + c[n]*L[n, w] + c[n + 1]*L[HoldForm[n + 1], w] + c[n + 2]*L[HoldForm[n + 2], w] + a*L[l, u]*L[m, v]*L[HoldForm[n - 2], w] + b*L[HoldForm[n - 2], w]*L[HoldForm[l - 1], u]*L[HoldForm[m + 1], v]]] ]] == 0 In[307]:= show[eqn[7.10b]] Out[307]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][a* L[l, u]*L[m, v]*L[-2 + n, w] + b*L[-1 + l, u]*L[1 + m, v]*L[-2 + n, w] + c[-1 + n]*L[-1 + n, w] + c[n]*L[n, w] + c[1 + n]*L[1 + n, w] + c[2 + n]*L[2 + n, w]]]] == 0 In[308]:= function[7.11] = toTheCoefficientOfEach[L[_, w]][F]; This envelopes the entire coefficient of an L of w, including the L's of u and v. In[309]:= eqn[7.10c] = eqn[7.10b] // function[7.11]; In[310]:= show[eqn[7.10c] // format[7.10]] Out[310]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][Hold" Form[F[c[n - 1]]*L[HoldForm[n - 1], w] + F[c[n]]*L[n, w] + F[c[n + 1]]*L[HoldForm[n + 1], w] + F[c[n + 2]]*L[HoldForm[n + 2], w] + F[a*L[l, u]*L[m, v]]*L[HoldForm[n - 2], w] + F[b*L[HoldForm[l - 1], u]*L[HoldForm[m + 1], v]]* L[HoldForm[n - 2], w]]]]] == 0 In[311]:= show[eqn[7.10c]] Out[311]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][F [a*L[l, u]*L[m, v]]*L[-2 + n, w] + F[b*L[-1 + l, u]*L[1 + m, v]]*L[-2 + n, w] + F[c[-1 + n]]*L[-1 + n, w] + F[c[n]]*L[n, w] + F[c[1 + n]]*L[1 + n, w] + F[c[2 + n]]*L[2 + n, w]]]] == 0 In contrast, by using L[__], only the part of a term that is independent of the L's gets enveloped. In[312]:= eqn[7.10d] = eqn[7.10b] // toTheCoefficientOfEach[L[__]][F]; In[313]:= show[eqn[7.10d] // format[7.10]] Out[313]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][Hold" Form[F[c[n - 1]]*L[HoldForm[n - 1], w] + F[c[n]]*L[n, w] + F[c[n + 1]]*L[HoldForm[n + 1], w] + F[c[n + 2]]*L[HoldForm[n + 2], w] + F[a]*L[l, u]*L[m, v]*L[HoldForm[n - 2], w] + F[b]*L[HoldForm[n - 2], w]*L[HoldForm[l - 1], u]* L[HoldForm[m + 1], v]]]]] == 0 In[314]:= show[eqn[7.10d]] Out[314]= sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][F[ a]*L[l, u]*L[m, v]*L[-2 + n, w] + F[b]*L[-1 + l, u]*L[1 + m, v]*L[-2 + n, w] + F[c[-1 + n]]*L[-1 + n, w] + F[c[n]]*L[n, w] + F[c[1 + n]]*L[1 + n, w] + F[c[2 + n]]*L[2 + n, w]]]] == 0 displays (7.12) and (7.13) ------------------------ In[315]:= eqn[7.12, pre] = J13 == 8 pi/(beta^5 (kappa^2 - 1)^5 tau) * ((3 kappa^6 tau^2 -40 kappa^4 tau - 5 kappa^4 tau^2 + 20 kappa^4 + kappa^2 tau^2 + 152 kappa^2 + 32 kappa^2 tau + tau^2 + 8 tau + 20) * exp[-tau] + (-kappa^6 tau^2 -8 kappa^5 tau - kappa^4 tau^2 -20 kappa^4 - 32 kappa^3 tau + 5 kappa^2 tau^2 -152 kappa^2 + 40 kappa tau - 3 tau^2 - 20 ) exp[-kappa tau]); In[316]:= format[7.12, pre] = toTheRhs[ collectivelyToFactorsThat[doNotContain[exp]][hold], toTheArgumentOfThe[hold][ toThe[_ - 1][numbersLast], sortByAbsence[tau]], sortByPresence[hold], hold -> HoldForm ]; In[317]:= show[eqn[7.12, pre] // format[7.12, pre]] Out[317]= J13 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^5*HoldForm[kappa^2 - 1]^5*tau)]]* ((20 + 152*kappa^2 + 20*kappa^4 + 8*tau + 32*kappa^2*tau - 40*kappa^4*tau + tau^2 + kappa^2*tau^2 - 5*kappa^4*tau^2 + 3*kappa^6*tau^2)*exp[-tau] + (-20 - 152*kappa^2 - 20*kappa^4 + 40*kappa*tau - 32*kappa^3*tau - 8*kappa^5*tau - 3*tau^2 + 5*kappa^2*tau^2 - kappa^4*tau^2 - kappa^6*tau^2)*exp[-(kappa*tau)])] In[318]:= show[eqn[7.12, pre]] Out[318]= J13 == (8*pi*((20 + 152*kappa^2 + 20*kappa^4 + 8*tau + 32*kappa^2*tau - 40*kappa^4*tau + tau^2 + kappa^2*tau^2 - 5*kappa^4*tau^2 + 3*kappa^6*tau^2)*exp[-tau] + (-20 - 152*kappa^2 - 20*kappa^4 + 40*kappa*tau - 32*kappa^3*tau - 8*kappa^5*tau - 3*tau^2 + 5*kappa^2*tau^2 - kappa^4*tau^2 - kappa^6*tau^2)*exp[-(kappa*tau)]))/(beta^5*(-1 + kappa^2)^5*tau) In[319]:= function[7.13] = toTheCoefficientOfEach[exp][ collectPowersOf[tau], toTheCoefficientOfEach[tau^n_.][Factor], toEach[-kappa + _][factorOut[-1]]]; In[320]:= eqn[7.12] = eqn[7.12, pre] // function[7.13]; In[321]:= format[7.12] = toTheRhs[ HoldForm -> Identity, toEach[_Integer + _. kappa^_.][sortByPresence[kappa]], collectivelyToFactorsThat[doNotContain[exp]][ sortByAbsence[tau], hold[0]], toTheCoefficientOfEach[exp][ toEachTermThat[contains[tau]][ collectivelyToTheFactorsThat[contain[kappa]][hold[1]], collectivelyToTheFactorsThat[containAny[kappa, tau]][hold[2]]], sortByAbsence[tau^2, tau]], toTheCoefficientOfThe[hold[0]][ toEachTerm[sortByAbsence[exp]], sortByPresence[exp[-tau]]], sortByPresence[hold[0]], hold[_] -> HoldForm ]; In[322]:= show[eqn[7.12] // format[7.12]] Out[322]= J13 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^5*HoldForm[kappa^2 - 1]^5*tau)]]* HoldForm[HoldForm[HoldForm[20 + 152*kappa^2 + 20*kappa^4 - 8*HoldForm[tau*HoldForm[HoldForm[kappa - 1]*HoldForm[kappa + 1]* HoldForm[5*kappa^2 + 1]]] + HoldForm[tau^2*HoldForm[HoldForm[kappa - 1]^2* HoldForm[kappa + 1]^2*HoldForm[3*kappa^2 + 1]]]]*exp[-tau]] + HoldForm[HoldForm[-20 - 152*kappa^2 - 20*kappa^4 - 8*HoldForm[tau*HoldForm[kappa*HoldForm[kappa - 1]* HoldForm[kappa + 1]*HoldForm[kappa^2 + 5]]] - HoldForm[tau^2*HoldForm[HoldForm[kappa - 1]^2* HoldForm[kappa + 1]^2*HoldForm[kappa^2 + 3]]]]* exp[-(kappa*tau)]]]] In[323]:= show[eqn[7.12]] Out[323]= J13 == (8*pi*(exp[-(kappa*tau)]* (-20 - 152*kappa^2 - 20*kappa^4 - (-1 + kappa)^2*(1 + kappa)^2*(3 + kappa^2)*tau^2 - 8*kappa*(1 + kappa)*(5 + kappa^2)*tau*HoldForm[-1 + kappa]) + exp[-tau]*(20 + 152*kappa^2 + 20*kappa^4 + (-1 + kappa)^2*(1 + kappa)^2*(1 + 3*kappa^2)*tau^2 - 8*(-1 + kappa)*(1 + 5*kappa^2)*tau*HoldForm[1 + kappa])))/ (beta^5*(-1 + kappa^2)^5*tau) In[324]:= check[7.12] = (eqn[7.12] // format[7.12]) === pfmtd[7.12] Out[324]= True Alternatively, In[325]:= function[7.13, alt] = Module[{a}, toTheCoefficientOfEach[exp][ collectPowersOf[tau], toTheCoefficientOfEach[tau^n_.][Factor], a_ (-kappa+b_) -> -a (kappa-b)]]; In[326]:= eqn[7.12, alt] = eqn[7.12, pre] // function[7.13, alt]; In[327]:= show[eqn[7.12, alt] // format[7.12]] Out[327]= J13 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^5*HoldForm[kappa^2 - 1]^5*tau)]]* HoldForm[HoldForm[HoldForm[20 + 152*kappa^2 + 20*kappa^4 - 8*HoldForm[tau*HoldForm[HoldForm[kappa - 1]*HoldForm[kappa + 1]* HoldForm[5*kappa^2 + 1]]] + HoldForm[tau^2*HoldForm[HoldForm[kappa - 1]^2* HoldForm[kappa + 1]^2*HoldForm[3*kappa^2 + 1]]]]*exp[-tau]] + HoldForm[HoldForm[-20 - 152*kappa^2 - 20*kappa^4 - 8*HoldForm[tau*HoldForm[kappa*HoldForm[kappa - 1]* HoldForm[kappa + 1]*HoldForm[kappa^2 + 5]]] - HoldForm[tau^2*HoldForm[HoldForm[kappa - 1]^2* HoldForm[kappa + 1]^2*HoldForm[kappa^2 + 3]]]]* exp[-(kappa*tau)]]]] In[328]:= show[eqn[7.12, alt]] Out[328]= J13 == (8*pi*((20 + 152*kappa^2 + 20*kappa^4 - 8*(-1 + kappa)*(1 + kappa)*(1 + 5*kappa^2)*tau + (-1 + kappa)^2*(1 + kappa)^2*(1 + 3*kappa^2)*tau^2)*exp[-tau] + (-20 - 152*kappa^2 - 20*kappa^4 - 8*(-1 + kappa)*kappa*(1 + kappa)*(5 + kappa^2)*tau - (-1 + kappa)^2*(1 + kappa)^2*(3 + kappa^2)*tau^2)* exp[-(kappa*tau)]))/(beta^5*(-1 + kappa^2)^5*tau) In[329]:= check[7.12, alt, 2] = (eqn[7.12, alt] // ReleaseHold // ExpandAll) === (eqn[7.12] // ReleaseHold // ExpandAll) Out[329]= True In[330]:= function[7.16] = toTheCoefficientOfEach[exp][ collectPowersOf[tau], toTheCoefficientsOfPowersOf[tau][Factor], toEach[-kappa + _][factorOut[-1]]]; In[331]:= eqn[7.16a] = eqn[7.12, pre] // function[7.16]; In[332]:= show[eqn[7.16a] // format[7.12]] Out[332]= J13 == HoldForm[HoldForm[HoldForm[(8*pi)/ (beta^5*HoldForm[kappa^2 - 1]^5*tau)]]* HoldForm[HoldForm[HoldForm[4*(5 + 38*kappa^2 + 5*kappa^4) - 8*HoldForm[tau*HoldForm[HoldForm[kappa - 1]*HoldForm[kappa + 1]* HoldForm[5*kappa^2 + 1]]] + HoldForm[tau^2*HoldForm[HoldForm[kappa - 1]^2* HoldForm[kappa + 1]^2*HoldForm[3*kappa^2 + 1]]]]*exp[-tau]] + HoldForm[HoldForm[-4*(5 + 38*kappa^2 + 5*kappa^4) - 8*HoldForm[tau*HoldForm[kappa*HoldForm[kappa - 1]* HoldForm[kappa + 1]*HoldForm[kappa^2 + 5]]] - HoldForm[tau^2*HoldForm[HoldForm[kappa - 1]^2* HoldForm[kappa + 1]^2*HoldForm[kappa^2 + 3]]]]* exp[-(kappa*tau)]]]] In[333]:= show[eqn[7.16a]] Out[333]= J13 == (8*pi*(exp[-(kappa*tau)]* (-4*(5 + 38*kappa^2 + 5*kappa^4) - (-1 + kappa)^2*(1 + kappa)^2*(3 + kappa^2)*tau^2 - 8*kappa*(1 + kappa)*(5 + kappa^2)*tau*HoldForm[-1 + kappa]) + exp[-tau]*(4*(5 + 38*kappa^2 + 5*kappa^4) + (-1 + kappa)^2*(1 + kappa)^2*(1 + 3*kappa^2)*tau^2 - 8*(-1 + kappa)*(1 + 5*kappa^2)*tau*HoldForm[1 + kappa])))/ (beta^5*(-1 + kappa^2)^5*tau) In[334]:= check[7.16a] = (eqn[7.16a] // format[7.12]) === pfmtd[7.16a] Out[334]= True displays (8.1) to (8.4) ----------------------- In[335]:= exprn[8.1] = s = n(n+1)(n+2)/6; In[336]:= exprn[8.2] = s // toEachFactor[numbersLast]; In[337]:= show[exprn[8.1]] Out[337]= (n*(1 + n)*(2 + n))/6 In[338]:= show[exprn[8.2]] Out[338]= (n*HoldForm[n + 1]*HoldForm[n + 2])/6 In[339]:= check[8.2] = exprn[8.2] === pfmtd[8.2] Out[339]= True --------------------------------------------------------------------- In[340]:= opc = Identity; In[341]:= {Length[checkList], Union[checkList], Plus @@ checkList} Out[341]= {339, {Null, shown, True}, 166*Null + 103*shown + 70*True} In[342]:= Complement[Range[Length[checkList]], Position[checkList, #, 1]& /@ {True, Null, shown} // Flatten] Out[342]= {} In[343]:= localList[localName] = checkList;