Re: Dimensional analysis, Infinite sums
- To: mathgroup at smc.vnet.net
- Subject: [mg31698] Re: Dimensional analysis, Infinite sums
- From: "Alan Mason" <swt at austin.rr.com>
- Date: Tue, 27 Nov 2001 02:47:50 -0500 (EST)
- Approved: Steven M. Christensen <steve@smc.vnet.net>, Moderator
- References: <9stbl0$3co$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Hello Vishnu.
I haven't really looked closely at your code -- it can be greatly shortened
and simplified by using a more Mathematica-friendly programming style
=) -- but your description of the problem seems clear.
1).You can remove powers greater than p from expr by doing
expr= expr /. mtm^k_:> 0 /; k >= p
where expr is your expression involving mtm. Now do the calculation with
the resulting expr.
This also applies to your second question.
2) Your code does not appear to be using the Mathematica function Sum[]; you
should do this.
Let's suppose you're summing over l, m, and n, then you would write
Sum[func[l, m, n], {l, p, Infinity}, {m, p, Infinity}, {n, 1, p-1}]. This
will enable you to use the pattern matcher to distinguish between the two
types of sum.
In your case it looks like p is some kind of parameter you're interested in
and you want the result expressed in terms of p. If so, use c[k, p] =
Sum[coef[k,l, m, n], {l, 1, p-1}, {m, p, Infinity}, {n, p, Infinity}] to get
the coefficients c[k, p]. Here coef[k, l, m, n] is the coefficient of x^k in
the Laguerre polynomials (coef[k, l, m, n] = Coefficient[Lagpoly[l, m, n],
x, k]). If Mathematica can't already evaluate the sums you need exactly you
can teach it to do this by introducing appropriate rules, assuming you know
what the exact answer is. This is too long a story to go into here, but
rule-based programming is what Mathematica is all about.
"vishnumohan jejjala" <jejjala at ux12.cso.uiuc.edu> wrote in message
news:9stbl0$3co$1 at smc.vnet.net...
> 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}]
>