* Validation file hadold.test for * * HIERARCHICAL ADDRESSING IN bilo * ------------------------------- * * displays (1.1), (1.2) and (2.3) * ------------------------------- < exp[u + v]); * * then check[2.7] = (exp[a] exp[b] + exp[c] exp[d] /. r) === exp[a + b] + exp[c + d] * * ---------------------------------------------------------------- * * display (2.8) * ------------- Clear[u, v, b, c, d, e, f, g, x, y] 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) * * ---------------------------------------------------------------- * * display (2.9) and (2.10) * ------------------------ Clear[x, y, z, f1, f2, fn, s] check[2.9] = inSuccession[f1, f2, dots, fn][s] === (s // f1 // f2 // dots // fn) Clear[a, b, c, d, x, y, z] check[2.10] = (exp[x] (exp[y] + exp[z]) // inSuccession[Expand, r]) === exp[x + y] + exp[x + z] * * ---------------------------------------------------------------- * * 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. Clear[b, c, k, n, q, s, ss] transfm[3.2] = (c^(k-n) - b^(k-n)) q[n] / (k - n) -> (b^(k-n) - c^(k-n))q[n]/(n-k); format[3.2] = inSuccession[ toThe[c^_ + _][sortByPresence[c]], toThe[n-k][sortByPresence[n]]]; show[transfm[3.2] // format[3.2]] show[transfm[3.2]] function[3.3] = toTheNumeratorAndDenominator[factorOut[-1]]; show[transfm[3.2][[1]] // function[3.3]] show[transfm[3.2][[1]] // function[3.3] // ReleaseHold // format[3.2][[1]]] check[3.3] = (transfm[3.2][[1]] // function[3.3] // ReleaseHold) === transfm[3.2][[2]] * * ---------------------------------------------------------------- * * displays (3.5)-(3.8) * -------------------- Clear[z, i, n] 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]); format[3.5] = inSuccession[ toEach[n + _ | 2n + _][sortByPresence[n]], to[Times][outermost][ collectivelyToFactorsThat[containAny[z^_, bb]][hold], sortByAbsence[i, hold, n], hold -> HoldForm ]]; show[eqn[3.5] // format[3.5]] show[eqn[3.5]] 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]; format[3.6] = inSuccession[toEachTerm[toEach[n + _ | 2n + _][sortByPresence[n]], collectivelyToFactorsThat[contain[bb]][HoldForm]]]; show[eqn[3.6] // format[3.6]] show[eqn[3.6]] function[3.7] = inSuccession[ toBothSides[times[z^(3/2-n) sqrt[pi/2] bb[2n+1]]], toTheRhs[Distribute], sqrtSimplify]; check[3.7] = eqn[3.6] === (eqn[3.5] // function[3.7]) function[3.8] = toBothSides[times[z^(3/2-n) sqrt[pi/2] bb[2n+1]], Distribute, sqrtSimplify]; check[3.8] = eqn[3.6] === (eqn[3.5] // function[3.8]) * * ---------------------------------------------------------------- * * displays (3.9)-(3.16) * --------------------- Clear[u, v, a, b, exp, log] eqn[1] = u == exp[a]; eqn[2] = v == exp[b]; eqn[3] = exp[a + b] == exp[a] exp[b]; eqn[4] = log == InverseFunction[exp]; brule[4] === (log :> InverseFunction[exp]) function[3.13] = localFunction = inSuccession[toBothSides[log], toTheRhs[brule[4]]]; check[3.14a] = (eqn[5] = eqn[1] // function[3.13]) === (log[u] == a) check[3.14b] = (eqn[6] = eqn[2] // function[3.13]) === (log[v] == b) check[3.15] = {bruleReverse[1], bruleReverse[2], bruleReverse[5], bruleReverse[6]} === {exp[a] :> u, exp[b] :> v, a :> log[u], b :> log[v]} 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]) * * ---------------------------------------------------------------- * * displays (4.1)-(4.2) * -------------------- eqn[4.1] = x f[n, x] == n f[n, x] + (n+1) f[n-1, x]; format[4.1] = inSuccession[toTheRhs[toEach[n+_][sortByPresence[n]], toEachTerm[sortByAbsence[f]]]]; show[eqn[4.1] // format[4.1]] show[eqn[4.1]] format[4.2] = toTheRhs[toEach[n+_][sortByPresence[n]], toEach[_ f[__]][sortByAbsence[f]], to[Plus][containing[HoldForm[n-2]], innermost][ sortByAbsence[-2]]]; eqn[4.2] = eqn[4.1] // toBothSides[times[x], Distribute, grule[4.1]]; 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])) show[eqn[4.2] // format[4.2]] show[eqn[4.2]] format[4.3] = toTheRhs[toEach[_?IntegerQ + _][sortByPresence[n]], toEachTerm[sortByAbsence[f, 2n]], sortByAbsence[-2]]; 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]; show[eqn[4.3] // format[4.3]] show[eqn[4.3]] function[4.4] = toTheRhs[toEachTerm[leftDistribution]]; check[4.4] = (eqn[4.2] // function[4.4]) === eqn[4.3] * * ----------------------------------------------------------------------- * * displays (4.5) and (4.6) * ------------------------ Clear[theta, a, b, c] 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]]; 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]]]; show[eqn[4.5] // format[4.5]] show[eqn[4.5]] function[4.6] = toEachTermThat[doesNotContain[P]][ cos[theta] -> 1 - 2 sin[theta/2]^2, collectPowersOf[sin[theta/2]]]; eqn[4.6a] = eqn[4.5] // function[4.6]; format[4.6] = Module[{a, b}, inSuccession[ toTheRhs[log[a_] P[b__] :> HoldForm[P[b] log[a]], sortByAbsence[log]]]]; show[eqn[4.6a] // format[4.6]] show[eqn[4.6a]] eqn[4.6b] = eqn[4.6a] // toTheRhs[Expand, collectPowersOf[sin[theta/2]]]; show[eqn[4.6b] // format[4.6]] show[eqn[4.6b]] * * ----------------------------------------------------------------------- * * 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. 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])]; 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]; show[eqn[4.7] // format[4.7]] show[eqn[4.7]] evaln[P][s_] := s /. P[n_, x_] -> LegendreP[n, x] function[4.8] = toEachTermThat[doesNotContain[log]][evaln[P]]; eqn[4.8a] = eqn[4.7] // function[4.8]; format[4.8] = toTheRhs[toTerm[containing[P]][sortByAbsence[log]], sortByAbsence[log]]; show[eqn[4.8a] // format[4.8]] show[eqn[4.8a]] tidier = toTheRhs[ toTerms[notContaining[log]][ cos[theta] -> 1 - 2 sin[theta/2]^2], collectPowersOf[sin[theta/2]], Expand]; eqn[4.8b] = eqn[4.8a] // tidier; show[eqn[4.8b] // format[4.8]] show[eqn[4.8b]] * * ----------------------------------------------------------------------- * * displays (4.10) to (4.13) * ------------------------ Clear[s, a, b, r, X] 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; format[4.10] = toTheRhs[toEach[_Integer + _][sortByPresence[r^2, r]], toEachTerm[sortByAbsence[X]]]; show[eqn[4.10] // format[4.10]] show[eqn[4.10]] eqn[4.11] = X == a^2 - b^2; show[eqn[4.11]] 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; show[eqn[4.12]] 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]]; check[4.13] = eqn[4.12] === (eqn[4.10] // toTheRhs[function[4.13]]) * * ----------------------------------------------------------------------- * * displays (4.14) and (4.15) * ------------------------ 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; show[eqn[4.14]] function[4.15] = collectivelyToTheTermsThat[doNotContain[X]][Factor]; check[4.15] = eqn[4.14] === (eqn[4.12] // function[4.15]) * * ----------------------------------------------------------------------- * * displays (4.16) and (4.17) * -------------------------- show[eqn[4.3] // format[4.3]] 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]; show[eqn[4.16] // format[4.3]] show[eqn[4.16]] function[4.17] = collectivelyToTheTermsThat[contain[n-1]][Factor]; check[4.17] = eqn[4.16] === (eqn[4.3] // function[4.17] ) * * ----------------------------------------------------------------------- * * displays (4.18) and (4.19) * -------------------------- Clear[z, i, n] format[4.18] = toBothSides[ toEach[_Integer + _][sortByPresence[n]], collectivelyToTheFactorsThat[doNotContain[i]][HoldForm]]; 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]); show[transfm[4.18] // format[4.18]] show[transfm[4.18]] function[4.19] = collectivelyToTheFactorsThat[doNotContain[z]][Expand]; check[4.19] = (transfm[4.18][[1]] // function[4.19]) === transfm[4.18][[2]] * * ----------------------------------------------------------------------- * * displays (4.20) to (4.22) * -------------------------- Clear[alpha, beta] 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]]]; transfm[4.20] = 2^(2j)/4 pi alpha + 2^(2j)/2 beta -> 2^(2j-2)pi alpha + 2^(2j-1) beta; show[transfm[4.20] // format[4.20]] show[transfm[4.20]] rule[4.21] = powerDown = 2^(n_) :> 2 * 2^(n-1); show[rule[4.21]] function[4.22] = inSuccession[toTheTermThat[contains[pi]][powerDown^2], toTheTermThat[doesNotContain[pi]][powerDown]]; check[4.22] = (transfm[4.20][[1]] // function[4.22]) === transfm[4.20][[2]] * * ----------------------------------------------------------------------- * * displays (4.23) and (4.24) * -------------------------- Clear[x, theta] format[4.23] = inSuccession[sin[x_]^2 -> (sin^2)[x], toTheRhs[sortByAbsence[P]]]; transfm[4.23] = (1 - cos[theta]) P[n, cos[theta]] -> 2 (sin[theta/2])^2 P[n, cos[theta]]; show[transfm[4.23] // format[4.23]] show[transfm[4.23]] function[4.24] = toTheFactorThat[doesNotContain[P]][ cos[x_] :> 1 - 2 sin[x/2] ^2]; check[4.24] = (transfm[4.23][[1]] // function[4.24]) === transfm[4.23][[2]] * * ----------------------------------------------------------------------- * * display (4.26) to (4.29) * ------------------------ check[4.26] = ({toEachTerm, toTheTerm} // Union) === {toTerms[]} check[4.27] = ({toEachTermThat, toTheTermsThat, toTheTermThat, toTerms, toTerm} // Union)=== {toTerms} check[4.28] = ({collectivelyToTheTermsThat, collectivelyToTerms} // Union) === {collectivelyToTermsThat} exprn[4.29a] = s = a + b + c // numberTheTerms; check[4.29b] = s === term[1][a] + term[2][b] + term[3][c] check[4.29c] = (s // unnumberTheTerms) === a + b + c * ----------------------------------------------------------------------- * * display (5.2) to (5.4) * ------------------------ transfm[4.23] = (1 - cos[theta]) P[n, cos[theta]] -> 2 (sin[theta/2])^2 P[n, cos[theta]]; function[5.2] = toThe[1 - cos[theta]][cos[x_] :> 1 - 2 sin[x/2] ^2]; check[5.2] = (transfm[4.23][[1]] // function[5.2]) === transfm[4.23][[2]] 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]; 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 ]; show[eqn[5.3] // format[5.3]] show[eqn[5.3]] function[5.4] = toThe[1-3n][factorOut[-1]]; eqn[5.3a] = eqn[5.3] // function[5.4] // ReleaseHold; format[5.3a] = format /. notMatching[_] -> Null; show[eqn[5.3a] // format[5.3a]] show[eqn[5.3a]] * ----------------------------------------------------------------------- * * display (5.5) to (5.8) * ------------------------ show[eqn[3.6] // format[3.6]] eqn[5.5] = z^2 i[n, z] == (2n-1)(2n+1) i[n-2, z] - (2n-1)(2n+1) i[n-1, z]; format[5.5] = toEach[_Integer + _][sortByPresence[n]]; show[eqn[5.5] // format[5.5]] show[eqn[5.5]] exprn[5.6] = r = bb[n_] :> n*bb[n-2]; function[5.7] = toTheRhs[toEach[bb[2n+1]][r], toThe[bb[2n-1]][r]]; exprn[5.8] = (2n+1) bb[2n-1]/bb[2n-3] i[n-2, z] - (2n-1) (2n+1) i[n-1, z]; format[5.8] = inSuccession[ toEach[_Integer + _][sortByPresence[n]], toTerm[containing[bb]][ collectivelyToFactors[notContaining[i]][ sortByAbsence[bb] ]]]; show[exprn[5.8] // format[5.8]] show[exprn[5.8]] check[5.7a] = exprn[5.8] === (eqn[3.6][[2]] // function[5.7][[1]]) check[5.7b] = eqn[5.5] === (eqn[3.6] // function[5.7]) * ----------------------------------------------------------------------- * * display (5.9) to (5.13) * ------------------------ Clear[a, u, v, w] eqn[5.9] = {u == e(r2 - r1 + r12), v == e(r1 -r2 + r12), w == 2e(r1 + r2 -r12)}; eqn[5.10] = psi == a[u, v, w] exp[-1/2(u+v+w)]; format[5.10] = toTheArgumentOfThe[exp][ toTheNumerator[factorOut[-1]], toThe[-1/2][HoldForm]]; show[eqn[5.10] // format[5.10]] show[eqn[5.10]] eqn[5.11] = psi == aBar[r1, r2, r12] * exp[-1/2(e (r2 -r1 + r12) + e (r1 - r2 + r12) + 2 e (r1 + r2 - r12))]; 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]; show[eqn[5.11] // format[5.11]] show[eqn[5.11]] eqn[5.12] = psi == aBar[r1, r2, r12] exp[-e r1 - e r2]; function[5.13] = toThe[exp][ExpandAll]; check[5.12] = eqn[5.12] === (eqn[5.11] // function[5.13]) * ----------------------------------------------------------------------- * * displays (5.14) to (5.17) * ------------------------ show[eqn[3.5] // format[3.5]] eqn[5.14] = I[n+1/2, z] == I[n-3/2, z] - (2n-1)/z I[n-1/2, z]; format[5.14] = inSuccession[ toEach[_. n + _] [sortByPresence[n]], toThe[1/z _][ collectivelyToFactors[{2, 4}][HoldForm], sortByAbsence[I]]]; show[eqn[5.14] // format[5.14]] show[eqn[5.14]] eqn[5.15] = i[n, z] == z^-(n+1/2) sqrt[pi/2] bb[2n+1] I[n+1/2, z]; format[5.15] = toTheRhs[ toThe[z^_][ toThe[-n + _][factorOut[-1], toFactor[containing[n]][hold]], hold], ReleaseHold, toEach[_. n+_][numbersLast], sortByAbsence[I, bb], hold -> HoldForm]; show[eqn[5.15] // format[5.15]] show[eqn[5.15]] 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]; format[5.16] = inSuccession[ toEach[_. n+_][numbersLast], toEach[z^_ _][ collectivelyToFactors[containingAny[bb, z^_]][HoldForm], sortByAbsence[i, z]]]; show[eqn[5.16] // format[5.16]] show[eqn[5.16]] function[5.17] = toEach[bb][ExpandAll]; check[5.17] = eqn[3.5] === (eqn[5.16] // function[5.17]) * ----------------------------------------------------------------------- * * displays (5.18) and (5.19) * -------------------------- 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 ; 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]]; show[eqn[5.18] // format[5.18]] show[eqn[5.18]] function[5.19] = toThe[(_)*(u-1)][Expand]; eqn[5.18a] = eqn[5.18] // function[5.19]; show[eqn[5.18a] // format[5.18]] show[eqn[5.18a]] * ----------------------------------------------------------------------- * * display (5.20) * -------------- Clear[p, k, s, t] 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]); 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}] ]]; show[exprn[5.20] // format[5.20]] show[exprn[5.20]] function[5.21] = toEach[(_) + (_.) * t^n_.][collectPowersOf[t]]; eqn[5.21a] = (p[#][t] == a + b t + c t + d t^2 + e t^2)& /@ {1, 2, 3, 4, 5}; eqn[5.21b] = (p[#][t] == a + b t^2 + c t^2 + d t^3 + e t^3)& /@ {6, 7, 8, 9}; show[eqn[5.21a]] show[eqn[5.21b]] exprn[5.21c] = (exprn[5.20] /. brule[5.21a] /. brule[5.21b] // function[5.21]); 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]]]]; show[exprn[5.21c] // format[5.21c]] show[exprn[5.21c]] check[5.21c] = Through[{Head, Length, #[[1]]&}[exprn[5.21c]]] === {Times, 2, 1/t^3} exprn[5.21d] = exprn[5.21c][[2]] // collectivelyToTerms[notContainingAny[exp, log, E1]][ind]; check[5.21d] = Through[{Head, Length}[exprn[5.21d]]] === {Plus, 9} * ----------------------------------------------------------------------- * * display (5.22) * -------------- 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]]]; transfm[4.20] = 2^(2j)/4 pi alpha + 2^(2j)/2 beta -> 2^(2j-2)pi alpha + 2^(2j-1) beta ; show[transfm[4.20] // format[4.20]] show[rule[4.21]] function[5.22] = inSuccession[toThe[(_) pi][powerDown^2], toThe[2^(2j)][powerDown]]; check[5.22] = (transfm[4.20][[1]] // function[5.22]) === transfm[4.20][[2]] * ----------------------------------------------------------------------- * * display (5.24) to (5.26) * ------------------------ 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]]; eqn[5.24a] = {a[0] == 0, c[-1] == 0}; function[5.26] = inSuccession[ toThe[sum][that[contains[a]]][reindex[n, n-1], leftExpand], toThe[sum][that[contains[c]]][reindex[n, n+1], leftExtend]]; check[5.26] = ((transfm[5.24][[1]] // function[5.26]) /. brule[5.24a]) === transfm[5.24][[2]] * ----------------------------------------------------------------------- * * display (5.27) to (5.29) * ------------------------ 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]]]]; function[5.29] = inSuccession[to[sum][2][switchOrderOfSummation], to[sum][3][moveCoefficientLeft], to[sum][1][switchOrderOfSummation], to[sum][2][moveCoefficientLeft]]; check[5.27] = (transfm[5.27][[1]] // function[5.29]) === transfm[5.27][[2]] * ----------------------------------------------------------------------- * * display (5.30) to (5.32) * ------------------------ check[5.30] = ({toEachLog, toTheLog} // Union) === {to[log][]} check[5.31] = ({toEachLogThat, toTheLogsThat, toTheLogThat, toLogs} // Union) === {toLog} * * Given exprn[5.31a] = s = log[a] + sin[x] + log[a + b] cos[x] + log[log[a]]; * * then check[5.31b] = (s // toEachLog[G]) === G[log[a]] + cos[x] G[log[a + b]] + G[log[G[log[a]]]] + sin[x] check[5.31c] = (s // toEachLogThat[contains[a]][G]) === G[log[a]] + cos[x] G[log[a + b]] + G[log[G[log[a]]]] + sin[x] * ----------------------------------------------------------------------- * * display (6.6) and (6.7) * ----------------------- transfm[6.6] = psi == aBar[r1, r2, r12] exp[-e r1 - e r2] -> psi == aBar[r1, r2, r12] exp[-e(r1 + r2)]; function[6.7] = toThe[exp][toTheArgument[Factor]]; check[6.7] = (transfm[6.6][[1]] // function[6.7]) === transfm[6.6][[2]] * ----------------------------------------------------------------------- * * display (6.8) and (6.9) * ----------------------- 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]]; show[transfm[6.8]] function[6.9] = inSuccession[ toThe[sin][that[doesNotContain[pi]]][toTheArgument[Factor]], toThe[sin][that[contains[pi]]][ toTheArgument[Factor, leftDistribution]]]; check[6.9] = (transfm[6.8][[1]] // function[6.9]) === transfm[6.8][[2]] * ----------------------------------------------------------------------- * * 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 stmt[6.13a] = toTheLhsDemo[action___] := toThe[relHeads][toArguments[1][inSuccession[action]]] stmt[6.13b] = toTheRhsDemo[action___] := toThe[relHeads][toArguments[2][inSuccession[action]]] stmt[6.13c] = toBothSidesDemo[action___] := toThe[relHeads][toArguments[{1, 2}][inSuccession[action]]] check[6.12] = relHeads === (Greater | GreaterEqual | Equal | LessEqual | Less | Unequal | Rule | RuleDelayed) check[6.13d] = (f[a == b] // toTheLhsDemo[F]) === f[F[a] == b] check[6.13e] = (a != b // toBothSidesDemo[#+x&]) === a + x != b + x * ----------------------------------------------------------------------- * * displays(6.14) and (6.15) * ----------------------- check[6.14] = {toEachTermThat, toEachFactorThat} === {toTerms, toFactors} check[6.15] = {toEachTerm, toEachFactor} === {toTerms[], toFactors[]} check[6.15a] = ((s = # // Definition // ToString // (StringReplace[#, "bilo`Private`" -> ""]&))& /@ {toTerms, toFactors}; ; Print[s]) * ----------------------------------------------------------------------- * * display (6.16) * -------------- 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]]] ) * ----------------------------------------------------------------------- * * displays (6.17) and (6.18) * -------------------------- stmt[6.17] = toVectorElements[selector___][action___] := toThe[vector][toArguments[selector][inSuccession[action]]] check[6.17] = (vector[a, b, c, d, e] // toVectorElements[matching[b | d]][F]) === vector[a, F[b], c, F[d], e] stmt[6.18] = toEachSummandThat[selector___][action___] := to[sum][selector][toTheArgument[inSuccession[action]]] 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] (s = Definition[toTheNumerator] // InputForm // ToString // (StringReplace[#, "bilo`Private`" -> ""]&); Print[s]) * ----------------------------------------------------------------------- * * displays (6.20) * --------------- (s = Definition[swapArguments] // InputForm // ToString // (StringReplace[#, "bilo`Private`" -> ""]&); Print[s]) 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] * ----------------------------------------------------------------------- * * displays (6.21) to (6.25) * ------------------------- 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] 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]] check[6.22a] = (f[1, 2, 3, 4] // toTheArgumentList[Reverse]) === f[{4, 3, 2, 1}] check[6.22b] = (f[1, 2, 3, 4] // toTheArgumentList[Reverse, Apply[Sequence, #]&]) === f[4, 3, 2, 1] 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] 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}} 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}} * ----------------------------------------------------------------------- * * displays (7.1) and (7.2) * ------------------------ exprn[7.1d] = (3 + (-1 - 2k^2) sin[x]^2) sin[x] /(3 d^3); show[exprn[7.1d]] function[7.2] = toTheCoefficientOfThe[sin[x]^2] [factorOut[-1]]; exprn[7.1e] = exprn[7.1d] // function[7.2]; format[7.1] = toTheNumerator[sortByPresence[k]]; show[exprn[7.1e] // format[7.1]] show[exprn[7.1e]] * ----------------------------------------------------------------------- * * displays (7.4) to (7.6) * ------------------------ eqn[7.4a] = J1 == integral[V][exp[-alpha ra - beta rb]]; 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]); 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 ]]; show[eqn[7.4b] // format[7.4b]] show[eqn[7.4b]] # pfmtd[7.4b] = Equal[J1, HoldForm[Times[HoldForm[HoldForm[Times[8, Power[beta, -3], pi, Power[HoldForm[Plus[Power[kappa, 2], -1]], -3], Power[tau, -1]]]], HoldForm[Plus[HoldForm[Times[HoldForm[Plus[Times[Power[kappa, 3], tau], Times[-1, kappa, tau], Times[-4, kappa]]], exp[Times[-1, tau]]]], HoldForm[Times[HoldForm[Plus[Times[Power[kappa, 2], tau], Times[-1, tau], 4]], exp[Times[-1, kappa, tau]]]]]]]]]; check[7.4b] = (eqn[7.4b] // format[7.4b]) === pfmtd[7.4b] 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]); 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 ]]; show[eqn[7.5] // format[7.5]] show[eqn[7.5]] # pfmtd[7.5] = Equal[J1, HoldForm[Times[HoldForm[HoldForm[Times[8, Power[beta, -3], pi, Power[HoldForm[Plus[Power[kappa, 2], -1]], -3], Power[tau, -1]]]], Plus[HoldForm[Times[HoldForm[Plus[Times[tau, HoldForm[Plus[Power[kappa, 3], Times[-1, kappa]]]], Times[-4, kappa]]], exp[Times[-1, tau]]]], HoldForm[Times[HoldForm[Plus[Times[tau, HoldForm[Plus[Power[kappa, 2], -1]]], 4]], HoldForm[exp[Times[-1, kappa, tau]]]]]]]]]; check[7.5] = (eqn[7.5] // format[7.5]) === pfmtd[7.5] function[7.6] = toTheCoefficientOfEach[exp][collectPowersOf[tau]]; check[7.6] = (eqn[7.4b] // function[7.6]) === eqn[7.5] * ----------------------------------------------------------------------- * * displays (7.7) to (7.9) * ------------------------ 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]); 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 ]]; show[eqn[7.7] // format[7.7]] show[eqn[7.7]] # pfmtd[7.7] = Equal[J1, HoldForm[Times[HoldForm[HoldForm[Times[8, Power[beta, -3], pi, Power[HoldForm[Plus[Power[kappa, 2], -1]], -3], Power[tau, -1]]]], Plus[HoldForm[Times[HoldForm[Plus[HoldForm[Times[tau, kappa, HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]]]], Times[-4, kappa]]], exp[Times[-1, tau]]]], HoldForm[Times[HoldForm[Plus[HoldForm[Times[tau, HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]]]], 4]], HoldForm[exp[Times[-1, kappa, tau]]]]]]]]]; check[7.7] = (eqn[7.7] // format[7.7]) === pfmtd[7.7] function[7.8] = toEachCoefficientOf[tau][Factor]; check[7.7] = (eqn[7.5] // function[7.8]) === eqn[7.7] function[7.9] = toEachCoefficientOf[tau^n_.][factorIfPossible]; eqn[7.9a] = eqn[7.5] // function[7.9]; 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]; show[eqn[7.9a] // format[7.9a]] show[eqn[7.9a]] # pfmtd[7.9a] = Equal[J1, HoldForm[Times[HoldForm[Times[8, pi, Power[HoldForm[Times[Power[beta, 3], Power[HoldForm[Plus[kappa, -1]], 3], Power[HoldForm[Plus[kappa, 1]], 3], tau]], -1]]], HoldForm[Plus[HoldForm[Times[HoldForm[Plus[HoldForm[Times[tau, kappa, HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]]]], Times[-4, kappa]]], exp[Times[-1, tau]]]], HoldForm[Times[HoldForm[Plus[Times[tau, HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]]], 4]], exp[Times[-1, kappa, tau]]]]]]]]]; check[7.9a] = (eqn[7.9a] // format[7.9a]) === pfmtd[7.9a] * ----------------------------------------------------------------------- * * displays (7.10) and (7.11) * ------------------------ 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; 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 ]; show[eqn[7.10] // format[7.10]] show[eqn[7.10]] # pfmtd[7.10] = Equal[sum[l, 0, infinity][sum[m, 0, infinity][sum[n, 0, infinity][ HoldForm[Plus[Times[c[Plus[n, -2]], L[HoldForm[Plus[n, -2]], w]], Times[c[Plus[n, -1]], L[HoldForm[Plus[n, -1]], w]], Times[c[n], L[n, w]], Times[c[Plus[n, 1]], L[HoldForm[Plus[n, 1]], w]], Times[c[Plus[n, 2]], L[HoldForm[Plus[n, 2]], w]]]]]]], 0]; check[7.10] = (eqn[7.10] // format[7.10]) === pfmtd[7.10] eqn[7.10a] = c[n-2] = a L[l, u] L[m, v] + b L[l-1, u] L[m+1, v]; eqn[7.10b] = eqn[7.10] /. brule[7.10a] // ExpandAll; show[eqn[7.10b] // format[7.10]] show[eqn[7.10b]] 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. eqn[7.10c] = eqn[7.10b] // function[7.11]; show[eqn[7.10c] // format[7.10]] show[eqn[7.10c]] * * In contrast, by using L[__], only the part of a term that is * independent of the L's gets enveloped. eqn[7.10d] = eqn[7.10b] // toTheCoefficientOfEach[L[__]][F]; show[eqn[7.10d] // format[7.10]] show[eqn[7.10d]] * ----------------------------------------------------------------------- * * displays (7.12) and (7.13) * ------------------------ 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]); format[7.12, pre] = toTheRhs[ collectivelyToFactorsThat[doNotContain[exp]][hold], toTheArgumentOfThe[hold][ toThe[_ - 1][numbersLast], sortByAbsence[tau]], sortByPresence[hold], hold -> HoldForm ]; show[eqn[7.12, pre] // format[7.12, pre]] show[eqn[7.12, pre]] function[7.13] = toTheCoefficientOfEach[exp][ collectPowersOf[tau], toTheCoefficientOfEach[tau^n_.][Factor], toEach[-kappa + _][factorOut[-1]]]; eqn[7.12] = eqn[7.12, pre] // function[7.13]; 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 ]; show[eqn[7.12] // format[7.12]] show[eqn[7.12]] # pfmtd[7.12] = Equal[J13, HoldForm[Times[HoldForm[HoldForm[ Times[8, Power[beta, -5], pi, Power[HoldForm[Plus[Power[kappa, 2], -1]], -5], Power[tau, -1]]]], HoldForm[Plus[HoldForm[Times[HoldForm[Plus[20, Times[152, Power[kappa, 2]], Times[20, Power[kappa, 4]], Times[-8, HoldForm[Times[tau, HoldForm[Times[HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]], HoldForm[Plus[Times[5, Power[kappa, 2]], 1]]]]]]], HoldForm[Times[Power[tau, 2], HoldForm[Times[Power[HoldForm[Plus[kappa, -1]], 2], Power[HoldForm[Plus[kappa, 1]], 2], HoldForm[Plus[Times[3, Power[kappa, 2]], 1]]]]]]]], exp[Times[-1, tau]]]], HoldForm[Times[HoldForm[Plus[-20, Times[-152, Power[kappa, 2]], Times[-20, Power[kappa, 4]], Times[-8, HoldForm[Times[tau, HoldForm[Times[kappa, HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]], HoldForm[Plus[Power[kappa, 2], 5]]]]]]], Times[-1, HoldForm[Times[Power[tau, 2], HoldForm[Times[Power[HoldForm[Plus[kappa, -1]], 2], Power[HoldForm[Plus[kappa, 1]], 2], HoldForm[Plus[Power[kappa, 2], 3]]]]]]]]], exp[Times[-1, kappa, tau]]]]]]]]]; check[7.12] = (eqn[7.12] // format[7.12]) === pfmtd[7.12] * * Alternatively, function[7.13, alt] = Module[{a}, toTheCoefficientOfEach[exp][ collectPowersOf[tau], toTheCoefficientOfEach[tau^n_.][Factor], a_ (-kappa+b_) -> -a (kappa-b)]]; eqn[7.12, alt] = eqn[7.12, pre] // function[7.13, alt]; show[eqn[7.12, alt] // format[7.12]] show[eqn[7.12, alt]] check[7.12, alt, 2] = (eqn[7.12, alt] // ReleaseHold // ExpandAll) === (eqn[7.12] // ReleaseHold // ExpandAll) function[7.16] = toTheCoefficientOfEach[exp][ collectPowersOf[tau], toTheCoefficientsOfPowersOf[tau][Factor], toEach[-kappa + _][factorOut[-1]]]; eqn[7.16a] = eqn[7.12, pre] // function[7.16]; show[eqn[7.16a] // format[7.12]] show[eqn[7.16a]] # pfmtd[7.16a] = Equal[J13, HoldForm[Times[HoldForm[HoldForm[Times[8, Power[beta, -5], pi, Power[HoldForm[Plus[Power[kappa, 2], -1]], -5], Power[tau, -1]]]], HoldForm[Plus[HoldForm[Times[HoldForm[Plus[Times[4, Plus[5, Times[38, Power[kappa, 2]], Times[5, Power[kappa, 4]]]], Times[-8, HoldForm[Times[tau, HoldForm[Times[HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]], HoldForm[Plus[Times[5, Power[kappa, 2]], 1]]]]]]], HoldForm[Times[Power[tau, 2], HoldForm[Times[Power[HoldForm[Plus[kappa, -1]], 2], Power[HoldForm[Plus[kappa, 1]], 2], HoldForm[Plus[Times[3, Power[kappa, 2]], 1]]]]]]]], exp[Times[-1, tau]]]], HoldForm[Times[HoldForm[Plus[Times[-4, Plus[5, Times[38, Power[kappa, 2]], Times[5, Power[kappa, 4]]]], Times[-8, HoldForm[Times[tau, HoldForm[Times[kappa, HoldForm[Plus[kappa, -1]], HoldForm[Plus[kappa, 1]], HoldForm[Plus[Power[kappa, 2], 5]]]]]]], Times[-1, HoldForm[Times[Power[tau, 2], HoldForm[Times[Power[HoldForm[Plus[kappa, -1]], 2], Power[HoldForm[Plus[kappa, 1]], 2], HoldForm[Plus[Power[kappa, 2], 3]]]]]]]]], exp[Times[-1, kappa, tau]]]]]]]]]; check[7.16a] = (eqn[7.16a] // format[7.12]) === pfmtd[7.16a] * ----------------------------------------------------------------------- * * displays (8.1) to (8.4) * ----------------------- * exprn[8.1] = s = n(n+1)(n+2)/6; exprn[8.2] = s // toEachFactor[numbersLast]; show[exprn[8.1]] show[exprn[8.2]] # pfmtd[8.2] = Times[Rational[1, 6], n, HoldForm[Plus[n, 1]], HoldForm[Plus[n, 2]]]; check[8.2] = exprn[8.2] === pfmtd[8.2] * * ---------------------------------------------------------------------