Dimensional analysis, Infinite sums
- To: mathgroup at smc.vnet.net
- Subject: [mg31581] Dimensional analysis, Infinite sums
- From: vishnumohan jejjala <jejjala at ux12.cso.uiuc.edu>
- Date: Wed, 14 Nov 2001 03:42:00 -0500 (EST)
- Organization: University of Illinois at Urbana-Champaign
- Sender: owner-wri-mathgroup at wolfram.com
I'm trying to do some integrals of Hermite polynomials with Mathematica.
The result of the integrals is expressed in terms of associated Laguerre
polynomials, and is then summed over the indices of the associated
Laguerre polynomials. I am only interested in the leading terms in
the expression. My question is two-fold:
1. I only want lowest order terms in mtm, say the first three
non-vanishing powers. How does one tell Mathematica to ignore higher
powers of mtm and thereby minimize computation time? I.e., how do I
put mtm^k = 0 when k > 3, for example?
2. My sums come in two forms: sums from 0 to p-1 and p to infinity.
Below, l and m are sums of the second type, and n is a sum of the first
type. I am isolating the relevant terms by hand using the Skipp function.
Is there a way to teach Mathematica to ignore terms above a certain
order in the Taylor expansion in mtm, and do the infinite sums explicitly?
The relevant parts of my code are below. I have something like 600
similar calculations to perform, and want to address them efficiently.
Thanks for any help you can offer.
--Vishnu Jejjala
High Energy Physics Group
University of Illinois
Theta[x_] := If[x > 0, 1, 0]
Theta[0] := 1/2
L[0, m_, x_, y_] := 1 - m*(x^2 + y^2)/2
L[1, m_, x_, y_] := (m + 1) - ((m + 1)m/2)*(x^2 + y^2)/2
L[2, m_, x_, y_] := (m + 2)(m + 1)/2
L[3, m_, x_, y_] := (m + 3)(m + 2)(m + 1)/6
No[m_] := 1/(2^m * m!)^(1/2)
omega[p_] := omeff(p + 1/2)
roots = {Sqrt[a_]Sqrt[b_] -> Sqrt[a b],
Sqrt[a_]/Sqrt[b_] -> Sqrt[a/b],
Sqrt[2^a_ (b_)!]*Sqrt[2^c_ (d_)!] -> 2^((a + c)/2) Sqrt[b!d!],
Sqrt[(a_^2)b_] -> a*Sqrt[b],
Sqrt[(1/a_^2)b_] -> 1/a*Sqrt[b],
2^a_ Sqrt[b_]Sqrt[c_]/Sqrt[d_] -> 2^a Sqrt[b c/d]}
integration1 =
Phi1[a_, u_, v_]Phi2[b_, u_, v_] ->
No[a]*No[b]*{Theta[a - b]*2^a*b!*(-(u + I*v)/2)^{a - b}*
L[a - b, b, u, v] +
Theta[b - a]*2^b*a!*((u - I*v)/2)^{b - a}*L[b - a, a, u, v]}
integration2 =
Phi1[a_, u_, v_]Phi2[a_, u_, v_] -> No[a]^2*{2^a*a!*L[0, a, u, v]}
Skipp[l_, m_, n_] :=
Block[{s, t}, s = l - m; t = l - (p + 1);
If[s == 0, If[t == 0, Return[-1]], If[n == p - 2, Return[-1]]]; Return[0]]
Eppm[l_, m_, n_] :=
Block[{AA, BB, CC, AA1, BB1, CC1, denom, den1, den2, A1},
If[Skipp[l, m, n] == -1, Return[0]];
AA = Sqrt[l + 1]Phi1[l + 1, Q1*mtm, Q2*mtm]*Phi2[n, Q1*mtm, Q2*mtm] +
Sqrt[l]Phi1[l - 1, Q1*mtm, Q2*mtm]*Phi2[n, Q1*mtm, Q2*mtm] /.
integration2 /. integration1;
BB = Sqrt[m + 1]Phi1[m + 1, P1*mtm, P2*mtm]*Phi2[l, P1*mtm, P2*mtm] -
Sqrt[m]Phi1[m - 1, P1*mtm, P2*mtm]*Phi2[l, P1*mtm, P2*mtm] /.
integration2 /. integration1;
CC = Sqrt[n + 1]Phi1[n + 1, R1*mtm, R2*mtm]*Phi2[m, R1*mtm, R2*mtm] -
Sqrt[n]Phi1[n - 1, R1*mtm, R2*mtm]*Phi2[m, R1*mtm, R2*mtm] /.
integration2 /. integration1;
AA1 = PowerExpand[AA] //. roots;
BB1 = PowerExpand[BB] //. roots;
CC1 = PowerExpand[CC] //. roots;
denom =
Series[1/(Q0*mtm - (omega[l] - omega[n])), {Q0, 0, 3}]*
Series[1/(R0*mtm + (omega[m] - omega[n])), {R0, 0, 3}]*-1 //
Simplify;
den1 = denom*mtm;
den2 =
Coefficient[den1, mtm] + Coefficient[den1, mtm^2]*mtm +
Coefficient[den1, mtm^3]*mtm^2 + Coefficient[den1, mtm^4]*mtm^3;
A1 = AA1*BB1*CC1*den2 // ExpandAll;
Return[A1]]
Answer1 = 0;
Do[Answer1 = Answer1 + Eppm[l, m, n];
Print[{l, m, n, Skipp[l, m, n], Eppm[l, m, n], Answer1}],
{l, p, p + 1}, {m, p, p + 1}, {n, p - 1, p - 1}]