Telescoping series
- To: mathgroup at yoda.physics.unc.edu
- Subject: Telescoping series
- From: kaufmana at ocfmail.ocf.llnl.gov (Alfred M Kaufman)
- Date: Tue, 8 Dec 92 23:31:17 PST
A colleague of mine asked me if I knew of a Mma package to
telescope series. I told him that I didn't know of one but
he could check Math Source to see if such a package existed.
I was intrigued by the problem and would like to share the
results my efforts. There are all kinds of examples
of the use of telescoped series in Abramowitz and Stegun as
polynomial approximations.
Here's a package that does expansions on the interval [-1,1]
Telescope and expansions on [0,1] ShiftedTelescope.
BeginPackage["`Telescope`"];
Telescope::usage =
"Telescope[series data object,n] = Approximating \
polynomial of order n < order of SeriesData object. \
Based on Chebyshev polynomial approximations on \
interval [-1,1]";
ShiftedTelescope::usage =
"ShiftedTelescope[series data object,n] = Approximating \
polynomial of order n < order of series data object. \
Based on shifted Chebyshev polynomial approximations \
on interval [0,1]";
Begin["`Private`"];
(* rx[k] is the replacement rule in Chebyshev representation
of x^k *)
rx[0] := t[0];
rx[1] := t[1];
(* Use recurrence relation for Chebyshev polynomials as
an operator to obtain new replacement rule*)
rx[n_] := rx[n] = ((rx[n-1] /. t[k_] :> (t[k+1]+t[k-1])/2 )
/.t[k_?Negative] :> t[-k])//Expand;
Telescope[
Literal[SeriesData[xx_,0,coefs_List,nmin_,nmax_,1]],
n_Integer/;n>=0]:=
Block[{nn=n,nterms,rxtab,obj},
If[nmax-nmin <= nn,
Print["Approximation order ",nn," should \
be < ",nmax-nmin];Return[$Failed]];
nterms = Length[coefs];
rxtab = Table[rx[j],{j,0,nterms-1}];
obj = coefs.rxtab // Expand;
obj = xx^nmin*
(Plus@@Cases[obj,_.*t[l_]/;l<=nn] /.
t[k_] :> ChebyshevT[k,xx])// Expand;
Return[obj]
];
(* sx[k] is the replacement rule in Shifted Chebyshev
representation of x^k *)
sx[0] := st[0];
sx[1] := (st[0]+st[1])/2;
(* Use recurrence relation for Shifted Chebyshev
polynomials as an operator to obtain new replacement
rule*)
sx[n_] := sx[n] =
((sx[n-1] /. st[k_] :> (st[k+1]+2*st[k]+st[k-1])/4 )
/.st[k_?Negative] :> st[-k])//Expand;
ShiftedTelescope[
Literal[SeriesData[xx_,0,coefs_List,nmin_,nmax_,1]],
n_Integer/;n>=0]:=
Block[{nn=n,nterms,sxtab,obj},
If[nmax-nmin <= nn,
Print["Approximation order ",nn," should \
be < ",nmax-nmin];Return[$Failed]];
nterms = Length[coefs];
sxtab = Table[sx[j],{j,0,nterms-1}];
obj = coefs.sxtab // Expand;
obj = xx^nmin*
(Plus@@ Cases[obj,_.*st[l_]/;l<=nn] /.
st[k_] :> ChebyshevT[k,2*xx-1])// Expand;
Return[obj]
];
End[];
EndPackage[];
I'd welcome any comments.