(* Package Specialfunctions, Copyright (C) 1992-2006 Wolfram Koepf, University Kassel *)
(* Version fuer: Koepf, Wolfram: Computeralgebra. Eine algorithmisch orientierte Einfuehrung. 
   Springer, Berlin/Heidelberg, 2006 *)

(* Mathematica Version 5.2, Package Release 2.01 *)

(* Um das Package "SpecialFunctions" zu installieren, verschiebt  man die Datei "SpecialFunctions.m"
   in den Ordner AddOns/ExtraPackages, der sich in dem Verzeichnis befindet, wo man Mathematica installiert hat.
   Alternativ kann man das Verzeichnis, in dem "SpecialFunctions.m" liegt, mit dem Mathematica-Befehl SetDirectory angeben. 
   Das Package laedt man dann mit dem Mathematica-Befehl Needs["SpecialFunctions`"]. *)

(* This package loads the package zb_alg (C), Peter Paule/Markus Schorn from the same file.
   A newer version of their implementation can be downloaded from 
   http://www.risc.uni-linz.ac.at/research/combinat/risc/software *)

(*:Version: Mathematica 2.2-5.2 *)

(*:Name: SpecialFunctions *)

(*:Authors:
        Wolfram Koepf, Axel Rennoch, Gregor Stoelting 1992, 1993
	Wolfram Koepf 1994-2006	
*)

(*:Keywords:
        ComplexFactor, ComplexApart, Pochhammer,
	SimpleDE, DEOrder, DEtoRE, SimpleRE, HolonomicDE, holonomicDE, 
	PowerSeries, PS, FPS, AsymptPowerSeries,
	Convert, SimpByRecursion, FindRecursion, REtoDE, RETODE, SumtoDE,
	Bateman, Hankel1, Hankel2, KummerM, KummerU, WhittakerM,
	WhittakerW, StruveH, StruveL, Erfc, Abramowitz, NormalIntegral,
	KnuthA, KnuthB, ParabolicU, ParabolicD, ParabolicV, 
	(* missing: ParabolicW, ParabolicE, ParabolicEstar, *)
	Hypergeometric0F1, Hypergeometric1F0, HypergeometricU, 
	Hypergeometric1F1, Hypergeometric2F0, Hypergeometric2F1,
	Hypergeometric2F3, Hypergeometric3F2,
	(* missing: CoulombWaveF,CoulombWaveG, Mathieu, Kelvin, *)
	EllipticK, EllipticE,
	SphericalBesselJ, SphericalBesselY, SphericalBesselI,
	SphericalBesselK, SphericalHankel1, SphericalHankel2,
	Krawtchouk, Charlier, Meixner, DiscreteChebyshev,
	DiscreteLaguerre, Hahn, (* Nikiforov, Suslov, Uvarov:
	Classical Orthogonal Polynomials of a Discrete Variable *)
	(* todo: Wilson *)
	SumDE, DESum, ProductDE, DEProduct, SumRE, RESum, ProductRE, REProduct,
	ConvolutionRE, ZTransform, InverseZTransform,
	SumToHypergeometric, FunctionToHypergeometric, 
	GeneratingFunction, ExponentialGeneratingFunction,
	specfunprint, nospecfunprint, specfunprintoff,
	SimplifyGamma, SimplifyCombinatorial, SimpComb, Ratio, ToGamma, 
	HyperTerm,
	SeriesSolution, Taylor
*)

(*:References:
	Wolfram Koepf: Power Series in Computer Algebra,
	Journal of Symbolic Computation 13, 1992, 581-603.
		
	Wolfram Koepf: Algorithmic development of power series. In:
	Artificial intelligence and symbolic mathematical computing,
	J. Calmet and J. A. Campbell, Editors,
	International Conference AISMC-1, Karlsruhe, Germany, August 1992, 
	Proceedings, Lecture Notes in Computer Science 737, 
	Springer-Verlag, Berlin-Heidelberg, 1993, 195-213.

	Wolfram Koepf: Examples for the algorithmic calculation of formal
        Puiseux, Laurent and power series. SIGSAM Bulletin 27, 1993, 20-32.

	Wolfram Koepf, Dieter Schmersau: Bounded nonvanishing functions
	and Bateman functions. Preprint A/31-93 Free University Berlin, 
        Department of Mathematics, 1993. Complex Variables 25, 1994, 237-259.

        Wolfram Koepf: A package on formal power series. Mathematica 
        Journal 4, 1994, 62-69.

	Wolfram Koepf, Dieter Schmersau: Spaces of functions satisfying
	simple differential equations. Konrad-Zuse-Zentrum Berlin (ZIB),
	Technical Report TR 94-2, 1994.

	Wolfram Koepf: Algorithmic work with orthogonal polynomials and
	special functions. Konrad-Zuse-Zentrum Berlin (ZIB), Preprint 
	SC 94-5, 1994.

	Wolfram Koepf: Algorithms for m-fold hypergeometric summation.
	Journal of Symbolic Computation 20, 1995, 399-417.

	Peter Paule, Markus Schorn: A Mathematica version of Zeilberger's
	algorithm for proving binomial coefficient identities. J. Symbolic
	Computation 20, 1995, 673-698.

The article
	Wolfram Koepf: A Package on Orthogonal Polynomials and Special 
	Functions. Konrad-Zuse-Zentrum Berlin (ZIB), Preprint 1996.
is kind of a manual for the package.
*)
					
(*:Requirements: none. *)

(*:History:
        Version 0.0 by Wolfram Koepf, Axel Rennoch, 1991
        Modified by Wolfram Koepf, March, April 1992.
	Modified by Wolfram Koepf, Gregor Stoelting, October 1992.
	Version 0.01 by Wolfram Koepf, Gregor Stoelting, 1993.
	Release 0.50, Oct 25, 1993 (bugs FindRecursion eliminated)
        Release 0.51, Feb 08, 1994 (hypergeometric functions)
	Release 0.52, Mar 07, 1994 (special functions updated)
	Release 0.53, Mar 15, 1994 (BesselK)
	Release 0.54, Apr 18, 1994 (Knuth, Parabolic, LegendreQ)
        Release 0.55, Apr 27, 1994 (Pochhammer)
	Release 0.60, May 01--Sep 27, 1994 (SDE, FR, Hypergeometric2F3-3F2,
                                    REtoDE, SumtoDE, PS with SDE,
				    AbsRules, Zeilberger, Gamma, 
				    Collect, ratalgo, integrate,
				    Bloedsinn)
	Release 0.61, Nov 11, 1994 (FR/Pochhammer/Binomial)
	Release 0.62, Dec 02, 1994 (SumToHypergeometric/
				    FunctionToHypergeometric)
	Release 0.63, Dec 19, 1994 (hypergeometric representations)
	Release 0.64, Dec 29, 1994 (global->private, and FR)
	Release 0.65, Jan 05, 1995 (SimplifyGamma, ToGamma,
                                    SimplifyCombinatorial)
	Release 0.66, Jan 10, 1995 (SumToHypergeometric)
	Release 0.67, Feb 27, 1995 (Limits of orthogonal polynomials)
	Release 0.68, Sep 18, 1996 (DEOrder not lower than REOrder in Convert)
	Release 0.70, Oct 17-21, 1996 (again bugs in Convert,
           		 	    SeriesSolution, Taylor, 
                                    zb_alg V 2.2 embedded,
 			 	    efficient computation of orth. poly.,
				    OP[-1,x]->0i,
				    SimpComb, Ratio, HyperTerm)
        Release 0.99, Nov 20, 1996 (adaptions for Mathematica Version 3)
        Release 1.00, Dec 6, 1996  (final adaptions in connection with manual article)
	Release 1.01, May 19, 2004 (FPS alias for PS, holonomicDE alias for SpecialFunctions`Private`simpleDE)
	Release 1.02, May 25, 2004 (Norm -> norm for Mathematica 5)
	Release 2.00, Jan 31, 2006 (final adaptations for book:
				    new SimplifyCombinatorial,
				    put new functionalities from book into the 
				    SpecialFunctions context: 
				    DiskreteStammfunktion, GradSchranke, PrimDispersion,
				    Dispersionsmenge, REtoPol, SumRekursion, WZCertificate)
	Release 2.01, Feb 21, 2006  Torsten Sprenger: bug fix in HolonomicRE[sum[...]]
*)

(* 
todo: Tue Nov 21 17:00:36 GMT+0100 2000
SumToHypergeometric nur bei Summen von Reihen, die hypergeometrisch sind
ArcSin[x]
E^ArcSin[x]
Algebraic: DEout ersetzt durch Map[Factor,Collect[...
simple[e_]:=FullSimplify[e] (* CHANGE *) ???

SimplifyCombinatorial erneuern
Hold-Funktionen fuer Sum etc. wieder aufheben ?

done: Cleared three last lines
*)

(*:Warning: 
	Pochhammer[n,k] is redefined appropriately.
	SimplifyGamma is redefined appropriately.
	Series[f,{x,a}] is defined appropriately.
	HypergeometricPFQ is cleared so that no automatic simplification
	applies.
*)

(*:Aims and Limitations:
        The aim of this package is to provide implementations
	- SimpleDE[f,x]
	  to find a homogeneous linear differential equation with
	  polynomial coefficients with respect to the variable x for 
	  any function built from x^a, Exp[x], Log[x], Sin[x], Cos[x], 
	  ArcSin[x], ArcTan[x], ArcSinh[x], ArcTanh[x], Erf[x], 
	  ExpIntegralEi[x], CosIntegral[x], SinIntegral[x], 
	  AiryAi[x], AiryBi[x], BesselI[x], BesselJ[x], BesselY[x], BesselK[x],
	  LegendreP[n,m,x], LegendreQ[n,m,x], HypergeometricU[a,b,x],
	  Hypergeometric0F1[a,x], Hypergeometric1F1[a,b,x],
	  Hypergeometric2F1[a,b,x], HypergeometricPFQ[plist,qlist,x],
	  JacobiP[n,a,b,x], GegenbauerC[n,a,x], ChebyshevT[n,x], 
	  ChebyshevU[n,x], LegendreP[n,x], LaguerreL[n,a,x], and HermiteH[n,x] 
	  by addition, multiplication, and the composition with rational 
	  functions, and rational powers.
	  Similarly definitions for the following special functions have
	  been added, that can be treated similarly: Bateman[n,x],
	  Hankel1[n,x], Hankel2[n,x], KummerM[a,b,x], KummerU[a,b,x],
	  WhittakerM[a,b,x], WhittakerW[a,b,x], StruveH[n,x], StruveL[n,x],
	  Hypergeometric1F0[a,x], Hypergeometric2F0[a,b,x], 
	  Hypergeometric2F3[a,b,c,d,e,x], Hypergeometric3F2[a,b,c,d,e,x],
	  Erfc[n,x], Abramowitz[n,x], NormalIntegral[n,x], 
	  ParabolicU[n,x], ParabolicD[n,x], ParabolicV[n,x]. 
	  Informations about these functions can be obtained by using 
	  Mathematica's ? feature after the package is loaded.
	- FindRecursion[f,n]
	  to find a homogeneous linear recurrence equation with
	  polynomial coefficients with respect to the variable n for 
	  any function built from the above mentioned special functions,
	  n being one of their parameters, and n!, Gamma[n],
	  Pochhammer[n,k], Pochhammer[k,n], Binomial[n,k],
	  Binomial[k,n], by addition, multiplication, and the
	  composition with functions of the type (m n+a), m integer.
	  Further terms of the form Sum[f,{k,a,b}], and Sum[f,k] can be
	  treated, f depending on k, and n, using the Zeilberger
	  algorithm.
	- Series[f,{x,a}]
	  to find an infinite series representation for f with respect
	  to the variable x, developed at the point a, if f is of 
	  rational, explike, or of hypergeometric type.
	- SumToHypergeometric[f]
	  to find a hypergeometric representation of an expression f
	  involving infinite sums. 
	- FunctionToHypergeometric[f,x]
	  to find a hypergeometric representation of f, where x is
	  assumed to be a variable occuring in the last argument of the
	  hypergeometric function.
	- GeneratingFunction[a,k,x]
	  to find an explicit form of the generating function 
	  Sum[a x^k,{k,0,Infinity}] in terms of variable x of the sequence a
	  of variable k.
	- ExponentialGeneratingFunction[a,k,x]
	  to find an explicit form of the exponential generating function 
	  Sum[a x^k/k!,{k,0,Infinity}] in terms of variable x of the 
	  sequence a of variable k.
	- Convert[Sum[a x^(m k+s),{k,k0,Infinity}],x]
	  to find an explicit form of Sum[a x^(m k+s),{k,k0,Infinity}]
	- SeriesSolution[DE,y,x,incslist,maxorder] gives the n-th order power 
	  series approximation of the holonomic differential equation DE in 
	  terms of y[x], using the initial values incslist.
	- Taylor[f,{x,x0,n}] calculates the nth order power series 
	  approximation of f at the point x0 with respect to variable x, by
	  computing a holonomic differential equation of f, if applicable.
	  For holonomic functions this is the fasted known method.
*)

(* cancel automatic simplification for HypergeometricPFQ *)

(* FINAL ???
Unprotect[HypergeometricPFQ]
Clear[HypergeometricPFQ]
Protect[HypergeometricPFQ]
*)

(* the following are for Mathematica Version 3 *)
Off[SetDelayed::write]
Off[TagSetDelayed::write]

(* Global function declaration *)

Unprotect[Series]

Series::usage =
"Series[f, {x, x0, n}] generates a power series expansion for f about the point
x = x0 to order (x - x0)^n. Series[f, {x, x0, nx}, {y, y0, ny}]
successively finds series expansions with respect to y, then x.
Series[f, {x, x0}] tries to find a closed form power series representation
for f, developed at x0."

(* Bessel functions *)

Unprotect[BesselI,BesselK,BesselY,BesselJ,D]

(* AS 9.26. Seite 120 *)

Literal[Derivative[0,1][BesselI]]:=
Function[{nn,x},
BesselI[nn-1,x]-nn/x*BesselI[nn,x]]

D[BesselI[nn_,x_],x_]:=Derivative[0,1][BesselI][nn, x]

D[BesselI[nn_, x_],{x_,k_}]:= D[D[BesselI[nn, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 9.26. Seite 120 *)

Literal[Derivative[0,1][BesselK]]:=
Function[{nn,x},
-BesselK[nn-1,x]-nn/x*BesselK[nn,x]]

D[BesselK[nn_,x_],x_]:=Derivative[0,1][BesselK][nn, x]

D[BesselK[nn_, x_],{x_,k_}]:= D[D[BesselK[nn, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 9.1.27 Seite 105 *)

Literal[Derivative[0,1][BesselY]]:=
Function[{nn,x},
BesselY[-1 + nn, x] - (nn*BesselY[nn, x])/x]

D[BesselY[nn_,x_],x_]:=Derivative[0,1][BesselY][nn, x]

D[BesselY[nn_, x_],{x_,k_}]:= D[D[BesselY[nn, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* AS 9.1.27 Seite 105 *)

Literal[Derivative[0,1][BesselJ]]:=
Function[{nn,x},
BesselJ[-1 + nn, x] - (nn*BesselJ[nn, x])/x]

D[BesselJ[nn_,x_],x_]:=Derivative[0,1][BesselJ][nn, x]

D[BesselJ[nn_, x_],{x_,k_}]:= D[D[BesselJ[nn, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Protect[BesselI,BesselK,BesselY,BesselJ,D]

(* Erfc *)
(* AS (7.2) *)
Unprotect[Erfc,D]

Erfc::usage =
"Erfc[z] gives the complementary error function erfc(z) == 1 - erf(z).
Erfc[n,z] gives the iterated integrals of the complementary error
function, see Abramowitz/Stegun, (7.2)."

Off[Erfc::argx]
Literal[Derivative[0,k_][Erfc]]:=
Function[{nn,x},(-1)^k*Erfc[nn-k,x]]
D[Erfc[nn_,x_],x_]:= Derivative[0,1][Erfc][nn,x]
Erfc[-1,x_]:=2/Sqrt[Pi]*E^(-x^2)
Erfc[0,x_]:=(1-Erf[x])
Erfc[1,x_]:=Erfc[-1, x]/2 - x*Erfc[0, x]
Protect[Erfc,D]

Unprotect[SimplifyGamma]
Clear[SimplifyGamma]

SimplifyGamma::usage = "SimplifyGamma[expr] simplifies expressions
involving rational functions, exponentials, and Gamma function terms
according to a recursive application of the rule Gamma[a+1]->a*Gamma[a].\n\n
Example: SimplifyGamma[Gamma[n+1]/Gamma[k]-Gamma[n]/Gamma[k+1]] results in\n\n
(-1 + k n) Gamma[n]\n
-------------------\n
   Gamma[1 + k]"

Unprotect[LaguerreL,ChebyshevT,ChebyshevU,LegendreP,HermiteH,GegenbauerC,
JacobiP]

(* Limits of orthogonal polynomials *)
LegendreP[nn_,-1]:=Cos[nn*Pi]
LegendreP[nn_,0]:=Pi^(1/2)/(Gamma[(1 - nn)/2]*Gamma[1 + nn/2])
LegendreP[nn_,1]:=1

ChebyshevT[nn_,-1]:=Cos[nn*Pi]
ChebyshevT[nn_,0]:=Cos[(nn*Pi)/2]
ChebyshevT[nn_,1]:=1

ChebyshevU[nn_,-1]:=Cos[nn*Pi]*(1 + nn)
ChebyshevU[nn_,0]:=Sin[((1 + nn)*Pi)/2]
ChebyshevU[nn_,1]:=1 + nn

GegenbauerC[nn_,0]:=(2*Pi*Gamma[2*a + nn])/
   (2^(2*a)*nn!*Gamma[a]*Gamma[(1 - nn)/2]*Gamma[1/2 + a + nn/2])
GegenbauerC[nn_,1]:=
(2*Pi^(1/2)*Gamma[2*a + nn])/(2^(2*a)*nn!*Gamma[a]*Gamma[1/2 + a])

LaguerreL[nn_,a_,0]:=Pochhammer[1 + nn, a]/Gamma[1 + a]

HermiteH[nn_,0]:=(2^nn*Pi^(1/2))/Gamma[(1 - nn)/2]

(* not yet: N-numeric *)

(* iterative appoach, divide and conquer *)
ChebyshevT[nn_,xxx_]:=Module[{a,bb,c,dd,g},
g[{a_,bb_,c_,dd_}]:=If[dd-2^c<0,{2*a^2-1,2*a*bb-xxx,c-1,dd},
{2*a*bb-xxx,2*bb^2-1,c-1,dd-2^c}];
If[nn==0,1,If[nn==1,xxx,FixedPoint[g,
{1,xxx,Floor[N[Log[2,nn]]],nn},Floor[N[Log[2,nn]]+1]][[1]]]]] /;
(NumberQ[xxx] && IntegerQ[nn] && nn>=0)
(* to use this for symbolic x, use
x /: NumberQ[x]:=True
*)

(* iterative series computation for symbolic x *)
ChebyshevT[nn_,xxx_]:=Module[{kkk,ttmp,ttab},
	If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        If[nn==1,Return[xxx]];
        ttmp=(2*xxx)^nn/2;
        ttab=
	Table[ttmp=-ttmp/4/kkk*(nn-2*kkk+2)*(nn-2*kkk+1)/xxx^2/(nn-kkk),
	{kkk,1,Floor[nn/2]}];
        (2*x)^nn/2+Apply[Plus,ttab]
] /; IntegerQ[nn]

(* this is still recursive approach, divide and conquer *)
ChebyshevU[nn_,xxx_]:=(ChebyshevU[nn,xxx]=
If[nn==0,1,If[nn==1,2*xxx,If[EvenQ[nn],
2*ChebyshevT[nn/2,xxx]*ChebyshevU[nn/2,xxx]-1,
2*ChebyshevU[(nn-1)/2,xxx]*ChebyshevT[(nn+1)/2,xxx]]]]) /;
(NumberQ[x] && IntegerQ[nn] && nn>=0)

HermiteHH[nn_,xxx_]:=Module[{kkk,iinit,ttmp,ttab},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        iinit=ttmp=2^nn*xxx^nn;
	ttab=Table[ttmp=-ttmp/xxx^2*(kkk+(1-nn)/2)*(kkk-nn/2)/(kkk+1),
	{kkk,0,nn-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

LegendreP[nn_,xxx_]:=Module[{kkk,iinit,ttmp,ttab},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        iinit=ttmp=Binomial[2*nn,nn]*xxx^nn/2^nn;
	ttab=Table[ttmp=ttmp/xxx^2*(kkk+(1-nn)/2)*(kkk-nn/2)/(kkk+1/2-nn)/
	(kkk+1),{kkk,0,nn-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

LaguerreL[nn_,aalpha_,xxx_]:=Module[{kkk,iinit,ttmp,ttab},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        iinit=ttmp=Binomial[nn+aalpha,nn];
        ttab=Table[ttmp=ttmp*xxx*(kkk-nn)/(kkk+aalpha+1)/(kkk+1),{kkk,0,nn-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

LaguerreL[nn_,xxx_]:=Module[{kkk,iinit,ttmp,ttab},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        iinit=ttmp=1;
        ttab=Table[ttmp=ttmp*xxx*(kkk-nn)/(kkk+1)^2,{kkk,0,nn-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

GegenbauerC[nn_,aalpha_,xxx_]:=Module[{kkk,iinit,ttmp,ttab,factor},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
	If[Simplify[aalpha]===0,Return[GegenbauerC[nn,xxx]]];
        iinit=ttmp=2^nn*xxx^nn*Binomial[nn+aalpha-1,nn];
	factor=Together[1/xxx^2*(kkk+(1-nn)/2)*(kkk-nn/2)/(kkk+1-aalpha-nn)/
	(kkk+1)];
        ttab=Table[ttmp=ttmp*factor,{kkk,0,Floor[nn/2]-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

Off[GegenbauerC::argrx]

GegenbauerC[nn_,xxx_]:=Module[{kkk,iinit,ttmp,ttab},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        iinit=ttmp=2^nn*xxx^nn/nn;
        ttab=Table[ttmp=ttmp/xxx^2*(kkk+(1-nn)/2)*(kkk-nn/2)/(kkk+1-nn)/(kkk+1),
	{kkk,0,Floor[nn/2]-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

JacobiP[nn_,aalpha_,bbeta_,xxx_]:=Module[{kkk,iinit,ttmp,ttab,factor},
        If[nn<0,Return[0]];
        If[nn==0,Return[1]];
        iinit=ttmp=Binomial[nn+aalpha,nn];
	factor=Together[(1-xxx)/2*(kkk-nn)*(kkk+nn+aalpha+bbeta+1)/
	(kkk+aalpha+1)/(kkk+1)];
        ttab=Table[ttmp=ttmp*factor,{kkk,0,nn-1}];
        iinit+Apply[Plus,ttab]
] /; IntegerQ[nn]

Protect[ChebyshevT,HermiteH,LegendreP,LaguerreL,GegenbauerC,JacobiP]
(* ChebyshevU cannot be protected because of remember option *)

(* 
PAULE-SCHORN PACKAGE 
loading ...
*)

(* file: 	algutil.m *)
(* written by	Markus Schorn *)


BeginPackage["algutil`"]

IntLinCoef
IntLinQ
ExtractNonIntLin
ExtractIntLin

MyCoefficientList

PolyContent
NormFactor
norm
MinusSign
MR
NC
GCDofFactored
ShiftFactored
FactoredToList
(* name convention for Mathematica Version 3 *)
PauleSchornSplit
ConstElems
GP
Q
NaturalQ
FCollect

Begin["`private`"]

NaturalQ[ n_] := IntegerQ[n] && (n >= 0) 

(* -------------------------------------------------------------------- *)
(* integer-linear stuff						        *)

IntLinCoef[ poly_, var_] :=
   Module[
      {exp = Exponent[ Expand[poly], var], coef = Coefficient[ poly, var, 1]},
   If[ IntegerQ[ coef] && exp < 2, Return[ coef]];
   Print[poly, " is not integer-linear in ", var];
   Abort[]
]

IntLinQ[ poly_, var_] := 
   (Exponent[ Expand[poly], var] < 2) && IntegerQ[ Coefficient[ poly, var, 1]]

IntLinQ[ poly_^i_Integer, var_] := 
   (Exponent[ Expand[poly], var] < 2) && IntegerQ[ Coefficient[ poly, var, 1]]


ExtractNonIntLin[ t_Times, var_]:= 
   PauleSchornSplit[ t, (PolynomialQ[#, var] && !IntLinQ[#, var])&]

ExtractNonIntLin[ t_^i_Integer, var_] := ExtractNonIntLin[ t, var]^i

ExtractNonIntLin[ t_, var_]:= 
   If[ PolynomialQ[ t, var] && !IntLinQ[ t, var], {t, 1}, {1, t}]

ExtractIntLin[ t_Times, var_]:= 
   PauleSchornSplit[ t, (PolynomialQ[#, var] && IntLinQ[#, var])&]

ExtractIntLin[ t_^i_Integer, var_] := ExtractIntLin[ t, var]^i

ExtractIntLin[ t_, var_]:= 
   If[ PolynomialQ[ t, var] && IntLinQ[ t, var], {t, 1}, {1, t}]

MyCoefficientList[ term_, var_] :=
   Module[
      {result = {}, t = Expand[ term], i},
      Return[ Table[ Coefficient[ t, var, i], {i, 0, 
              Max[0, Exponent[ term, var]]}]];
] 

(* -------------------------------------------------------------------- *)
(* extract rationals to get a list of polys 				*)

PolyContent[ l_List] :=
   Module[
      {i, numgcd = 0, denlcm = 1},
   Do[
      numgcd = PolynomialGCD[ numgcd, Numerator[ l[[i]]]];
      denlcm = PolynomialLCM[ denlcm, Denominator[ l[[i]]]],
   {i, Length[l]}];
   Return[ {numgcd / denlcm, Cancel[ denlcm / numgcd l]}];
]

(* -------------------------------------------------------------------- *)
(* factorization with normed factors (+-) 				*)

SetAttributes[ NormFactor, Listable]
NormFactor[ x_]:= norm[ Factor[ x]];


(* -------------------------------------------------------------------- *)
(* Norm factors to having positive sign in front of last variable 	*)

SetAttributes[norm, Listable]

norm[ a_Times] := norm /@ a
norm[ a_^n_]:= norm[a]^n
norm[ sum_Plus]:= If[ sign[ Last[ sum]] == 1, sum, MinusSign neg[ sum]] 
norm[a_] :=  If[ sign[a] === 1, a, MinusSign * -a]

MinusSign/: Power[MinusSign, i_Integer] := If [ OddQ[i], MinusSign, 1]
MR = (MinusSign -> -1)
NC = (norm[#] /. MR)&
sign[ i_?NumberQ]:= Sign[i]
sign[ (i_Integer:1)*_]:= Sign[i]
neg[a_] := -a


(* ------------------------------------------------------------------- *)
(* shift a factored polynomial yielding a factored one                 *)

ShiftFactored[ f_Times, var_, i_] := ShiftFactored[ #, var, i]& /@ f
ShiftFactored[ f_^n_Integer, var_, i_] := ShiftFactored[ f, var, i]^n 
ShiftFactored[ f_, var_, i_] := Expand[ f /. var -> var + i]  


(* ------------------------------------------------------------------- *)
(* convert a factored polynomial to a list of these factors            *)

FactoredToList[ 1] = {}
FactoredToList[ f_Times] := List @@ Flatten[ FactoredToList /@ (List @@ f)]
FactoredToList[ f_^n_Integer:1] := Table[ f, {n}]

FCollect[ t_, var_] := 
   Module[ 
      {res, const},
   const = t /. var -> 0;
   res = Collect[ t - const, var];
   If[ Head[ res] === Plus, 
         res = Factor /@ Select[res, (!FreeQ[#, var])&], 
      res = Factor[res]];
   Factor[const] + res
]


(* ------------------------------------------------------------------- *)
(* PauleSchornSplit a list into two lists                                         *)

PauleSchornSplit[list_, test_]:= {Select[list, test], Select[list, (test[#] =!= True) &]}


(* ------------------------------------------------------------------- *)
(* PauleSchornSplit product into non-constant and constant factor                 *)

ConstElems[ list_, var_] := PauleSchornSplit[ list, FreeQ[#, var]&]


(* ------------------------------------------------------------------- *)
(* computation of gcd and disjunct factors of two factored polynomials *)

flattenExponent[x_^y_:1]:= {x,y}

GCDofFactored[x_, y_]:= GCDofNFactored[ norm[x], norm[y]] /. MR

GCDofNFactored[ 0, 0]:= {0, 0, 1}

GCDofNFactored[ i1_Integer * x_, i2_Integer * y_] := 
   Module[ 
      {gcd = GCD[ i1, i2]},
   Return[ GCDofNFactored[ x, y] {i1/gcd, i2/gcd, gcd}]
]

GCDofNFactored[ x_, y_]:=
   Module[
      {oldX , oldY, gcd = 1, newX = 1, newY = 1, powX, powY},
	
   oldX = If[ Head[x] === Times, List @@ x, {x}];
   oldY = If[ Head[y] === Times, List @@ y, {y}];

				(* compare factors *)
   While[!((oldX === {}) || (oldY ==={})),
      {firstX, powX} = flattenExponent[ oldX[[1]]]; 
      {firstY, powY} = flattenExponent[ oldY[[1]]]; 
      If[ firstX === firstY,
            If[ powX < powY, 
                  gcd *= firstX ^powX; 
                  newY *= firstX ^ (powY-powX),
	       gcd *= firstX ^powY; 
               newX *= firstX ^ (powX-powY)
            ];
	    oldX = Rest[oldX]; 
            oldY = Rest[oldY],
	 If[ OrderedQ[{firstX, firstY}],
               newX *= firstX ^ powX; oldX = Rest[oldX],
	    newY *= firstY ^ powY; oldY = Rest[oldY]
   ]  ]  ];
   If[ oldX === {}, newY *= Times @@ oldY, newX *= Times @@ oldX];

   Return[ {newX, newY, gcd}];
]  

(* -------------------------------------------------------------------- *)
(* calculate GP    canonical-form of a factored rational function	*) 

GP[ rat_, var_]:=
   Module[
      {p = 1, q, r, 
       numlist, denlist, constnum, constden, 
       classnum, classden, class, 
       num, den, 
       coef, div, classPoly,
       nln, nld, nlq, nlp=1, nlr, poss, nposs, d, res, pos, min},

				(* check linearity of factors *)
   {nlq, num} = ExtractNonIntLin[ Numerator[ rat], var];
   {nlr, den} = ExtractNonIntLin[ Denominator[ rat], var];

   If[ nlq =!= 1 && nlr =!= 1,
      Print[ "Gosper`s condition cannot be checked without resultants,"];
      Run["sleep 1"];
      Print[ "therefore I use resultants."];

      nln = FactoredToList[ nlq];
      nld = FactoredToList[ nlr];
      nlq = nlr = 1;

      While[ nld =!= {},
         If[ nln === {}, 
               nlr *= Times @@ nld;
               nld = {},
            {poss, nposs} = PauleSchornSplit[ nln, 
                           (Exponent[#, var] === Exponent[First[nld], var])&];
            res = Resultant[ First[nld] /. var -> var+d, #, var] & /@ poss;
            res = FactoredToList[Factor[#]]& /@ res;
            res = Map[ Select[ #, (IntLinQ[#, d] && ! FreeQ[#, d])&]&, res, 
                       {1}];
            res = Map[(-# /. d -> 0 / Coefficient[#, d, 1])&, res, {2}];
            res = Map[ Select[ #, NaturalQ]&, res, {1}];
            res = Min /@ res;
            min = Min[ Select[ Flatten[res], NaturalQ]];
            If[ min < Infinity,
                   pos = Position[ res, min, {1}];
                   nlp *= Product[ ShiftFactored[ First[nld], var, i-1], 
                                   {i, min}];
                   poss = Drop[ poss, pos[[1]]],
               nlr *= First[ nld]
            ];

            nld = Rest[nld];
            nln = Join[ poss, nposs];
         ];
      ];

      nlq *= Times @@ nln;
   ];       

				(* extract the constant parts *)
   {constnum, numlist} = ConstElems[ FactoredToList[ norm[num]], var];
   {constden, denlist} = ConstElems[ FactoredToList[ norm[den]], var];
   q = Times @@ constnum;
   r = Times @@ constden; 
   div = Module[ {coefficient}, 
             coefficient = Coefficient[ #, var];
             {coefficient, Cancel[ #/coefficient]}]&;
   numlist = div /@ numlist;
   denlist = div /@ denlist;

				(* treat all classes *)
   While[ denlist =!= {} && numlist =!= {},
					(* select a class *)
      coef = First[First[denlist]];
      class = Last[First[denlist]];
      classPoly = Cancel[ class coef];

      {classnum, numlist} = 
         PauleSchornSplit[ numlist, (coef === First[#] && 
                          IntegerQ[ Together[ Last[#] - class]])&];
      {classden, denlist} = 
         PauleSchornSplit[ denlist, (coef === First[#] &&
                          IntegerQ[ Together[ Last[#] - class]])&];

      classnum = Sort[ Together[ Last[#] - class]& /@ classnum];
      classden = Sort[ Together[ Last[#] - class]& /@ classden];

					(* fullfill gospers cond *)
      While[ classden =!= {} && classnum =!= {},
	 If[ First[ classden] > First[ classnum], 
	        q *= ShiftFactored[ classPoly, var, First[ classnum]]; 
		classnum = Rest[ classnum],      
	     p *= 
                Product[ ShiftFactored[ classPoly, var, i], 
                              {i, First[ classden], First[ classnum] - 1} ];
	     classden = Rest[ classden]; 
	     classnum = Rest[ classnum]
	 ]
      ];

      q *= Apply[Times, ShiftFactored[ classPoly, var, #]& /@ classnum];
      r *= Apply[Times, ShiftFactored[ classPoly, var, #]& /@ classden];
   ];
   q *= Apply[Times, Cancel[ #[[1]] * #[[2]]]& /@ numlist];
   r *= Apply[Times, Cancel[ #[[1]] * #[[2]]]& /@ denlist];

   Return[{nlp p, nlq q, ShiftFactored[ nlr r, var, -1]} /. MR]
]  


(* -------------------------------------------------------------------- *)
(*   calculate the shiftquotient					*)

Q[ free_, var_] := 1 /; FreeQ[ free, var]
Q[ hyp_Times, var_] := Q[ #, var]& /@ hyp;
Q[ hyp_^i_Integer, var_] := Q[ hyp, var]^i

Q[ arg_^exp_, var_]:= arg^IntLinCoef[ exp, var] /; FreeQ[ arg, var]

Q[ f_!, var_]:=
   Module[
      {coef = IntLinCoef[ f, var]},
   Return[  Which[ 
               coef === 0, 1,
               coef > 0, Product[ Factor[f+i], {i, coef}],
               coef < 0, 1 / Product[ Factor[f-i+1], {i, -coef}]
         ]  ]
]

Q[ Binomial[n_, k_], var_]:=
   Q[ n!, var] / Q[ (n-k)!, var] / Q[ k!, var]

Q[ rat_, var_]:=
   If[ ! PolynomialQ[ Numerator[rat], {var}] ||
       ! PolynomialQ[ Denominator[ rat], {var}],
         Print[ "The factor ", rat, " cannot be handled!"];
         Abort[],
      ShiftFactored[ rat, var, 1] / rat]

End[]
EndPackage[]


(* file:	zeilutil.m			*)
(* written by Peter Paule and Markus Schorn 	*)

BeginPackage["zeilutil`", {"algutil`"}]

PolyDeg
ZeilbergerSummand
CorrectingTerm
Conditions
SolveGosperEquation
Psi
PsiForFactored

Begin["`private`"]

(* -------------------------------------- *)
(* Degree of a polynomial giving -1 for 0 *)
PolyDeg[0, _] := -1
PolyDeg[expr_, var_] := Exponent[expr, var]

(* ------------------------------------------------------------------- *)
(* compute the impact of an unknown operator to a hypergeometric term  *)

ZeilbergerSummand[f_, ord_, var_, symbol_]:= 
   Module[
      {shqt, q,
       num, den, oldden, b0,
       i, r1, r2, gcd},

   shqt = norm[ Q[ f, var]];
   q = 1;
   oldden = 1;
   b0 = {symbol[0]};

   For[ i = 1, i <= ord, i++,
      q = NC[ q * ShiftFactored[ shqt, var, i-1]];
      den = Denominator[q];
      num = Numerator[q];

				(* calculate lcm of denomis *)
      {r1, r2, gcd} = GCDofFactored[ oldden, den];
      oldden *= r2;
      b0 = Append[ r2 b0, r1 num symbol[i]] /. MR;
   ];

   Return[{Plus @@ b0, oldden /. MR}];
]


(* ------------------------------------------------------------ *) 
(* compute the correction terms in dependence of NonRat(border) *)

CorrectingTerm[ _, 0, _, _, _, _, _, _] = 0
CorrectingTerm[ ord_, coef_, bound_, b0_, rule_, q_, var_, c_]:=
   Module[
      {result = 0, 
       index, rat=1, pm = 0, 
       b00 = b0, 
       nq = norm[q]},

   If[ bound > 0,
      If[ coef > 0,
         Do[ 
            b00 = norm[ Factor[ b00 /. c[index] -> 0]];
            Do[
               rat *= ShiftFactored[ nq, var, pm++];
               b00 =  ShiftFactored[ b00, var, 1];
               result += rat (b00 /. rule),
            {coef}],
         {index, 0, ord - 1}],

         Do[ 
            b00 = norm[ Factor[ b00 /. c[index] -> 0]];
            Do[
               result += rat (b00 /. rule);
               rat /= ShiftFactored[ nq, var, --pm];
               b00 =  ShiftFactored[ b00, var, -1],
            {-coef}],
         {index, 0, ord - 1}]
      ],

      If[ coef > 0,
         Do[ 
            b00 = norm[ Factor[ b00 /. c[index] -> 0]];
            Do[
               result += rat (b00 /. rule);
               rat *= ShiftFactored[ nq, var, pm++];
               b00 =  ShiftFactored[ b00, var, 1],
            {coef}],
         {index, 0, ord - 1}],

         Do[ 
            b00 = norm[ Factor[ b00 /. c[index] -> 0]];
            Do[
               rat /= ShiftFactored[ nq, var, --pm];
               b00 =  ShiftFactored[ b00, var, -1];
               result += rat (b00 /. rule),
            {-coef}],
         {index, 0, ord - 1}]
      ]
   ];

   Return[ result /. MR]   
]
	

(* -------------------------------------------------- *)
(* evaluable-form of Factorial-expressions              *)	

divide[pol_, var_]:=
  Module[ {coef},
     coef = Together[ Coefficient[ pol, Variables[pol][[1]]]];
     If[ coef === 0, coef = 1];
     {coef, Together[ pol / coef]}
     ] 	

Psi[ f_, var_]:=
   Module[
      {den, rest},
   den = Denominator[ f];
   {den, rest} = ExtractIntLin[ den, var];
   Psi[ den, Numerator[f]/ rest, var, 0]
]

Psi[ den_, f_, var_, v_] := 
   PsiForFactored[ Factor[den], Factor[f], var, v] /. MR

PsiForFactored[ den_, f_, var_, v_]:=
   Module[ 
       {fn, fd, 
        den1, nc,
        fac, bin, facmod, binmod,
        nonlin, const, 
        d, c, nd,
        newden = 1, newnum = 1,
        dif, sel, i, j, k},

   fn = NC[ Numerator[f]/den]; fd = Denominator[f];
   den1 = Denominator[ fn]; fn = Numerator[ fn]; 
   fn = FactoredToList[ fn]; fd = FactoredToList[ fd];
   {fac, fd} = PauleSchornSplit[ fd, MatchQ[ #, x_!]&];
   {bin, fn} = PauleSchornSplit[ fn, MatchQ[ #, Binomial[x_, y_]]&];
   facmod = divide[ First[#], var]& /@ fac;
   binmod = {divide[ First[#] - Last[#], var], 
             divide[ Last[#], var]}& /@ bin;
If[ v > 0, Print["fn = ", fn]];
If[ v > 0, Print["fd = ", fd]];
If[ v > 0, Print["fac = ", fac]];
If[ v > 0, Print["bin = ", bin]];

   {nonlin, den1} = ExtractNonIntLin[ den1, var];
   {const, den1} = ConstElems[ FactoredToList[ den1], var];
If[ v > 0, Print["nonlin = ", nonlin];
           Print["const = ", const];
           Print["den1 = ", den1]];

   While[ den1 =!= {},
      d = First[ den1]; den1 = Rest[ den1];

(* R1 *)  
      nc = NC[ newnum / d]; 
      If[ Denominator[nc] === 1, newnum = nc;
If[ v > 0, Print["R1 (", d,"): newnum = ", newnum]],

(* R2 *)  
      {c, nd} = divide[ d, var];
      dif = Together[ #[[1]](nd - #[[2]]) - 1]& /@ facmod;
      sel = Position[ dif, _?NaturalQ, {1}];
      If[ sel =!= {},
         sel = sel[[1,1]];
         j = facmod[[sel, 1]] / c;
         i = dif[[sel]];

         fac[[sel,1]] += i + 1;
         newnum *= j Product[ Factor[j c nd - k], {k, i}];
         facmod[[sel]] = divide[fac[[sel]], var];
If[ v > 0, Print["R2 (", d,"):"];
           Print["    newnum = ", newnum];
	   Print["    fac = ", fac]],
(* R7 *)
      dif = Together[ #[[2,1]](nd - #[[2,2]]) - 1]& /@ binmod;
      sel = Position[ dif, _?NaturalQ, {1}];
      If[ sel =!= {},
         sel = sel[[1,1]];
         j = binmod[[sel, 2, 1]] / c;
         i = dif[[sel]];

         newnum *= j Product[ Factor[j c nd - k], {k, i}];
         newden *= Product[ Factor[ bin[[sel, 1]] + k], {k, i+1}];
         bin[[sel,1]] += i+1;
         bin[[sel,2]] += i+1;
         binmod[[sel,2]] = divide[ bin[[sel,2]], var];
If[ v > 0, Print["R7 (", d,"):"];
           Print["    newnum = ", newnum];
	   Print["    newden = ", newden];
	   Print["    bin = ", bin]],
(* R8 *)
      dif = Together[ #[[1,1]](nd - #[[1,2]]) - 1]& /@ binmod;
      sel = Position[ dif, _?NaturalQ, {1}];
      If[ sel =!= {},
         sel = sel[[1,1]];
         j = binmod[[sel, 1, 1]] / c;
         i = dif[[sel]];

         newnum *= j Product[ Factor[j c nd - k], {k, i}];
         newden *= Product[ Factor[ bin[[sel, 1]] + k], {k, i+1}];
         bin[[sel,1]] += i+1;
         binmod[[sel,1]] = divide[ bin[[sel,1]] - bin[[sel, 2]], var];
If[ v > 0, Print["R8 (", d,"):" ];
           Print["    newnum = ", newnum];
	   Print["    newden = ", newden];
	   Print["    bin = ", bin]],

(* no rule *)
      newden *= d;
If[ v > 0, Print["No rule for ", d]]
   ]]]]];
   Return[ newnum / newden / nonlin / (Times @@ const) (Times @@ fn) / 
           (Times @@ fd) (Times @@ bin) / (Times @@ fac) ]
]


(* -------------------------------------------- *)
(* Binomial entries are supposed to be positive *)

Conditions[ f_, l_, u_, ord_, x1_, x2_] :=
   Module[
      {bins, nc, result, nat, cnat, ci, i, j, iv, res, z},

   bins = Union[ FactoredToList[ Numerator[f]], 
                 FactoredToList[ Denominator[f]]];
   bins = Select[ bins, MatchQ[#, Binomial[x_,y_]]&];

   nc = Union[ Flatten[
           Intersection[ Variables[#[[1]]], Variables[#[[2]]]]& /@ bins]];
   nc = Union[ nc, Variables[l], Variables[u], {x1}];

   bins = Union[ Expand[First[#]]& /@ bins];
   bins = AppendTo[ bins, Expand[u-l]]; 
   bins = Select[ bins, SameQ[ Complement[ Variables[#], nc], {}]&];

   result = If[ IntLinCoef[ #, x1] > 0,
         ((# /. x1 -> l) + ord * 
               Min[ 0, IntLinCoef[l, x2] IntLinCoef[#, x1] + 
                       IntLinCoef[#, x2]] )&  /@ bins,
         ((# /. x1 -> u) + ord *
               Min[ 0, IntLinCoef[u, x2] IntLinCoef[#, x1] + 
                       IntLinCoef[#, x2]] )&  /@ bins];

   nat = Expand[u-l];
   nat += Min[ 0, IntLinCoef[ nat, x2]];

   vl = Prepend[ Variables[ nat], x2];

   Do[
      If[ IntLinQ[ nat, vl[[i]]],
          iv = vl[[i]];
          cnat = IntLinCoef[ nat, iv]],
   {i, Length[vl]}];

   If[ cnat =!= 0,
      Do[
         ci = IntLinCoef[ result[[i]], iv];
         If[ i =!= j && ci cnat > 0, 
            res = Expand[ result[[i]] - ci/cnat nat];
 	    If[ res >= 0, result[[i]] = res]],
      {i, Length[ result]}]
   ];

   Do[
      z = Expand[ result[[j]]];
      vl = Prepend[ Variables[ z], x2];

      Do[
         If[ IntLinQ[ z, vl[[i]]],
            iv = vl[[i]];
            cnat = IntLinCoef[ z, iv]],
      {i, Length[vl]}];

      If[ cnat =!= 0,
         Do[
            ci = IntLinCoef[ result[[i]], iv];
            If[ i =!= j && ci =!=0,
               If[ NaturalQ[ cnat/ci], 
                  res = Expand[ result[[i]] - ci/cnat z];
 	          If[ NumberQ[res] && (! IntegerQ[res] || NaturalQ[res]),
                      result[[i]] = res
                  ];
               ];
            ],
         {i, Length[ result]}]
      ],
   {j, Length[result]}];

   result = Select[ Union[ Factor[result]], (!NumberQ[#] || NaturalQ[-#-1])&]; 

   Return[{nat,result}];
]


(* --------------------------------------------------------------- *)
(* find the degree-bound for solutions of the gosper equation      *)

findDegBound[ p_, q_, r_, var_, v_]:=
   Module[ 
      { pDeg, qDeg, rDeg, 
        qrneg, qrnegDeg, 
        k0, set},

   {pDeg, qDeg, rDeg} = PolyDeg[ #, var]& /@ {p, q, r};
If[ v > 0, Print[ "{pDeg, qDeg, rDeg}: ", {pDeg, qDeg, rDeg} ]];

   If[ rDeg > qDeg, Return[ pDeg - rDeg]];
   If[ rDeg < qDeg, Return[ pDeg - qDeg]];

   qLcf = Coefficient[ q, var, qDeg];
If[ v > 0, Print[ "qLcf: ", qLcf ]];
   If[ Expand[ Coefficient[ r, var, rDeg] - qLcf] =!= 0, 
      Return[ pDeg - qDeg]];

   qrneg = Expand[q - r];
   qrnegDeg = PolyDeg[ qrneg, var];
If[ v > 0, Print[ "qrnegDeg: ", qrnegDeg ]];      

   set = {pDeg - qDeg + 1};
   If[ qrnegDeg <= pDeg, AppendTo[ set, 0]];

   If[ qDeg === qrnegDeg + 1,
      k0 = Cancel[ -Coefficient[ qrneg, var, qrnegDeg] / qLcf];
If[ v > 0, Print[ "k0: ", k0 ]];      
         If[ IntegerQ[ k0],
            AppendTo[ set, k0]]];
   Max[set]   
]


(* ---------------------------------------------------- *)
(* solving gospers equation with additional variables   *)

SolveGosperEquation[ p_, q_, r_, var_, varlist_, systembreaker_, files_, v_] :=
   Module[ 
      {varmany, degbound, i, coefs, len, sols},

   varmany = Length[ varlist];	   
   degbound = findDegBound[ p, q, r, var, v-1];

If[ v > 0, Print["degbound = ", degbound]];
   If[ degbound < 0, Return[ {}]];

 					(* set up equations *)
   coefs = Join[ (Coefficient[ p, #, 1]& /@ varlist),
                 Table[ - q (var + 1)^i + r var^i, {i, 0, degbound}]];
   coefs = MyCoefficientList[ #, var]& /@ coefs;
   len = Max @@ (Length /@ coefs);
   coefs = Reverse[ Join[ #, Table[ 0, {len - Length[#]}]]]& /@ coefs;
   coefs = Transpose[ coefs];
   coefs = Select[ coefs, (!SameQ[ #, Table[ 0, {varmany + degbound + 1}]])&];


					(* solve equations *)
If[ v > 0, Print[ Dimensions[ coefs],  {"Equations", "Variables"}]];
If[ files, Put[ coefs, "~/.mat"]];
   sols = systembreaker[ coefs];
If[ v > 0, Print["sols = ", InputForm[sols]]];

   sols = Select[ sols, (Take[#, varmany] =!= Table[0, {varmany}])&];

				(* simplify solution vectors *)
   sols = PolyContent[ #][[2]]& /@ sols;
   sols = Prepend[ Take[ #, varmany], 
		  Sum[ #[[varmany+i+1]] var^i, {i, 0, degbound}]]& /@ sols;

   Return[ sols]
]
 (*-----------------------------------------------------------------------*)

End[]
EndPackage[]


(* file:	linsolve.m 	*)
(* written by	Markus Schorn 	*)


BeginPackage["linsolve`"]

NoSolutionByLinSolve
LinSolve

Begin["`privat`"]

LinSolve [A_List, b_List, NullSpaceAlgorithm_]:=
   Module[ 
      {nsp},
   nsp = NullSpaceAlgorithm[ Transpose[ Append[ Transpose[A], -b]]];
   nsp = Select[ nsp, (Last[#] =!= 0)&];
   If[ nsp === {}, Return[ NoSolutionByLinSolve]];

   Return[ Cancel[ Drop[First[nsp], -1] / Last[First[nsp]]]]
]

End[]
EndPackage[]


(* file:	enullspace.m 		*)
(* written by	Erhard Aichinger	*)


BeginPackage["enullspace`", {"linsolve`"}]

ENullspace
ELinSolve

Begin["`private`"]

ELinSolve [A_List, b_List]:= linsolve`LinSolve[A,b,ENullspace]

ENullspace [mat_List] :=
  Module[{res, perm, lines, columns, y, dim, M},

	 {lines, columns} = Dimensions[mat];
	 {M , perm} = MakeTriangularMatrix[lines, columns, mat];
	 {y, dim} = BackwardSubstitute[lines, columns, M];
	 res = SettleColumnExchanges[y, dim, columns, perm];
	 Return[res]
	]


MakeTriangularMatrix [lines_, columns_, mat_] :=
  Module[{perm, T=mat, ended=False, i=1, i1, j1,
	  iPivot, jPivot, Mult},

	 perm = Range[columns];
	 While[i <= lines && i <= columns && ! ended,
	       {iPivot, jPivot} = SearchPivot[T, i, lines, columns];
	       If[iPivot === 0,
		  ended = True,
		  T = ExchangeLines[i, iPivot, T, lines];
		  {T, perm} = ExchangeColumns[i, jPivot, T, lines, perm];

		  i1 = i + 1;
		  While[i1 <= lines,
			If[T[[i1, i]] =!= 0,
			   Mult = Cancel[T [[ i1, i ]] / T[[i,i]] ];
			   T[[i1, i]] = 0;
			   j1 = i + 1;
			   While[j1 <= columns,
				 T[[ i1, j1 ]] = Together[T[[i1, j1]] - Mult *
							  T[[i, j1]]];
				 j1++
				] (* for j1 *)
			  ]; (* if != 0 *)
			i1++
		       ] (* for i1 *)
		 ]; (* if iPivot == 0 *)
	       i++; 
	      ]; (* for i *)
	 Return[{T, perm}]
	]


BackwardSubstitute [lines_, columns_, T_] :=
  Module[{ last, dim, x, i, k, l, sum },

	 last = Min[lines, columns];
	 While[last > 0 && T [[last, last]] === 0, last--];

	 dim = columns - last;

	 x = Table [ Table [ 0, {columns} ], {dim} ]; (* BUG !!!! columns -> dim *)

	 i = 1;
	 While[last + i <= columns,
	       x[[i, last + i]] = 1;
	
	       k = last;
	       While[k >= 1,
		     sum = 0;

		     l = k + 1;
		     While[l <= last,
			   sum = Together[ sum +  T[[k,l]] * x[[i,l]]];

			   l++
			  ]; (* for l *)

		     sum = Together[sum + T[[k, last + i]]];
		     sum = -sum;

		     x [[i, k]] =  Cancel[sum / T[[k,k]]];

		     k--
		    ]; (* for k *)

	       i++
	      ]; (* for i *)

	 Return[{x, dim}]
	]


SettleColumnExchanges [y_, dim_, columns_, perm_] :=
  Module[{x, i, j},

	 x = Table [ Table [ 0, {columns} ], {dim} ];
	 Do[
	    Do[
	       x[[i, perm [[j]]]] = y[[i, j]],
	       {j, columns}
	      ],
	    {i, dim}
	   ];

	 Return[x]
	]


SearchPivot [T_, i_, lines_, columns_] :=
  Module[{currentIPivot, currentJPivot, currentSize, i1, j1, sizeI1J1},

	 currentIPivot = 0;
	 currentSize = Infinity;

	 i1 = i;
	 While[i1 <= lines,

	       j1 = i;
	       While[j1 <= columns,
		     If[T[[i1, j1]] =!= 0,
			sizeI1J1 = PivotSize[T[[i1, j1]] ];

			If[sizeI1J1 < currentSize,

			   currentSize = sizeI1J1;
			   currentIPivot = i1;
			   currentJPivot = j1
			  ]
			];

		     j1++
		    ];

	       i1++
	      ];
	 Return[{currentIPivot, currentJPivot}]
	]


PivotSize [p_] := LeafCount [p]


TotalLength [p_, bound_] :=
  Module[{l, i, sum},
	 l = Length[p];

	 If[l === 0,
	    Return[1],

	    sum = 0;
	    i = 1;
	    While[i <= l && sum < bound,
		  sum = sum + TotalLength[p[[i]], bound - sum];
		  i++
		 ];
	    Return[sum]
	   ]
	]



ExchangeLines [i1_, i2_, M_, lines_] :=
  Module[{i},
	 Return[Table[If[i === i1,
			 M[[i2]],
			 If[i === i2,
			    M[[i1]],
			    M[[i]]
			   ]
			 ],{i,lines}
		      ]
		 ]
	 ]


ExchangeColumns [j1_, j2_, M_, lines_, perm_] :=
  Module[{i, newPerm, newM},

	 newPerm = perm;
	 newPerm[[j1]] = perm[[j2]];
	 newPerm[[j2]] = perm[[j1]];

	 newM = M;

	 i = 1;
	 While[i <= lines,
	       newM[[i, j1]] = M[[i, j2]];
	       newM[[i, j2]] = M[[i, j1]];

	       i++
	      ];

	Return[{newM, newPerm}]
       ]

End[]
EndPackage[]


(* file:        zb_alg.m                      *)
(* written by:  Peter Paule and Markus Schorn *)
(* slightly modified by Wolfram Koepf for the use in SpecialFunctions *)
(* an original copy can be obtained by anonymous ftp from
   ftp.risc.uni-linz.ac.at *)

BeginPackage["fastZeil`",{"algutil`","zeilutil`", "enullspace`"}]


Zb::usage = "Zb[ function, range, n, order], 
uses Zeilberger's algorithm to find a recurrence relation of given order in n
for the sum of the function over the range.
\n\nZb[ function, k, recvar, order],
uses Zeilberger's algorithm to find a recurrence relation of given order in n
for the function. This recurrence is -- up to a telescoping part -- free of k."


Gosper::usage = "Gosper[ function, range],
uses Gosper's algorithm to find a hypergeometric closed form for the sum
of the function over the range,
\n\nGosper[ function, k], computes the hypergeometric forward anti-difference
of function in k, if it exists,
\n\nGosper[ function, range, degree] or
\nGosper[ function, k, degree] use Gosper's algorithm with an
undetermined polynomial of given degree in k multiplied to the function."

Systembreaker::usage = "Systembreaker contains the method used to find the 
nullspace of a matrix during the execution of either Zb or Gosper. 
For instance, Systembreaker = NullSpace uses the built in algorithm."

Prove::usage = "Prove produces a short certificate for the last result
obtained by using either Zb or Gosper and appends it to the file named `proof',
\n\nProve[filename] appends the certificate to the specified file."

SUM::usage = "SUM is an abbreviation for the sum of the function over the range
used in the output. Both the function and the range is defined by your input
to the algorithm. Reveal its definition by Show[SUM]!"

F::usage = "F is an abbreviation for your inputted function, used in the
output. Reveal its definition by Show[F]!"
R::usage = "R is an abbreviation for the rational function that yields the
anti-difference of F and is used in the output. Reveal its definition by
Show[R]!"

Unprotect[Show]
Show::usage = "Show[abbreviation] reveals the definition for the abbreviation.
Abbreviations that may be used are SUM, F and R."

Delta::usage ="Delta[ k, function] denotes the forward difference operator in
k applied to the function."

pl

Begin["`private`"] 
LINE = 0

(* --------------------------------------------------------------------- *)
(* Zeilberger's algorithm for natural bounds                             *)

Zb[ _, _Symbol, _Symbol, order_] := "Use Gosper's Algorithm!" /; order <= 0
Zb[ f_, x1_Symbol, x2_Symbol, order_Integer, pl -> v_]  := 
   Zb[f, {x1, -Infinity, Infinity}, x2, order, pl -> v]


(* --------------------------------------------------------------------- *)
(* Gosper's algorithm using the Zeilberger implementation                *)


Gosper[ f_, {x1_Symbol, bl_, bu_}, pl -> p_] := 
   Zb[ f, {x1, bl, bu}, x2, 0, pl -> p]
Gosper[ f_, {x1_Symbol, bl_, bu_}, deg_Integer, pl -> p_] := 
     Zb[ f, {x1, bl, bu}, x2, -deg, pl -> p]

Gosper[ f_, x1_Symbol, pl -> p_] := Gosper[ f, {x1, Delta, Delta}, pl -> p]
Gosper[ f_, x1_Symbol, deg_Integer, pl -> p_]  :=    
     Gosper[ f, {x1, Delta, Delta}, deg, pl -> p]

Gosper[ a_, b_] := Gosper[a,b,pl->0]
Gosper[ a_, b_, c_] := Gosper[a,b,c,pl->0]

(* --------------------------------------------------------------------- *)
(* the common interface bu Zeilberger/Gosper                             *)

f/: Format[f] := "f";
y/: Format[y] := "y";

Zb[ a_,b_,c_,d_] := Zb[a,b,c,d,pl -> 0]

Zb[ f_, {x1_Symbol, bl_, bu_}, x2_Symbol, ord_Integer, pl -> v_]:=
   Module[
      { c, i, j,
        f1, f2,
        varlist, 
        b0, b1,
        nonlin,
        shqt, p, q, r,
	sollist, outlist, sol, solrule,
        cl, cu, cbl, cbu, gratl, gratu, g, gu, gl,
        rhs, bounds
},
   c/: Format[c] := "c";

   Clear[ Show, ANTI];
   LINE = $Line;

				(* presetting dependent on Gosper/Zb *)
   f1 = Factor[ f];
   Show[F] = f1;
   varlist = Array[ c, Abs[ord] + 1, 0];

   If[ ord <= 0,
				(* this is the Gosper call *)
          b0 = Sum[ c[i] x1^i, {i, 0, -ord}];
          b1 = 1,

      (* else *)
				(* here we run Zeilberger's *)         
      {b0, b1} = ZeilbergerSummand[ f1, ord, x2, c];
   ];

If[ v > 0, Print["b0 = ", b0]];
If[ v > 0, Print["b1 = ", b1]];


				(* work around non-linear polynomials *)
   {nonlin, f2} = ExtractNonIntLin[ NC[f1/b1], x1]; 
If[ v > 0, Print["nonlin = ", nonlin]];
If[ v > 0, Print["f2 = ", f2]];


				(* calculate GP-form of shift-quotient *)
   shqt = NC[ Q[ f2, x1]];
   {p,q,r} = GP[ shqt, x1] * {nonlin, 1, 1};
   shqt *= ShiftFactored[ nonlin, x1, 1] / nonlin;

If[ v > 0,
   Print["Q f/b1 = ", shqt];
   Print["Gosper's equation:"]; 
   Print[ b0 p == q y[x1 + 1] - r y[x1], "."]
];

   sollist = SolveGosperEquation[ b0 p, q, r, x1, varlist, Systembreaker, 
                                  Files, v-1];

If[ v > 0, Print["Solutions for y and the c's:"]; Print[ sollist]];


				(* no solution *)
   If[ sollist === {}, Return[ {}]];

				(* some solutions *)
   outlist = {};
   Do[
				(* initialization *)
      sol = sollist[[i]];
      solrule = Thread[ varlist -> Drop[ sol, 1]];

				(* compute rational function for certificate *)
      gratl = r First[ sol] / p;
      gratu = q ShiftFactored[ First[ sol], x1, 1] / p;   
      Show[R] = gratl/b1;

If[ v > 0, Print["{gratl, gratu} =", {gratl, gratu}]];

      If[ ord > 0 && Abs[ bl] === Infinity && bu === Infinity,
            rhs = 0; 
            bounds = False,
      (* else *)
         bounds = True;
			        (* rat. representation of correcting terms *)
         If[ ord <= 0,
               cl = cu = 0,

         (* else *)
If[ v > 0, Print["Calculating correcting terms"]];

            {cbl, cbu} = 
               If[ Abs[#] === Infinity, 0, IntLinCoef[ #, x2]]& /@ {bl, bu};

            cl = Sign[cbl] CorrectingTerm[ ord, cbl, -1, b0, solrule, 
                                 shqt, x1, c];
            cu = Sign[cbu] CorrectingTerm[ ord, cbu, 1, b0, solrule, 
                                 shqt, x1, c];
If[ v > 0, Print["{cl, cu} =", {cl, cu}]];
         ];
		
				(* corrected rational factors *)
         cratl = If[ Abs[bl] === Infinity, 0, Factor[ Together[ gratl + cl]]];
         cratu = If[ Abs[bu] === Infinity, 0, Factor[ Together[ gratu + cu]]];
If[ v > 0, Print["{cratl, cratu} =", {cratl, cratu}]];

				(* make Stammfunction evaluable at bounds *)
	 g = PsiForFactored[ b1, f1, x1, v-1];
If[ v > 0, Print["f1/b1 = ", g]];
         gl = PsiForFactored[ Denominator[ cratl], g Numerator[ cratl], 
                              x1, v-1];
         gu = PsiForFactored[ Denominator[ cratu], g Numerator[ cratu], 
                              x1, v-1];
If[ v > 0, Print["{gl, gu} =", {gl, gu}]];
      ];

      If[ ord > 0,
				(* Zeilberger-Output *)
            If[ bounds,
                  ProofType = Sumrecursion;
                  RHS = Factor[gu /. x1 -> bu] - Factor[ gl /. x1 -> bl];
                  LHS = Table[ SUM[x2 + i], {i, 0, ord}] . 
                        Factor[ Drop[ sol, 1]] /. MR;
                  ANTI = Show[R] F; 
		  Show[SUM] = Sum[ Show[F], {x1, bl, bu}],
               ProofType = Recursion;
               RHS = 0;
	       LHS = Table[ SUM[x2 + i], {i, 0, ord}] . 
                     Factor[ Drop[ sol, 1]] /. MR;
            ];
            AppendTo[ outlist, LHS == RHS],

      (* else *)
         			(* Gosper-Output *)
         If[ bl === Delta, 
               ProofType = Divideout;
	       If[ ord === 0,
		     RHS = Delta[ x1, gl/sol[[2]]];
		     LHS = f1,
                  RHS = Delta[ x1, gl];
 		  LHS = Factor[ b0 /. solrule /. MR] f1;
               ];
               AppendTo[ outlist, LHS == RHS],

	    ProofType = Sumevaluation;
            If[ ord === 0,
                  RHS = Factor[gu/tag /. x1 -> bu] - 
                        Factor[ gl/tag /. x1 -> bl] /. tag -> sol[[2]];
                  LHS = Sum[f1, {x1, bl, bu}];
                  ANTI = gl/sol[[2]],
               RHS = Factor[gu /. x1 -> bu] - Factor[ gl /. x1 -> bl];
               LHS = Sum[Factor[ b0 /. solrule /. MR] f1, {x1, bl, bu}];
               ANTI = gl;
            ];
            AppendTo[ outlist, LHS == RHS]
         ];
      ];
   ,{i, Length[ sollist]}];

   If[ Abs[bl] =!= Infinity && Abs[bu] =!= Infinity && bl =!= Delta,
      cond = Conditions[ f1, bl, bu, ord, x1, x2];
      If[ cond[[2]] === {},
         CondText =  "If `" <> ToString[cond[[1]]] <> 
                     "' is a natural number, then:",
         If[ Length[ cond[[2]]] === 1,
               CondText = "If `" <> ToString[cond[[1]]] <> 
			  "' is a natural number" <>
                          "\nand `" <> ToString[cond[[2,1]]] <>
                          "' is no negative integer, then:",
            CondText = "If `" <> ToString[cond[[1]]] <> 
                       "' is a natural number and none of \n" <> 
                       ToString[ cond[[2]]] <> "\nis a negative integer, then:"
         ]
      ];
      Print[ CondText];
   ];

   If[ bl =!= Delta && outlist =!= {}, OK = True];
   Return[ outlist];
]

Clear[ ProofType];
Prove := Prove1[ ProofType, "proof"]
Prove[ filename_] := Prove1[ ProofType, filename]

Prove1[ Divideout, file_] :=
   Module[
      {handle, w, skip},

   handle = OpenAppend[ file, FormatType -> OutputForm];
   w[ x_] := Write[ handle, x];
   skip[ n_]:= Do[ Write[ file], {n}];     

   Print["Creating proof for Out[", LINE, "] in file '", file,"'."];

   w["Computer Theorem:"];
   w[ SequenceForm["Let ", Delta[RHS[[1]], "."],
      " denote the forward difference operator in ", RHS[[1]], " then"]];
   w[LHS == RHS];
   skip[1];
   w["Proof:"]; 
   w["By dividing the right-hand side by the left-hand one,"]; 
   w["we get a rational function that simplifies to 1."];
   w["------------------------------------------------------------------------"];
   Close[ handle];
]

Prove1[ Sumevaluation, file_] :=
   Module[
      {handle, w, skip},

   handle = OpenAppend[ file, FormatType -> OutputForm];
   w[ x_] := Write[ handle, x];
   skip[ n_]:= Do[ Write[ file], {n}];     

   Print["Creating proof for Out[", LINE, "] in file '", file,"'."];

   w["Computer Theorem:"];
   w[CondText];
   w[LHS == RHS];
   skip[2];
   w["Proof:"]; 
   w[ SequenceForm["Let ", Delta[ANTI[[1]], "."],
      " denote the forward difference operator in ", RHS[[1]], " then"]];
   w["the Theorem follows from summing the equation"];
   skip[1];
   w[ LHS[[1]] == Delta[ LHS[[2,1]], ANTI]];
   skip[1];
   w[ "over the range " <> ToString[LHS[[2]]] <> "."];
   skip[1];
   w[ "The equation is routinely verifyable by dividing the right-hand side by"];
   w[ "the left-hand one and simplifying the resulting rational function to 1."];
   w["------------------------------------------------------------------------"];
   Close[ handle];
]

Prove1[ Recursion, file_] :=
   Module[
      {handle, w, skip},

   handle = OpenAppend[ file, FormatType -> OutputForm];
   w[ x_] := Write[ handle, x];
   skip[ n_]:= Do[ Write[ file], {n}];     

   Print["Creating proof for Out[", LINE, "] in file '", file,"'."];

   w["Computer Theorem:"];
   w[ SequenceForm["Let ", Delta[RHS[[1]], "."],
      " denote the forward difference operator in ", RHS[[1]], " let"]];

   w[SequenceForm[F, " := ", Show[F], " and"]];
   w[SequenceForm[R, " := ", Show[R], ", then"]];
   skip[1];
   w[SequenceForm[LHS == RHS,"."]];
   skip[2];
   w["Proof:"]; 
   w["By dividing both sides of the equation by F, we find a rational equation"];
   w["that can be verified routinely."];
   w["------------------------------------------------------------------------"];
   Close[ handle];
]

Prove1[ Sumrecursion, file_] :=
   Module[
      {handle, w, skip, n, var, iterator, recvar, a, b, c, d},

   handle = OpenAppend[ file, FormatType -> OutputForm];
   w[ x_] := Write[ handle, x];
   skip[ n_]:= Do[ Write[ file], {n}];     

   Print["Creating proof for Out[", LINE, "] in file '", file,"'."];

   iterator = Part[ Show[SUM], 2]; 
   var = First[ iterator];
   recvar = LHS /. (a_ SUM[b_Symbol + c_] + d_:0) -> b;

   w["Computer Theorem:"];
   w[ SequenceForm["Let ",F, " := ", Show[F], 
       " and ", SUM, " := ", Sum[F, Evaluate[ iterator]], ", then:"]];
   w[ CondText];
   w[ SequenceForm[LHS == RHS, "."]];
   skip[2];
   w["Proof:"]; 
   w[ SequenceForm["Let ", Delta[var, "."],
      " denote the forward difference operator in ", var, " and define"]];
   w[ SequenceForm[ R, " := ", Show[R], ","]];
   w["then the Theorem follows from summing the equation"];
   skip[1];
   w[ (LHS /. SUM[n_] -> F[ var, n]) == Delta[ var, R F[var, recvar]]];
   skip[1];
   w[ SequenceForm["over the range ", iterator, "."]];
   skip[1];
   w[ "This equation is routinely verifyable by dividing both sides by F,"];
   w[ "and checking the resulting rational equation."];
   w["----------------------------------------------------------------------"];
   Close[ handle];
]

End[];
EndPackage[]

Systembreaker = ENullspace

(* Print[ "Fast Zeilberger by Peter Paule and Markus Schorn. (V 2.2)"];
Print[ "Systembreaker = ", Systembreaker];
*)

(* 
done ...
PAULE-SCHORN PACKAGE 
*)

(* PACKAGE *)
BeginPackage["SpecialFunctions`"]

Unprotect[D]

(* Beginn Einfuegung fuer Buch *)

DiskreteStammfunktion::usage =
"DiskreteStammfunktion[a, k] ist eine Anwendung des Gosperalgorithmus und 
erzeugt eine diskrete Stammfunktion. Koepf: Computeralgebra, Springer, 2006, S. 436"

GradSchranke::usage =
"GradSchranke[A, B, C, k] ist ein Teil des Gosperalgorithmus und bestimmt die 
Gradschranke einer Polynoml\[ODoubleDot]sung einer inhomogenen Rekursion. Koepf: Computeralgebra, 
Springer, 2006, S. 413"

PrimDispersion::usage =
"PrimDispersion[q, r, k] ist ein Teil des Gosperalgorithmus und bestimmt die 
Dispersion zweier irreduzibler Polynome. Koepf: Computeralgebra, Springer, 2006, S. 417"

DispersionsMenge::usage =
"DispersionsMenge[q, r, k] ist ein Teil des Gosperalgorithmus und bestimmt die 
Dispersionsmenge zweier Polynome. Koepf: Computeralgebra, Springer, 2006, S. 418"

REtoPol::usage =
"REtoPol[A, B, C, k] ist ein Teil des Gosperalgorithmus und bestimmt die 
Polynoml\[ODoubleDot]sung einer inhomogenen Rekursion. Koepf: Computeralgebra, Springer, 2006, S. 414"

SumRekursion::usage =
"SumRekursion[F, k, S[n]] ist eine Anwendung des Zeilbergeralgorithmus und 
erzeugt eine Rekursion f\[UDoubleDot]r eine definite hypergeometrische Summe. Koepf: 
Computeralgebra, Springer, 2006, S. 424"

WZCertificate::usage =
"WZCertificate[F, k, n] liefert das WZ-Zertifikat einer konstanten hypergeometrischen
Summe unter Anwendung des Gosperalgorithmus. Koepf: Computeralgebra, Springer, 2006, 
S. 431"

(* Ende Einfuegung fuer Buch *)

(* Airy function *)

Ai::usage = "Ai[n,x] is the iterated derivative D[AiryAi[x],{x,n}]"

Literal[Derivative[0,kk_][Ai]]:=Module[{n,xx},
Function[{n,xx},Ai[n+kk,xx]]]
D[Ai[n_,xx_],xx_]:= Derivative[0,1][Ai][n,xx]
Ai[0,xx_]:=AiryAi[xx]
Ai[1,xx_]:=AiryAiPrime[xx]

(* Bateman *)

(* AS (13.6) *)
Bateman::usage = "Bateman[n,x] is the Bateman function given by
Bateman[n,x] ==
(-1)^n*2/Pi*Integrate[Cos[t*Tan[theta]-2*n*theta],{theta,0,Pi/2}]"

Bateman[0,xx_]:=E^(-xx)

Bateman[1,xx_]:=(-2*xx)/E^xx

Literal[Derivative[0,1][Bateman]]:=Module[{n,xx},
Function[{n,xx},
1/xx*((n-xx)*Bateman[n, xx]-(n-1)*Bateman[n-1, xx])]]

D[Bateman[n_,xx_],xx_]:= Derivative[0,1][Bateman][n, xx]

D[Bateman[n_,xx_],{xx_,kk_}]:=D[D[Bateman[n, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* Hankel functions *)

(* AS (9.1.3)-(9.1.4) *) 

Hankel1::usage = "Hankel1[n,x] is the first Hankel function,
see Abramowitz/Stegun, (9.1.3)"

Hankel2::usage = "Hankel2[n,x] is the second Hankel function,
see Abramowitz/Stegun, (9.1.4)"

Literal[Derivative[0,1][Hankel1]]:=Module[{n,xx},
Function[{n,xx},
(Hankel1[n-1,xx] - (n/xx) * Hankel1[n,xx])]]

D[Hankel1[n_,xx_],xx_]:= Derivative[0,1][Hankel1][n, xx]

D[Hankel1[n_,xx_],{xx_,kk_}]:=D[D[Hankel1[n, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

Literal[Derivative[0,1][Hankel2]]:=Module[{n,xx},
Function[{n,xx},
(Hankel2[n-1,xx] - (n/xx) * Hankel2[n,xx])]]

D[Hankel2[n_,xx_],xx_]:= Derivative[0,1][Hankel2][n, xx]

D[Hankel2[n_,xx_],{xx_,kk_}]:=D[D[Hankel2[n, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* Kummer functions *)

(* AS (13.1.2) *)
KummerM::usage = "KummerM[a,b,z] is Kummer's M-function given by
KummerM[a,b,z] == Sum[Pochhammer[a,k]/(Pochhammer[b,k]*k!)*z^k,{k,0,Infinity}],
see Abramowitz/Stegun, (13.1.2)."

Literal[Derivative[0,0,1][KummerM]]:=Module[{aa,b,xx},
Function[{aa,b,xx},
1/xx*((b-aa)*KummerM[aa-1,b,xx]-(b-aa-xx)*KummerM[aa,b,xx])]]

D[KummerM[n_,m_,xx_],xx_]:= Derivative[0,0,1][KummerM][n, m, xx]

D[KummerM[n_,m_,xx_],{xx_,kk_}]:=D[D[KummerM[n, m, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* AS (13.1.3) *)
KummerU::usage = "KummerU[a,b,z] is Kummer's U-function given by
KummerU[a,b,z] == Pi/Sin[Pi*b]*(KummerM[a,b,z]/(Gamma[1+a-b]*Gamma[b]) -
 z^(1-b)*KummerM[1+a-b,2-b,z]/(Gamma[a]*Gamma[2-b])), see
Abramowitz/Stegun, (13.1.3)."

Literal[Derivative[0,0,1][KummerU]]:=Module[{aa,b,xx},
Function[{aa,b,xx},
(- KummerU[aa-1,b,xx] + (aa-b+xx)*KummerU[aa,b,xx])/xx]]

D[KummerU[n_,m_,xx_],xx_]:= Derivative[0,0,1][KummerU][n, m, xx]

D[KummerU[n_,m_,xx_],{xx_,kk_}]:=D[D[KummerU[n, m, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* Whittaker functions *)

(* AS (13.1.32) *)
WhittakerM::usage = "WhittakerM[a,b,z] is Whittakers M-function given by
WhittakerM[a,b,z] == E^(-z/2)*z^(1/2+b)*KummerM[1/2+b-a,1+2*b,z], see
Abramowitz/Stegun, (13.1.32)."

Literal[Derivative[0,0,1][WhittakerM]]:=Module[{n,m,xx},
Function[{n,m,xx},
1/(2*xx)*((1+2*m-2*n)*WhittakerM[n-1,m,xx] + (2*n-xx)*WhittakerM[n,m,xx])]]

D[WhittakerM[n_,m_,xx_],xx_]:= Derivative[0,0,1][WhittakerM][n, m, xx]

(* AS (13.1.33) *)
WhittakerW::usage = "WhittakerW[a,b,z] is Whittakers W-function given by
WhittakerW[a,b,z] == E^(-z/2)*z^(1/2+b)*KummerU[1/2+b-a,1+2*b,z], see
Abramowitz/Stegun, (13.1.33)."

D[WhittakerM[n_,m_,xx_],{xx_,kk_}]:=D[D[WhittakerM[n, m, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

Literal[Derivative[0,0,1][WhittakerW]]:=Module[{n,m,xx},
Function[{n,m,xx},
1/(4*xx)*((1-4*m^2-4*n+4*n^2)*WhittakerW[n-1,m,xx] +
(4*n-2*xx)*WhittakerW[n,m,xx])]]

D[WhittakerW[n_,m_,xx_],xx_]:= Derivative[0,0,1][WhittakerW][n, m, xx]

D[WhittakerW[n_,m_,xx_],{xx_,kk_}]:=D[D[WhittakerW[n, m, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* Hypergeometric1F0 function *)

Hypergeometric1F0::usage = "Hypergeometric1F0[a,z] is the
hypergeometric function 1F0(a; ; z)."

Literal[Derivative[0,1][Hypergeometric1F0]]:=Module[{aa,xx},
Function[{aa,xx},
aa/(1-xx)*Hypergeometric1F0[aa,xx]]
]

D[Hypergeometric1F0[aa_,xx_],xx_]:=
Derivative[0,1][Hypergeometric1F0][aa,xx]

D[Hypergeometric1F0[aa_,xx_],{xx_,kk_}]:=
D[D[Hypergeometric1F0[aa,xx],{xx,kk-1}],xx]/; (IntegerQ[kk] && kk>1)

(* Hypergeometric2F0 function *)

Hypergeometric2F0::usage = "Hypergeometric2F0[a,b,z] is the
hypergeometric function 2F0(a, b; ; z)."

Literal[Derivative[0,0,1][Hypergeometric2F0]]:=Module[{aa,b,xx},
Function[{aa,b,xx},
aa/xx*(Hypergeometric2F0[aa+1,b,xx]-Hypergeometric2F0[aa,b,xx])]]

D[Hypergeometric2F0[aa_,b_,xx_],xx_]:=
Derivative[0,0,1][Hypergeometric2F0][aa,b,xx]

D[Hypergeometric2F0[aa_,b_,xx_],{xx_,kk_}]:=
D[D[Hypergeometric2F0[aa,b,xx],{xx,kk-1}],xx]/; (IntegerQ[kk] && kk>1)

(* Hypergeometric2F3 function *)

Hypergeometric2F3::usage = "Hypergeometric2F3[a,b,c,d,e,z] is the
hypergeometric function 2F3(a, b; c, d, e; z)."

Literal[Derivative[0,0,0,0,0,1][Hypergeometric2F3]]:=Module[{aa,b,cc,d,e,xx},
Function[{aa,b,cc,d,e,xx},
aa/xx*(Hypergeometric2F3[aa+1,b,cc,d,e,xx]-Hypergeometric2F3[aa,b,cc,d,e,xx])]]

D[Hypergeometric2F3[aa_,b_,cc_,d_,e_,xx_],xx_]:=
Derivative[0,0,0,0,0,1][Hypergeometric2F3][aa,b,cc,d,e,xx]

D[Hypergeometric2F3[aa_,b_,cc_,d_,e_,xx_],{xx_,kk_}]:=
D[D[Hypergeometric2F3[aa,b,cc,d,e,xx],{xx,kk-1}],xx]/; (IntegerQ[kk] && kk>1)

(* Hypergeometric3F2 function *)

Hypergeometric3F2::usage = "Hypergeometric3F2[a,b,c,d,e,z] is the
hypergeometric function 3F2(a, b, c; d, e; z)."

Literal[Derivative[0,0,0,0,0,1][Hypergeometric3F2]]:=Module[{aa,b,cc,d,e,xx},
Function[{aa,b,cc,d,e,xx},
aa/xx*(Hypergeometric3F2[aa+1,b,cc,d,e,xx]-Hypergeometric3F2[aa,b,cc,d,e,xx])]]

D[Hypergeometric3F2[aa_,b_,cc_,d_,e_,xx_],xx_]:=
Derivative[0,0,0,0,0,1][Hypergeometric3F2][aa,b,cc,d,e,xx]

D[Hypergeometric3F2[aa_,b_,cc_,d_,e_,xx_],xx_]:=
Derivative[0,0,0,0,0,1][Hypergeometric3F2][aa,b,cc,d,e,xx]

(* Struve functions *)

StruveH::usage = "StruveH[n,x] is the Struve H-function, see
Abramowitz/Stegun, (12.1.3)."

(* AS (12.1.9)-(12.1.10) *)
Literal[Derivative[0,1][StruveH]]:=Module[{n,xx},
Function[{n,xx},
(xx*StruveH[-1 + n,xx] - n*StruveH[n,xx])/xx]]

D[StruveH[n_,xx_],xx_]:=Derivative[0,1][StruveH][n, xx]

D[StruveH[n_, xx_],{xx_,kk_}]:= D[D[StruveH[n, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

StruveL::usage = "StruveL[n,x] is the Struve L-function, see
Abramowitz/Stegun, (12.2.1)."

(* AS (12.2.4)-(12.2.5) *)
Literal[Derivative[0,1][StruveL]]:=Module[{n,xx},
Function[{n,xx},
(xx*StruveL[-1 + n,xx] - n*StruveL[n,xx])/xx]]

D[StruveL[n_,xx_],xx_]:=Derivative[0,1][StruveL][n, xx]

D[StruveL[n_, xx_],{xx_,kk_}]:= D[D[StruveL[n, xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* AS (27.5) *)
Abramowitz::usage = "Abramowitz[n,z] is the Abramowitz function given by
Abramowitz[n,z] == Integrate[t^n*Exp[-t^2-z/t],{t,0,Infinity}],
see Abramowitz/Stegun, (27.5)."

Literal[Derivative[0,kk_][Abramowitz]]:=Module[{n,xx},
Function[{n,xx},(-1)^kk*Abramowitz[n-kk,xx]]]
D[Abramowitz[n_,xx_],xx_]:= Derivative[0,1][Abramowitz][n,xx]

Abramowitz[n_,0]:=Gamma[(n+1)/2]/2

(* NormalIntegral *)
(* AS (26.2.41) *)

NormalIntegral::usage = "NormalIntegral[n,z] is the repeated integral of
the Normal Probability Integral, see Abramowitz/Stegun, (26.2.41)."

Literal[Derivative[0,kk_][NormalIntegral]]:=Module[{n,xx},
Function[{n,xx},(-1)^kk*NormalIntegral[n-kk,xx]]]
D[NormalIntegral[n_,xx_],xx_]:= Derivative[0,1][NormalIntegral][n,xx]

NormalIntegral[-1,xx_]:=1/Sqrt[2 Pi]*E^(-xx^2/2)
NormalIntegral[0,xx_]:=1/2 - Erf[xx/2^(1/2)]/2

KnuthA::usage = "KnuthA[n,x] is the function
KnuthA[n,x]==E^(-x^3/6)/3^((n+1)/3)*
Sum[(3^(2/3)*x/2)^k/(k!*Gamma[(n+1-2k)/3]),{k,0,Infinity}]"

KnuthB::usage = "KnuthB[n,x] is the function KnuthB[n,x]==1/3^((n+1)/3)*
Sum[(3^(2/3)*x/2)^k/(k!*Gamma[(n+1-2k)/3]),{k,0,Infinity}]"

(* Knuth (10.23) *)
Literal[Derivative[0,1][KnuthA]]:=Module[{n,xx},
Function[{n,xx},KnuthA[n-2,xx]/2-xx^2*KnuthA[n,xx]/2]]
D[KnuthA[n_,xx_],xx_]:= Derivative[0,1][KnuthA][n,xx]
D[KnuthA[n_,xx_],{xx_,kk_}]:=D[D[KnuthA[n,xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* Knuth (10.6) *)
Literal[Derivative[0,1][KnuthB]]:=Module[{n,xx},
Function[{n,xx},KnuthB[n-2,xx]/2]]
D[KnuthB[n_,xx_],xx_]:= Derivative[0,1][KnuthB][n,xx]
D[KnuthB[n_,xx_],{xx_,kk_}]:=D[D[KnuthB[n,xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

ParabolicU::usage = "ParabolicU[n,z] is the parabolic cylinder function
U(n,z), see Abramowitz/Stegun, Chapter 19."

ParabolicV::usage = "ParabolicV[n,z] is the parabolic cylinder function
V(n,z), see Abramowitz/Stegun, Chapter 19."

ParabolicD::usage = "ParabolicD[n,z] is the parabolic cylinder function
D(n,z), see Abramowitz/Stegun, Chapter 19."

(* AS (19.6.2) *)
Literal[Derivative[0,1][ParabolicU]]:=Module[{n,xx},
Function[{n,xx},-ParabolicU[n-1,xx]+xx/2*ParabolicU[n,xx]]]
D[ParabolicU[n_,xx_],xx_]:= Derivative[0,1][ParabolicU][n,xx]
D[ParabolicU[n_,xx_],{xx_,kk_}]:=D[D[ParabolicU[n,xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* AS (19.6.5) *)
Literal[Derivative[0,1][ParabolicV]]:=Module[{n,xx},
Function[{n,xx},(n-1/2)*ParabolicV[n-1,xx]+xx/2*ParabolicV[n,xx]]]
D[ParabolicV[n_,xx_],xx_]:= Derivative[0,1][ParabolicV][n,xx]
D[ParabolicV[n_,xx_],{xx_,kk_}]:=D[D[ParabolicV[n,xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

(* using AS (19.3.1) *)
Literal[Derivative[0,1][ParabolicD]]:=Module[{n,xx},
Function[{n,xx},-ParabolicD[n+1,xx]+xx/2*ParabolicD[n,xx]]]
D[ParabolicD[n_,xx_],xx_]:= Derivative[0,1][ParabolicD][n,xx]
D[ParabolicD[n_,xx_],{xx_,kk_}]:=D[D[ParabolicD[n,xx],{xx,kk-1}],xx]/;
(IntegerQ[kk] && kk>1)

SphericalBesselJ::usage = "SphericalBesselJ[n,x] is the spherical
Bessel function SphericalBesselJ[n,x]=Sqrt[Pi/(2x)]*BesselJ[n+1/2,x]"

SphericalBesselY::usage = "SphericalBesselY[n,x] is the spherical
Bessel function SphericalBesselY[n,x]=Sqrt[Pi/(2x)]*BesselY[n+1/2,x]"

SphericalBesselI::usage = "SphericalBesselI[n,x] is the spherical
Bessel function SphericalBesselI[n,x]=Sqrt[Pi/(2x)]*BesselI[n+1/2,x]"

SphericalBesselK::usage = "SphericalBesselK[n,x] is the spherical
Bessel function SphericalBesselK[n,x]=Sqrt[Pi/(2x)]*BesselK[n+1/2,x]"

SphericalHankel1::usage = "SphericalHankel1[n,x] is the spherical
Hankel function SphericalHankel1[n,x]=Sqrt[Pi/(2x)]*Hankel1[n+1/2,x]"

SphericalHankel2::usage = "SphericalHankel2[n,x] is the spherical
Hankel function SphericalHankel2[n,x]=Sqrt[Pi/(2x)]*Hankel2[n+1/2,x]"

SphericalBesselJ[n_,xx_]:=Sqrt[Pi/(2xx)]*BesselJ[n+1/2,xx]

SphericalBesselY[n_,xx_]:=Sqrt[Pi/(2xx)]*BesselY[n+1/2,xx]

SphericalHankel1[n_,xx_]:=Sqrt[Pi/(2xx)]*Hankel1[n+1/2,xx]

SphericalHankel2[n_,xx_]:=Sqrt[Pi/(2xx)]*Hankel2[n+1/2,xx]

SphericalBesselI[n_,xx_]:=Sqrt[Pi/(2xx)]*BesselI[n+1/2,xx]

(* here a second one is mentioned *)

SphericalBesselK[n_,xx_]:=Sqrt[Pi/(2xx)]*BesselK[n+1/2,xx]

Krawtchouk::usage = "Krawtchouk[n,N,p,x] denote the Krawtchouk polynomials,
Krawtchouk[n,N,p,x] == (-1)^n*Binomial[N,n]*p^n*Hypergeometric2F1[-n,-x,-N,1/p],
see Nikiforov, Suslov, Uvarov: Classical Orthogonal Polynomials of a
Discrete Variable"

Krawtchouk[n_,N_,p_,xx_]:=Module[{kk,init,tmp,tab},
        If[n==0,Return[1]];
        init=tmp=(-1)^n*Binomial[N,n]*p^n;
        tab=Table[tmp=tmp*(kk-n)*(kk-xx)/(kk-N)/(kk+1)/p,{kk,0,n-1}];
        init+Apply[Plus,tab]
] /; (IntegerQ[n] && n>=0)

Charlier::usage = "Charlier[n,mu,x] denote the Charlier polynomials,
Charlier[n,mu,x] == Hypergeometric2F0[-n,-x,-1/mu], see Nikiforov,
Suslov, Uvarov: Classical Orthogonal Polynomials of a Discrete Variable"

Charlier[n_,mu_,xx_]:=Module[{kk,init,tmp,tab},
        If[n==0,Return[1]];
        init=tmp=1;
        tab=Table[tmp=-tmp*(kk-n)*(kk-xx)/(kk+1)/mu,{kk,0,n-1}];
        init+Apply[Plus,tab]
] /; (IntegerQ[n] && n>=0)

Meixner::usage = "Meixner[n,gamma,mu,x] denote the Meixner polynomials,
Meixnerm[n,gamma,mu,x] ==
Pochhammer[gamma,n]*Hypergeometric2F1[-n,-x,gamma,1-1/mu],
see Nikiforov, Suslov, Uvarov: Classical Orthogonal Polynomials of a
Discrete Variable"

Meixner[n_,gamma_,mu_,xx_]:=Module[{kk,init,tmp,tab},
        If[n==0,Return[1]];
        init=tmp=Pochhammer[gamma,n];
        tab=Table[tmp=tmp*(kk-n)*(kk-xx)/(kk+gamma)/(kk+1)*(1-1/mu),{kk,0,n-1}];
        init+Apply[Plus,tab]
] /; (IntegerQ[n] && n>=0)

DiscreteLaguerre::usage = "DiscreteLaguerre[n,rho,alpha,x] denote the
discrete Laguerre polynomials
DiscreteLaguerre[n,rho,alpha,x] == Pochhammer[1+alpha,n]*rho^n/n!*
Hypergeometric2F1[-n,-x+1,1+alpha,1-1/rho]"

DiscreteLaguerre[n_,rho_,alpha_,xx_]:=Module[{kk,init,tmp,tab},
        If[n==0,Return[1]];
        init=tmp=Pochhammer[1+alpha,n]*rho^n/n!;
        tab=Table[tmp=tmp*(kk-n)*(kk-xx+1)/(kk+1+alpha)/(kk+1)*(1-1/rho),
	{kk,0,n-1}];
        init+Apply[Plus,tab]
] /; (IntegerQ[n] && n>=0)

Hahn::usage = "Hahn[n,N,alpha,beta,x] denote the discrete Hahn
polynomials, Hahn[n,N,alpha,beta,x] ==
(-1)^n/n!*Pochhammer[N-n,n]*Pochhammer[beta+1,n]*
HypergeometricPFQ[{-n,-x,alpha+beta+n+1},{beta+1,1-N},1],
see Nikiforov, Suslov, Uvarov: Classical Orthogonal
Polynomials of a Discrete Variable"

Hahn[n_,N_,alpha_,beta_,xx_]:=Module[{kk,init,tmp,tab},
        If[n==0,Return[1]];
        init=tmp=(-1)^n/n!*Pochhammer[N-n,n]*Pochhammer[beta+1,n];
        tab=Table[
	tmp=tmp*(kk-n)*(kk-xx)*(kk+alpha+beta+n+1)/(kk+1)/(kk+beta+1)/(kk+1-N),
        {kk,0,n-1}];
        init+Apply[Plus,tab]
] /; (IntegerQ[n] && n>=0)

DiscreteChebyshev::usage = "DiscreteChebyshev[n,N,x] denote the
discrete Chebyshev polynomials,
DiscreteChebyshev[n,N,x] ==
(-1)^n*Pochhammer[N-n,n]*HypergeometricPFQ[{-n,-x,n+1},{1,-N},1],
see Nikiforov, Suslov, Uvarov: Classical
Orthogonal Polynomials of a Discrete Variable"

DiscreteChebyshev[n_,N_,xx_]:= Hahn[n,N,0,0,xx] /; (IntegerQ[n] && n>=0)

Protect[D]

(* usages *)

ZTransform::usage = "ZTransform[a,k,z] gives the Z Transform
Sum[a[k] z^(-k),{k,0,Infinity}].\n\n
Example: ZTransform[1/k!,k,z] results in\n\n
 1/z\n
E"

InverseZTransform::usage = "InverseZTransform[f,z] gives the inverse
Z Transform f[z]==Sum[a[k] z^(-k),{k,0,Infinity}].\n\n 
Example: InverseZTransform[E^(1/z),z] results in\n\n
     1 k\n
    (-)\n
     z\n
sum[----, {k, 0, Infinity}]\n
     k!"

SumDE::usage = "SumDE[de1,de2,F[x]] gives the holonomic differential
equation for the sum f+g, given holonomic differential equations de1 for f
and de2 for g in terms of F[x]. You can also use SumDE[de1,de2,F,x].\n\n
Example: SumDE[F''[x]-F[x]==0,F'[x]-x F[x]==0,F[x]] results in\n\n
      2                          2              (3)\n
(2 + x ) F[x] - x F'[x] + (-2 - x ) F''[x] + x F   [x] == 0"

DESum::usage = "DESum[de1,de2,F[x]] gives the holonomic differential
equation for the sum f+g, given holonomic differential equations de1 for f
and de2 for g in terms of F[x]. You can also use DESum[de1,de2,F,x].\n\n
Example: DESum[F''[x]-F[x]==0,F'[x]-x F[x]==0,F[x]] results in\n\n
      2                          2              (3)\n
(2 + x ) F[x] - x F'[x] + (-2 - x ) F''[x] + x F   [x] == 0"

ProductDE::usage = "ProductDE[de1,de2,F[x]] gives the holonomic differential
equation for the product f*g, given holonomic differential equations de1 for f
and de2 for g in terms of F[x]. You can also use ProductDE[de1,de2,F,x].\n\n
Example: ProductDE[F''[x]-F[x]==0,F'[x]-x F[x]==0,F[x]] results in\n\n
       2\n
(-2 + x ) F[x] - 2 x F'[x] + F''[x] == 0"

DEProduct::usage = "DEProduct[de1,de2,F[x]] gives the holonomic differential
equation for the product f*g, given holonomic differential equations de1 for f
and de2 for g in terms of F[x]. You can also use DEProduct[de1,de2,F,x].\n\n
Example: DEProduct[F''[x]-F[x]==0,F'[x]-x F[x]==0,F[x]] results in\n\n
       2\n
(-2 + x ) F[x] - 2 x F'[x] + F''[x] == 0"

SumRE::usage = "SumRE[re1,re2,A[k] gives the holonomic recurrence
equation for the sum a+b, given holonomic recurrence equations re1 for a
and re2 for b given in terms of A[k]. You can also use SumRE[re1,re2,A,k].\n\n
Example: SumRE[A[k+1]==A[k]/(k+1),A[k+1]==A[k]+A[k-1],A[k]] results
in\n\n
                                      2    3\n
(2 + k) (4 + k) A[k] + (-1 - 9 k - 6 k  - k ) A[1 + k] +\n
\n
                 2    3                            2\n
(-17 - 21 k - 8 k  - k ) A[2 + k] + (1 + k) (3 + k)  A[3 + k] == 0"

RESum::usage = "RESum[re1,re2,A[k]] gives the holonomic recurrence
equation for the sum a+b, given holonomic recurrence equations re1 for a
and re2 for b given in terms of A[k]. You can also use RESum[re1,re2,A,k].\n\n
Example: RESum[A[k+1]==A[k]/(k+1),A[k+1]==A[k]+A[k-1],A[k]] results
in\n\n
                                      2    3\n
(2 + k) (4 + k) A[k] + (-1 - 9 k - 6 k  - k ) A[1 + k] +\n
\n
                 2    3                            2\n
(-17 - 21 k - 8 k  - k ) A[2 + k] + (1 + k) (3 + k)  A[3 + k] == 0"

ProductRE::usage = "ProductRE[re1,re2,A[k]] gives the holonomic recurrence
equation for the product a*b, given holonomic recurrence equations re1 for a
and re2 for b given in terms of A[k]. You can also use
ProductRE[re1,re2,A,k].\n\n
Example: ProductRE[A[k+1]==A[k]/(k+1),A[k+1]==A[k]+A[k-1],A[k]] results
in\n\n
A[k] + (1 + k) A[1 + k] - (1 + k) (2 + k) A[2 + k] == 0"

REProduct::usage = "REProduct[re1,re2,A[k]] gives the holonomic recurrence
equation for the product a*b, given holonomic recurrence equations re1 for a
and re2 for b given in terms of A[k].You can also use
REProduct[re1,re2,A,k].\n\n
Example: REProduct[A[k+1]==A[k]/(k+1),A[k+1]==A[k]+A[k-1],A[k]] results
in\n\n
A[k] + (1 + k) A[1 + k] - (1 + k) (2 + k) A[2 + k] == 0"

ConvolutionRE::usage = "ConvolutionRE[b,c,A[k],n] gives the holonomic
recurrence equation of the sum Sum[b[k]*c[n-k],{k,0,n}] in terms of A[k].
You can also us ConvolutionRE[b,c,k,n,A].\n\n
Example: ConvolutionRE[(-1/2)^m PolyGamma[1+m]/m!,1/m!,a[m],n] results
in\n\n
a[n] - (8 + 5 n) a[1 + n] + 2 (2 + n) (9 + 4 n) a[2 + n] -\n\n
                 2\n
4 (2 + n) (3 + n)  a[3 + n] == 0"

SumToHypergeometric::usage = "SumToHypergeometric[f] calculates a
hypergeometric representation of
an expression f involving sums of the form Sum[expr,{k,0,Infinity}].\n\n
Example: SumToHypergeometric[sum[(-1)^k*Binomial[2n,k]^2,{k,0,Infinity}]]
results in\n\n
hypergeometricPFQ[{-2 n, -2 n}, {1}, -1]"

FunctionToHypergeometric::usage = "FunctionToHypergeometric[f,x]
calculates a hypergeometric representation of an expression f.\n\n
Example: FunctionToHypergeometric[Sin[x],x] results in\n\n
                               2\n
                         3   -x\n
x hypergeometricPFQ[{}, {-}, ---]\n
                         2    4"

HolonomicDE::usage = "HolonomicDE[g,f[x]] searches for a homogeneous linear
differential equation with polynomial coefficients for the function
g of the variable x, and results in this DE using the symbol f[x].
You can also use HolonomicDE[g,x,f] or the shortform HolonomicDE[g,x].\n\n
Example: HolonomicDE[ArcSin[x]^2,f[x]] results in\n\n
                                       (3)\n
f'[x] + 3 x f''[x] + (-1 + x) (1 + x) f   [x] == 0"

holonomicDE::usage = "HolonomicDE[g,f[x],max] searches for a homogeneous linear
differential equation with polynomial coefficients for the function
g of the variable x up to order max, and results in this DE using the symbol f[x].
You can also use holonomicDE[g,f[x]] with max=5.\n\n
Example: holonomicDE[ArcSin[x]^2,f[x]] results in\n\n
                                       (3)\n
f'[x] + 3 x f''[x] + (-1 + x) (1 + x) f   [x] == 0"

HolonomicRE::usage = "HolonomicRE[expr,a[k]] finds a homogeneous
recurrence equation with polynomial coefficients satisfied by expr
depending on k, and results in this RE using the symbol a[k].
You can also use HolonomicRE[expr,k,a] or the shortform HolonomicRE[expr,k].\n\n
Example: HolonomicRE[(-3 - (1/3)^k + 3*(1/2)^k),a[k]] results in\n\n
a[k] - 6 a[1 + k] + 11 a[2 + k] - 6 a[3 + k] == 0"

ComplexFactor::usage = "ComplexFactor[f,x] gives the complex factorization
of the rational expression f with respect to the variable x.\n\n
Example: ComplexFactor[(1-x^2)/(1+x^2),x] results in\n\n
  (-1 + x) (1 + x)\n
-(----------------)\n
  (-I + x) (I + x)"

ComplexApart::usage = "ComplexApart[f,x] gives the complex partial fraction
decomposition of the rational expression f with respect to the variable x.\n\n
Example: ComplexApart[(1-x^2)/(1+x^2),x] results in\n\n
        I        I\n
-1 - ------ + -----\n
     -I + x   I + x"

SimpleDE::usage = "SimpleDE[g,f[x]] searches for a homogeneous linear
differential equation with polynomial coefficients for the function
f of the variable x, and results in this DE using the symbol f[x].
You can also use SimpleDE[g,x,f] or the shortform SimpleDE[g,x].\n\n
Example: SimpleDE[ArcSin[x]^2,f[x]] results in\n\n
                                       (3)\n
f'[x] + 3 x f''[x] + (-1 + x) (1 + x) f   [x] == 0"

DEtoRE::usage = "DEtoRE[de,F[x],a[k]] converts the homogeneous linear
differential equation de of the function F[x] with polynomial coefficients
into an equivalent recurrence equation using the general coefficient a[k].
You can also use DEtoRE[de,F,x,a,k] or the shortform DEtoRE[de,F,x].\n\n
Example: DEtoRE[G[t] + G''[t] == 0,G[t],b[n]] results in\n\n
b[n] + (1 + n) (2 + n) b[2 + n] == 0"

SimpleRE::usage = "SimpleRE[f,x,a[k]] searches for a homogeneous linear
recurrence equation with polynomial coefficients for the formal power series
coefficients of the expression f with respect to the variable x, and results
in this RE using the symbol a[k] for the general coefficient. You can also use
SimpleRE[f,x,a,k] or the shortform SimpleRE[f,x].\n\n
Example: SimpleRE[Sin[t],t,b[n]] results in\n\n
b[n] + (1 + n) (2 + n) b[2 + n] == 0"

SeriesSolution::usage = "SeriesSolution[DE,y[x],incslist,n]
gives the n-th order power series approximation of the holonomic
differential equation DE in terms of y[x], using the initial values
incslist. You can also use SeriesSolution[DE,y,x,incslist,n].\n\n
Example: SeriesSolution[y''[x]-x*y[x]==0,y[x],{AiryAi[0],AiryAi'[0]},3]
results in\n\n
                                          3\n
        x                1               x\n
-(-------------) + ------------- + ---------------\n
   1/3       1      2/3       2       2/3       2\n
  3    Gamma[-]    3    Gamma[-]   6 3    Gamma[-]\n
             3                3                 3"

Taylor::usage = "Taylor[f,{x,x0,n}] calculates the nth order power series
approximation of f at the point x0 with respect to variable x, by
computing a holonomic differential equation of f, if applicable.
For holonomic functions this is the fasted known method. For x0=0
ypu can also use Taylor[f,x,n].\n\n
Example: Taylor[Sin[x]*Exp[x],{x,0,13}] results in\n\n
          3    5    6    7      9       10        11        13\n
     2   x    x    x    x      x       x         x         x\n
x + x  + -- - -- - -- - --- + ----- + ------ + ------- - --------\n
         3    30   90   630   22680   113400   1247400   97297200"

PowerSeries::usage = "PowerSeries[f,x,x0] tries to find a formal power series
expansion for f with respect to the variable x at the point of development x0.
It also works for formal Laurent series (negative exponents), for Puiseux
series (fractional exponents), and in certain cases of
logarithmic singularities. PS is a shortform for PowerSeries.\n\n
Example: PowerSeries[Sin[x],x,Pi] results in\n\n
          k          1 + 2 k\n
      (-1)  (-Pi + x)\n
sum[-(----------------------), {k, 0, Infinity}]\n
            (1 + 2 k)!"

PS::usage = PowerSeries::usage 

FPS::usage = PowerSeries::usage 

(* begin Algebraic package *)
AlgebraicDE::usage = "AlgebraicDE[F,y[x]] searches for a homogeneous linear
differential equation with polynomial coefficients for the function y[x]
of the variable x, given by the algebraic equation F[x,y]==0, and results
in this differential equation. The order of the differential equation is at
most the order of F with respect to y.\n\n
Example: AlgebraicDE[y^3+x^2 y-2 x^3,y[x]] results in\n\n
-y[x] + x y'[x] == 0"
(* end Algebraic package *)


Convert::usage="Convert[sum[expr*x^(m*k+b),{k,k0,Infinity}],x] converts
the Laurent-Puiseux series Sum[expr*x^(m*k+b),{k,k0,Infinity}] to its generating
function with respect to the variable x.\n\n
Example: Convert[sum[(k!)^2/(2k)!x^k,{k,0,Infinity}],x] results in\n\n
                                                 Sqrt[4 - x] (-2 + x)\n
                                2 Sqrt[x] ArcTan[--------------------]\n
  -4          Pi Sqrt[x]                           (-4 + x) Sqrt[x]\n
------ - -------------------- + --------------------------------------\n
-4 + x   Sqrt[4 - x] (-4 + x)            Sqrt[4 - x] (-4 + x)"

GeneratingFunction::usage="GeneratingFunction[a,k,x] calculates the
generating function Sum[a*x^k,{k,0,Infinity}] in terms of the
variable x of the sequence a depending on k.\n\n
Example: GeneratingFunction[LegendreP[n,x],n,z] results in\n\n
         1\n
--------------------\n
                  2\n
Sqrt[1 - 2 x z + z ]"

ExponentialGeneratingFunction::usage="ExponentialGeneratingFunction[a,k,x]
calculates the exponential generating function Sum[a*x^k/k!,{k,0,Infinity}]
in terms of the variable x of the sequence a depending on k.\n\n
Example: ExponentialGeneratingFunction[HermiteH[n,x],n,z] results
in\n\n
 (2 x - z) z\n
E"

SimpByRecursion::usage=
"SimpByRecursion[expr] simplifies an expression involving special
functions according to known recurrence equations. \n\n
Example: SimpByRecursion[x*BesselI[n+2,x]+2*(1+n)*BesselI[n+1,x]]
results in \n\n
x BesselI[n, x]"

FindRecursion::usage="FindRecursion[expr,a[k]] finds a homogeneous
recurrence equation with polynomial coefficients satisfied by expr
depending on k, and results in this RE using the symbol a[k]. 
You can also use FindRecursion[expr,k,a] or thee shortform
FindRecursion[expr,k].\n\n
Example: FindRecursion[(-3 - (1/3)^k + 3*(1/2)^k),a[k]] results in\n\n
a[k] - 6 a[1 + k] + 11 a[2 + k] - 6 a[3 + k] == 0"

DEOrder::usage = "DEOrder[de,y[x]] gives the order of the linear differential
equation de formed by the expression y depending on the variable x.
You can also use DEOrder[de,y,x]."

AsymptPowerSeries::usage="AsymptPowerSeries[f,x] tries to find a formal
asymptotic power series expansion for f with respect to the variable x
for x->+Infinity. It also works for formal Laurent series, and in certain
cases of fractional, or logarithmic singularities.
\n\n
Example: AsymptPowerSeries[ArcTan[x],x] results in\n\n
               k  1 1 + 2 k\n
           (-1)  (-)\n
Pi                x\n
-- + sum[-(----------------), {k, 0, Infinity}]\n
2              1 + 2 k"

specfunprint::usage = "specfunprint turns on the specfun-info messages
of the SpecialFunctions package."

specfunprintoff::usage = "specfunprintoff turns off the specfun-info
messages of the SpecialFunctions package."

nospecfunprint::usage = "nospecfunprint turns off the specfun-info
messages of the SpecialFunctions package."

REtoDE::usage = "REtoDE[re,a[k],f[x]] converts the homogeneous linear
recurrence equation re of the function a[k] with polynomial coefficients
into an equivalent differential equation using the general function f[x].
You can also use REtoDE[re,a,k,f,x] or the shortform REtoDE[re,a,k].\n\n
Example: REtoDE[a[k+1]==a[k]+a[k-1],a[k],f[x]] results in\n\n
                                      2\n
-f[x] - 2 x f[x] + f'[x] - x f'[x] - x  f'[x] == 0"

RETODE::usage = "RETODE[re,a,k,f,x] converts the homogeneous linear
recurrence equation re of the function a[k] with polynomial coefficients
into an equivalent differential equation using the general function f[x],
assuming the recurrence equation is valid for all integer k. Hence an
inhomogeneous part might be missing. A shortform is RETODE[re,a,k].\n\n
Example: RETODE[a[k+1]==a[k]+a[k-1],a,k] results in\n\n
          2\n
(1 - x - x ) f[x] == 0"

SumtoDE::usage = "SumtoDE[sum[expr*x^k,{k,0,Infinity}],f[x]] converts
the power series Sum[expr*x^k,{k,0,Infinity}] to a differential equation
using the general function f[x]. You can also use
SumtoDE[sum[expr*x^k,{k,0,Infinity}],x,f] or the shortform
SumtoDE[sum[expr*x^k,{k,0,Infinity}],x].\n\n
Example: SumtoDE[sum[(k!)^2/(2k)!x^k,{k,0,Infinity}],f[x]] results in\n\n
                                           2\n
f[x] - 2 f'[x] + 3 x f'[x] - 4 x f''[x] + x  f''[x] == 0"

SimplifyCombinatorial::usage = "SimplifyCombinatorial[expr] simplifies
expressions involving rational functions, exponentials, factorials,
Gamma function terms, Binomial coefficients, and Pochhammer symbols by
a conversion to Gamma function terms, and an application of SimplifyGamma.\n\n
Example: SimplifyCombinatorial[(Binomial[n,k]/2^n-Binomial[n-1,k]/2^(n-1))/\n
         (Binomial[n,k-1]/2^n-Binomial[n-1,k-1]/2^(n-1))] results in\n\n
(-1 + k - n) (2 k - n)\n
----------------------\n
   k (2 - 2 k + n)"

SimpComb::usage = "SimplifyCombinatorial[expr] simplifies
expressions involving rational functions, exponentials, factorials,
Gamma function terms, Binomial coefficients, and Pochhammer symbols by
a conversion to Gamma function terms, and an application of SimplifyGamma.\n\n
Example: SimpComb[(Binomial[n,k]/2^n-Binomial[n-1,k]/2^(n-1))/\n
         (Binomial[n,k-1]/2^n-Binomial[n-1,k-1]/2^(n-1))] results in\n\n
(-1 + k - n) (2 k - n)\n
----------------------\n
   k (2 - 2 k + n)"

ToGamma::usage = "ToGamma[expr] converts expressions involving factorials,
Binomial coefficients, and Pochhammer symbols to Gamma function terms.\n\n
Example: ToGamma[Binomial[n,k]] results in\n\n
        Gamma[1 + n]\n
-----------------------------\n
Gamma[1 + k] Gamma[1 - k + n]"

Ratio::usage = "Ratio[expr,k] simplifies the term ratio expr[k+1]/expr[k]
if expr is written in terms of expressions involving rational functions,
exponentials, and Gamma function terms.\n\n
Example: Ratio[Binomial[n+1,k]-Binomial[n,k],k] results in\n\n
1 - k + n\n
---------\n
    k"

HyperTerm::usage = "HyperTerm[upper,lower,x,k] gives the k-th summand of
the hypergeometric function HypergeometricPFQ[upper,lower,x].\n\n
Example: HyperTerm[{a,b},{c},x,k] results in\n\n
 k\n
x  Pochhammer[a, k] Pochhammer[b, k]\n
------------------------------------\n
        k! Pochhammer[c, k]"


(* PACKAGE *)
Begin["`Private`"]
Unprotect[
ComplexFactor,ComplexApart,SimpleDE,DEtoRE,SimpleRE,
PowerSeries,PS,FPS,Convert,SimpByRecursion,FindRecursion,
AsymptPowerSeries,Bateman,specfunprint,specfunprintoff,nospecfunprint,REtoDE,SumtoDE]

(* Version for Mathematica Version 2.2 to 5.2 *)
specfuninfo = 
"SpecialFunctions, (C) Wolfram Koepf, version 2.01, 2006"

Print[specfuninfo]
Print["Fast Zeilberger, (C) Peter Paule and Markus Schorn (V 2.2) loaded"]


(* Beginn Einfuegung fuer Buch *)

Clear[GradSchranke]
GradSchranke[A_,B_,C_,k_]:=Module[{pol1,pol2,deg1,deg2,a,b},
    pol1=Collect[A-B,k];
    pol2=Collect[A+B,k];
    If[pol1===0,deg1=-1,deg1=Exponent[pol1,k]];
    If[pol2===0,deg2=-1,deg2=Exponent[pol2,k]];
    If[deg1\[LessEqual]deg2,Print["Teil 1"];Return[Exponent[C,k]-deg2]];
    a=Coefficient[pol1,k,deg1];
    If[deg2<deg1-1,b=0,b=Coefficient[pol2,k,deg2]];
    If[Not[IntegerQ[-2*b/a]&&-2*b/a\[GreaterEqual]0],Print["Teil 2a"];
      Return[Exponent[C,k]-deg1+1],Print["Teil 2b"];
      Return[Max[-2*b/a,Exponent[C,k]-deg1+1]]]
    ]

Clear[REtoPol]
REtoPol[A_,B_,C_,k_]:=Module[{ deg,g,\[Alpha],j,rec,sol,result},
    deg=GradSchranke[A,B,C,k];
    If[deg<0,Return["keine Polynoml\[ODoubleDot]sung"]];
    g=Sum[\[Alpha][j]*k^j,{j,0,deg}];
    rec=Collect[A*(g/.k\[Rule]k+1)+B*g-C,k];
    sol=Solve[CoefficientList[rec,k]\[Equal]0,Table[\[Alpha][j],{j,0,deg}]];
    If[sol==={},Return["keine Polynoml\[ODoubleDot]sung"]];
    result=g/.sol[[1]]/.\[Alpha][_]\[Rule]0
    ]

Clear[PrimDispersion]
PrimDispersion[q_,r_,k_]:=Module[{s,t,n,a,b,c,d,j},
    s=Collect[q,k];
    t=Collect[r,k];
    n=Exponent[s,k];
    If[n===0 || Not[n==Exponent[t,k]],Return[{}]];
    a=Coefficient[s,k,n];
    b=Coefficient[s,k,n-1];
    c=Coefficient[t,k,n];
    d=Coefficient[t,k,n-1];
    j=Together[(b*c-a*d)/(a*c*n)];
    If[Not[IntegerQ[j]&& j\[GreaterEqual]0],Return[{}]];
    If[Together[c*s-a*(t/.k\[Rule]k+j)]===0,Return[{j}],Return[{}]]
    ]

Clear[DispersionsMenge]
DispersionsMenge[q_,r_,k_]:=Module[{f,g,m,n,i,j,result,tmp,op1,op2},
    f=Factor[q];
    g=Factor[r];
    If[Not[Head[f]===Times],m=1,m=Length[f]];
    If[Not[Head[g]===Times],n=1,n=Length[g]];
    result={};
    Do[
      If[Head[f]===Times,op1=f[[i]],op1=f];
      If[Head[op1]===Power,op1=op1[[1]]];
      Do[
        If[Head[g]===Times,op2=g[[j]],op2=g];
        If[Head[op2]===Power,op2=op2[[1]]];
        tmp=PrimDispersion[op1,op2,k];
        If[Not[tmp==={}],AppendTo[result,tmp[[1]]]],
        {j,1,n}],
      {i,1,m}];
    Union[result]
    ]

Clear[DiskreteStammfunktion]
DiskreteStammfunktion[a_,k_]:=Module[{rat,u,v,M,dis,h,j,A,B,CC,gcd,g},
    rat=SimplifyCombinatorial[(a/.k\[Rule]k+1)/a];
    u=Numerator[rat];
    v=Denominator[rat];
    If[Not[PolynomialQ[u,k] &&PolynomialQ[v,k]],
      Return["Eingabe ist kein hypergeometrischer Term"]];
    M=DispersionsMenge[u/.k\[Rule]k-1,v,k];
    If[M==={},dis=-1,
      dis=Max[M]];
    h=PolynomialGCD[Product[u/.k\[Rule]k-1-j,{j,0,dis}],
        Product[v/.k\[Rule]k+j,{j,0,dis}]];
    If[dis<1,
      A=Together[u/(h/.k\[Rule]k+1)];
      B=-Together[v/h];CC=v,
      gcd=PolynomialGCD[h*u,-(h/.k\[Rule]k+1)*v,h*(h/.k\[Rule]k+1)*v];
      A=Together[h*u/gcd];B=Together[-(h/.k\[Rule]k+1)*v/gcd];
      CC=Together[h*(h/.k\[Rule]k+1)*v/gcd]];
    g=REtoPol[A,B,CC,k];
    If[g==="keine Polynoml\[ODoubleDot]sung",
      Return["Es gibt keine hypergeometrische Stammfunktion"]];
    Together[g/h]*a 
    ]

Clear[SumRekursion]
SumRekursion[F_,k_,S_[n_]]:=
  Module[{a,\[Sigma],ratk,ratn,rat,nenner,u,v,M,dis,h,j,deg,rec,sol,A,B,CC,
      gcd,\[Alpha],g,RE},
    RE={};
    Do[
      ratk=SimplifyCombinatorial[(F/.k\[Rule]k+1)/F];
      ratn=SimplifyCombinatorial[(F/.n\[Rule]n+1)/F];
      nenner=1+Sum[\[Sigma][j]*Product[ratn/.n\[Rule]n+i,{i,0,j-1}],{j,J}];
      rat=Together[ratk*(nenner/.k\[Rule]k+1)/nenner];
      u=Numerator[rat];
      v=Denominator[rat];
      If[Not[PolynomialQ[u,k] &&PolynomialQ[v,k]],Return[]];
      M=DispersionsMenge[u/.k\[Rule]k-1,v,k];
      dis=Max[M];
      h=PolynomialGCD[Product[u/.k\[Rule]k-1-j,{j,0,dis}],
          Product[v/.k\[Rule]k+j,{j,0,dis}]];
      If[dis\[Equal]0,
        A=Together[u/(h/.k\[Rule]k+1)];
        B=-Together[v/h];
        CC=v,
        A=h*u;
        B=-(h/.k\[Rule]k+1)*v;
        CC=h*(h/.k\[Rule]k+1)*v];
      gcd=PolynomialGCD[A,B,CC];
      A=Together[A/gcd];
      B=Together[B/gcd];
      CC=Together[CC/gcd];
      deg=GradSchranke[A,B,CC,k];
      If[deg>=0,
        g=Sum[\[Alpha][j]*k^j,{j,0,deg}];
        rec=Collect[A*(g/.k\[Rule]k+1)+B*g-CC,k];
        sol=
          Solve[CoefficientList[rec,k]\[Equal]0,
            Union[Table[\[Alpha][j],{j,0,deg}],Table[\[Sigma][j],{j,1,J}]]];
        If[Not[sol==={}],
          RE=S[n]+Sum[\[Sigma][j]*S[n+j]/.sol[[1]],{j,1,J}];
          RE=Numerator[Together[RE]];
          RE=Collect[RE,S[___]];
          RE=Map[Factor,RE];
          Return[]
          ]
        ]
      ,{J,1,5}];
    If[Not[PolynomialQ[u,k] &&PolynomialQ[v,k]],
      Return["Eingabe ist kein hypergeometrischer Term"],
      If[RE==={},
        "Es gibt keine Rekursion der Ordnung 5",RE\[Equal]0]]
    ]

Clear[WZCertificate]
WZCertificate[F_,k_,n_]:=
  Module[{ratk,ratn,rat,u,v,M,dis,h,j,A,B,CC,gcd,g},
    ratk=SimplifyCombinatorial[(F/.k\[Rule]k+1)/F];
    ratn=SimplifyCombinatorial[(F/.n\[Rule]n+1)/F];
    rat=SimplifyCombinatorial[ratk*((ratn/.k\[Rule]k+1)-1)/(ratn-1)];
    u=Numerator[rat];
    v=Denominator[rat];
    If[Not[PolynomialQ[u,k]&&PolynomialQ[v,k]],
      Return["Eingabe ist kein hypergeometrischer Term"]];
    M=DispersionsMenge[u/.k\[Rule]k-1,v,k];
    dis=Max[M];
    h=PolynomialGCD[Product[u/.k\[Rule]k-1-j,{j,0,dis}],
        Product[v/.k\[Rule]k+j,{j,0,dis}]];
    If[dis<1,A=Together[u/(h/.k\[Rule]k+1)];
      B=-Together[v/h]; CC=v,
      gcd=PolynomialGCD[h*u,-(h/.k\[Rule]k+1)*v,h*(h/.k\[Rule]k+1)*v];
      A=Together[h*u/gcd]; B=Together[-(h/.k\[Rule]k+1)*v/gcd]; 
      CC=Together[h*(h/.k\[Rule]k+1)*v/gcd]];
    g=REtoPol[A,B,CC,k];
    If[g==="keine Polynoml\[ODoubleDot]sung",Return["WZ-Methode scheitert"]];
    SimplifyCombinatorial[g/h*(ratn-1)]]

(* Ende Einfuegung fuer Buch *)

(* From now on all Print messages only will be printed if the global
variable SpecialFunctionsPrintMessages is set to True. By default, this is
not the case. By the command specfunprint or specfuninfo you can set
SpecialFunctionsPrintMessages to True. *)

SpecialFunctionsPrintMessages=False

specfunprint:=(SpecialFunctionsPrintMessages=True;)
specfunprintoff:=(SpecialFunctionsPrintMessages=False;)
nospecfunprint:=(SpecialFunctionsPrintMessages=False;)

asympt = False

transformspecial1={}
transformspecial2={}
(* compatibility mode for simpleDE *)
transformspecial1={
BesselI->besselI,
BesselK->besselK,
BesselJ->besselJ,
BesselY->besselY,
JacobiP->jacobiP,
GegenbauerC->gegenbauerC,
ChebyshevT->chebyshevT,
ChebyshevU->chebyshevU,
Global`ChebyshevS->chebyshevS,
Global`ChebyshevC->chebyshevC,
Global`ChebyshevTstar->chebyshevTstar,
Global`ChebyshevUstar->chebyshevUstar,
LegendreP->legendreP,
LegendreQ->legendreQ,
Global`LegendrePstar->legendrePstar,
LaguerreL->laguerreL,
HermiteH->hermiteH,
HermiteHe->hermiteHe,
Hankel1->hankel1,
Hankel2->hankel2,
Bateman->bateman,
KummerM->kummerM,
KummerU->kummerU, (* equals HypergeometricU *)
WhittakerW->whittakerW,
WhittakerM->whittakerM,
StruveH->struveH,
StruveL->struveL,
System`Hypergeometric0F1->hypergeometric0F1,
Hypergeometric1F0->hypergeometric1F0,
System`HypergeometricU->hypergeometricU,
System`Hypergeometric1F1->hypergeometric1F1,
Hypergeometric2F0->hypergeometric2F0,
System`Hypergeometric2F1->hypergeometric2F1,
(* article *)
Ai->ai,
System`Erfc->erfc,
System`ExpIntegralE->expIntegralE,
Abramowitz->abramowitz,
NormalIntegral->NormalIntegral,
KnuthA->knuthA,
KnuthB->knuthB,
ParabolicU->parabolicU,
ParabolicD->parabolicD,
ParabolicV->parabolicV,
ParabolicW->parabolicW,
ParabolicE->parabolicE
}

transformspecial2={
besselI->BesselI,
besselK->BesselK,
besselJ->BesselJ,
besselY->BesselY,
jacobiP->JacobiP,
gegenbauerC->GegenbauerC,
chebyshevT->ChebyshevT,
chebyshevU->ChebyshevU,
chebyshevS->ChebyshevS,
chebyshevC->ChebyshevC,
chebyshevTstar->ChebyshevTstar,
chebyshevUstar->ChebyshevUstar,
legendreP->LegendreP,
legendreQ->LegendreQ,
legendrePstar->LegendrePstar,
laguerreL->LaguerreL,
hermiteH->HermiteH,
hermiteHe->HermiteHe,
hankel1->Hankel1,
hankel2->Hankel2,
bateman->Bateman,
kummerM->KummerM,
kummerU->KummerU,
whittakerW->WhittakerW,
whittakerM->WhittakerM,
struveH->StruveH,
struveL->StruveL,
hypergeometric0F1->System`Hypergeometric0F1,
hypergeometric1F0->Hypergeometric1F0,
hypergeometricU->System`HypergeometricU,
hypergeometric1F1->System`Hypergeometric1F1,
hypergeometric2F0->Hypergeometric2F0,
hypergeometric2F1->System`Hypergeometric2F1,
(* article *)
ai->Ai,
erfc->System`Erfc,
expIntegralE->System`ExpIntegralE,
abramowitz->Abramowitz,
NormalIntegral->NormalIntegral,
knuthA->KnuthA,
knuthB->KnuthB,
parabolicU->ParabolicU,
parabolicD->ParabolicD,
parabolicV->ParabolicV,
parabolicW->ParabolicW,
parabolicE->ParabolicE
}

(* begin module derivatives  *)

laguerreL[n_,x_]:= laguerreL[n,0,x]

legendreP[n_,x_]:= legendreP[n,0,x]

Unprotect[D]

Literal[Derivative[0,1][bateman]]:=
Function[{n,x},
1/x*((n-x)*bateman[n, x]-(n-1)*bateman[n-1, x])]

D[bateman[n_,x_],x_]:= Derivative[0,1][bateman][n, x]

D[bateman[n_,x_],{x_,k_}]:=D[D[bateman[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 22.8.1  *)

Literal[Derivative[0,0,0,1][jacobiP]]:=
Function[{n,a, b, x},
(2*(a + n)*(b + n)*jacobiP[-1 + n, a, b, x])/((a + b + 2*n)*(1 - x^2)) +
(n*(a - b - (a + b + 2*n)*x)*jacobiP[n, a, b, x])/((a + b + 2*n)*(1
-x^2))]
D[jacobiP[n_, a_, b_, x_],x_]:=
Derivative[0,0,0,1][jacobiP][n, a, b, x]

D[jacobiP[n_, a_, b_, x_],{x_,k_}]:= D[D[jacobiP[n, a, b,
x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)



(* AS 22.8.2  *)

Literal[Derivative[0,0,1][gegenbauerC]]:=
Function[{n,a,x},
((-1 + 2*a + n)*gegenbauerC[-1 + n, a, x])/(1 - x^2) -
   (n*x*gegenbauerC[n, a, x])/(1 - x^2)]

D[gegenbauerC[n_,a_,x_],x_]:=
Derivative[0,0,1][gegenbauerC][n, a, x]

D[gegenbauerC[n_,a_,x_],{x_,k_}]:= D[D[gegenbauerC[n, a,
x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 22.8.3 *)

Literal[Derivative[0,1][chebyshevT]]:=
Function[{n,x},
(n*chebyshevT[-1 + n, x])/(1 - x^2) - (n*x*chebyshevT[n, x])/(1 - x^2)]

D[chebyshevT[n_, x_],x_]:=
Derivative[0,1][chebyshevT][n, x]

D[chebyshevT[n_, x_],{x_,k_}]:= D[D[chebyshevT[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* Eigenbau aus AS 22.5.5   *)

Literal[Derivative[0,1][chebyshevC]]:=
Function[{n,x},
(n*chebyshevC[-1 + n, x])/(2*(1 - x^2/4)) - 
   (n*x*chebyshevC[n, x])/(4*(1 - x^2/4))
]

D[chebyshevC[n_, x_],x_]:=
Derivative[0,1][chebyshevC][n, x]

D[chebyshevC[n_, x_],{x_,k_}]:= D[D[chebyshevC[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* Eigenbau aus AS 22.5.9 und 22.5.13 *)

Literal[Derivative[0,1][chebyshevS]]:=
Function[{n,x},
 (2*(1 + n)*chebyshevS[-1 + n, x])/(4 - x^2) + 
   (n*x*chebyshevS[n, x])/(-4 + x^2)
]


D[chebyshevS[n_, x_],x_]:=
Derivative[0,1][chebyshevS][n, x]

D[chebyshevS[n_, x_],{x_,k_}]:= D[D[chebyshevS[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)



(*  Eigenbau aus AS 22.5.14 *)

Literal[Derivative[0,1][chebyshevTstar]]:=
Function[{n,x},
 -((n*chebyshevTstar[-1 + n, x])/(-2*x + 2*x^2)) + 
 (n*(-1 + 2*x))/(-2*x + 2*x^2) *chebyshevTstar[n, x]
]

D[chebyshevTstar[n_, x_],x_]:=
Derivative[0,1][chebyshevTstar][n, x]

D[chebyshevTstar[n_, x_],{x_,k_}]:= D[D[chebyshevTstar[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)



(* Eigenbau aus AS 22.5.15 *)

Literal[Derivative[0,1][chebyshevUstar]]:=
Function[{n,x},
 2*(((1 + n)*chebyshevUstar[-1 + n, x])/(1 - (-1 + 2*x)^2) - 
(n*(-1 + 2*x)*chebyshevUstar[n, x])/(1 - (-1 + 2*x)^2))
 ]

D[chebyshevUstar[n_, x_],x_]:=
Derivative[0,1][chebyshevUstar][n, x]

D[chebyshevUstar[n_, x_],{x_,k_}]:= D[D[chebyshevUstar[n,
x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)



(* 22.8.4  *)

Literal[Derivative[0,1][chebyshevU]]:=
Function[{n,x},
((1 + n)*chebyshevU[-1 + n, x])/(1 - x^2) - (n*x*chebyshevU[n, x])/(1 -
x^2)]

D[chebyshevU[n_, x_],x_]:=
Derivative[0,1][chebyshevU][n, x]

D[chebyshevU[n_, x_],{x_,k_}]:= D[D[chebyshevU[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)



(* 22.8.5 *)

(* WK auf drei Parameter geaendert AS (8.5.4), ist eigentlich
unnoetig, da in Mathematica korrekt *)

(*
Literal[Derivative[0,1][legendreP]]:=
Function[{n,x},
(n*legendreP[-1 + n, x])/(1 - x^2) - (n*x*legendreP[n, x])/(1 - x^2)]

D[legendreP[n_, x_],x_]:=
Derivative[0,1][legendreP][n, x]

D[legendreP[n_, x_],{x_,k_}]:= D[D[legendreP[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)
*)

Literal[Derivative[0,0,1][legendreP]]:=
Function[{n,m,x},
(n+m)*legendreP[-1+n,m,x]/(1 - x^2) - (n*x*legendreP[n,m,x])/(1 - x^2)]

D[legendreP[n_,m_,x_],x_]:=
Derivative[0,0,1][legendreP][n,m,x]

D[legendreP[n_,m_,x_],{x_,k_}]:= D[D[legendreP[n,m,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


Literal[Derivative[0,0,1][legendreQ]]:=
Function[{n,m,x},
(n+m)*legendreQ[-1+n,m,x]/(1 - x^2) - (n*x*legendreQ[n,m,x])/(1 - x^2)]

D[legendreQ[n_,m_,x_],x_]:=
Derivative[0,0,1][legendreQ][n,m,x]

D[legendreQ[n_,m_,x_],{x_,k_}]:= D[D[legendreQ[n,m,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* Vermutung, da es bei den anderen shifted- Funktionen auch so ging.
Ich habe angenommen, dass legendrePstar[n,x] == legendreP[n,(1+x)/2]
ist *)

Literal[Derivative[0,1][legendrePstar]]:=
Function[{n,x},
2*((n*legendrePstar[-1 + n, x])/(1 - (-1 + 2*x)^2)- 
(n*(-1 + 2*x)*legendrePstar[n, x])/(1 - (-1 + 2*x)^2))]

D[legendrePstar[n_, x_],x_]:=
Derivative[0,1][legendrePstar][n, x]

D[legendrePstar[n_, x_],{x_,k_}]:= D[D[legendrePstar[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(*  22.8.6  *)

Literal[Derivative[0,0,1][laguerreL]]:=
Function[{n,a,x},
((-a - n)*laguerreL[-1 + n, a, x])/x + n*laguerreL[n, a, x]/x]
(* klappt noch nicht 
-laguerreL[-1 + n, 1 + a, x]]
*)

D[laguerreL[n_, x_],x_]:=
Derivative[0,0,1][laguerreL][n,0,x]

D[laguerreL[n_,a_,x_],x_]:= Derivative[0,0,1][laguerreL][n,a,x]

D[laguerreL[n_,a_,x_],{x_,k_}]:= D[D[laguerreL[n,a, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)



(* 22.8.7 *)

Literal[Derivative[0,1][hermiteH]]:=
Function[{n,x},
2 n hermiteH[-1 + n, x]]

D[hermiteH[n_, x_],x_]:=
Derivative[0,1][hermiteH][n, x]

D[hermiteH[n_, x_],{x_,k_}]:= D[D[hermiteH[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* 22.8.8 *)

Literal[Derivative[0,1][hermiteHe]]:=
Function[{n,x},
 n hermiteHe[-1 + n, x]
 ]

D[hermiteHe[n_, x_],x_]:=
Derivative[0,1][hermiteHe][n, x]

D[hermiteHe[n_, x_],{x_,k_}]:= D[D[HermiteHe[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 9.26. Seite 120 *)

Literal[Derivative[0,1][besselI]]:=
Function[{n,x},
besselI[n-1,x]-n/x*besselI[n,x]]

D[besselI[n_,x_],x_]:=Derivative[0,1][besselI][n, x]

D[besselI[n_, x_],{x_,k_}]:= D[D[besselI[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 9.26. Seite 120 *)

Literal[Derivative[0,1][besselK]]:=
Function[{n,x},
-besselK[n-1,x]-n/x*besselK[n,x]]

D[besselK[n_,x_],x_]:=Derivative[0,1][besselK][n, x]

D[besselK[n_, x_],{x_,k_}]:= D[D[besselK[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


(* AS 9.1.27 Seite 105 *)

Literal[Derivative[0,1][besselY]]:=
Function[{n,x},
besselY[-1 + n, x] - (n*besselY[n, x])/x]

D[besselY[n_,x_],x_]:=Derivative[0,1][besselY][n, x]

D[besselY[n_, x_],{x_,k_}]:= D[D[besselY[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* AS 9.1.27 Seite 105 *)

Literal[Derivative[0,1][besselJ]]:=
Function[{n,x},
besselJ[-1 + n, x] - (n*besselJ[n, x])/x]

D[besselJ[n_,x_],x_]:=Derivative[0,1][besselJ][n, x]

D[besselJ[n_, x_],{x_,k_}]:= D[D[besselJ[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,1][hankel1]]:=
Function[{n,x},
(hankel1[n-1,x] - (n/x) * hankel1[n,x])
]

D[hankel1[n_,x_],x_]:= Derivative[0,1][hankel1][n, x]

D[hankel1[n_,x_],{x_,k_}]:=D[D[hankel1[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,1][hankel2]]:=
Function[{n,x},
(hankel2[n-1,x] - (n/x) * hankel2[n,x])
]

D[hankel2[n_,x_],x_]:= Derivative[0,1][hankel2][n, x]

D[hankel2[n_,x_],{x_,k_}]:=D[D[hankel2[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][kummerM]]:=
Function[{a,b,x},
1/x*((b-a)*kummerM[a-1,b,x]-(b-a-x)*kummerM[a,b,x])]

D[kummerM[n_,m_,x_],x_]:= Derivative[0,0,1][kummerM][n, m, x]

D[kummerM[n_,m_,x_],{x_,k_}]:=D[D[kummerM[n, m, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][kummerU]]:=
Function[{a,b,x},
(- kummerU[a-1,b,x] + (a-b+x)*kummerU[a,b,x])/x]

D[kummerU[n_,m_,x_],x_]:= Derivative[0,0,1][kummerU][n, m, x]

D[kummerU[n_,m_,x_],{x_,k_}]:=D[D[kummerU[n, m, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][whittakerM]]:=
Function[{n,m,x},
1/(2*x)*((1+2*m-2*n)*whittakerM[n-1,m,x] + (2*n-x)*whittakerM[n,m,x])]

D[whittakerM[n_,m_,x_],x_]:= Derivative[0,0,1][whittakerM][n, m, x]

D[whittakerM[n_,m_,x_],{x_,k_}]:=D[D[whittakerM[n, m, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][whittakerW]]:=
Function[{n,m,x},
1/(4*x)*((1-4*m^2-4*n+4*n^2)*whittakerW[n-1,m,x] + (4*n-2*x)*whittakerW[n,m,x])]

D[whittakerW[n_,m_,x_],x_]:= Derivative[0,0,1][whittakerW][n, m, x]

D[whittakerW[n_,m_,x_],{x_,k_}]:=D[D[whittakerW[n, m, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* hypergeometric functions *)
Literal[Derivative[0,1][hypergeometric0F1]]:=
Function[{a,x},
hypergeometric0F1[1 + a, x]/a]

D[hypergeometric0F1[a_,x_],x_]:=
Derivative[0,1][hypergeometric0F1][a,x]

D[hypergeometric0F1[a_,x_],{x_,k_}]:=
D[D[hypergeometric0F1[a,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][hypergeometricU]]:=
Function[{a,b,x},
1/x*((b-a)*hypergeometricU[a-1,b,x]-(b-a-x)*hypergeometricU[a,b,x])]

D[hypergeometricU[a_,b_,x_],x_]:=
Derivative[0,0,1][hypergeometricU][a,b,x]

D[hypergeometricU[a_,b_,x_],{x_,k_}]:=
D[D[hypergeometricU[a,b,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][hypergeometric1F1]]:=
Function[{a,b,x},
1/x*((b-a)*hypergeometric1F1[a-1,b,x]-(b-a-x)*hypergeometric1F1[a,b,x])]

D[hypergeometric1F1[a_,b_,x_],x_]:=
Derivative[0,0,1][hypergeometric1F1][a,b,x]

D[hypergeometric1F1[a_,b_,x_],{x_,k_}]:=
D[D[hypergeometric1F1[a,b,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,1][hypergeometric1F0]]:=
Function[{a,x},
a/(1-x)*hypergeometric1F0[a,x]
]

D[hypergeometric1F0[a_,x_],x_]:=
Derivative[0,1][hypergeometric1F0][a,x]

D[hypergeometric1F0[a_,x_],{x_,k_}]:=
D[D[hypergeometric1F0[a,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,0,1][hypergeometric2F0]]:=
Function[{a,b,x},
a/x*(hypergeometric2F0[a+1,b,x]-hypergeometric2F0[a,b,x])]

D[hypergeometric2F1[a_,b_,x_],x_]:=
Derivative[0,0,1][hypergeometric2F0][a,b,x]

D[hypergeometric2F0[a_,b_,x_],{x_,k_}]:=
D[D[hypergeometric2F0[a,b,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

(* AS (15.2.3) *)
Literal[Derivative[0,0,0,1][hypergeometric2F1]]:=
Function[{a,b,c,x},
a/x*(hypergeometric2F1[a+1,b,c,x]-hypergeometric2F1[a,b,c,x])]

D[hypergeometric2F1[a_,b_,c_,x_],x_]:=
Derivative[0,0,0,1][hypergeometric2F1][a,b,c,x]

D[hypergeometric2F1[a_,b_,c_,x_],{x_,k_}]:=
D[D[hypergeometric2F1[a,b,c,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,1][struveH]]:=
Function[{n,x},
(x*struveH[-1 + n,x] - n*struveH[n,x])/x
]

D[struveH[n_,x_],x_]:=Derivative[0,1][struveH][n, x]

D[struveH[n_, x_],{x_,k_}]:= D[D[struveH[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

Literal[Derivative[0,1][struveL]]:=
Function[{n,x},
(x*struveL[-1 + n,x] - n*struveL[n,x])/x
]

D[struveL[n_,x_],x_]:=Derivative[0,1][struveL][n, x]

D[struveL[n_, x_],{x_,k_}]:= D[D[struveL[n, x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* special examples article *)

(* lower order preferred 
Literal[Derivative[0,1][ai]]:=
Function[{n,x}, x*ai[n-1,x]+(n-1)*ai[n-2,x]]
D[ai[n_,x_],x_]:= Derivative[0,1][ai][n,x]
D[ai[n_,x_],{x_,k_}]:=D[D[ai[n,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)
*)

Literal[Derivative[0,1][ai]]:=
Function[{n,x}, ai[n+1,x]]
D[ai[n_,x_],x_]:= Derivative[0,1][ai][n,x]
D[ai[n_,x_],{x_,k_}]:=D[D[ai[n,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,1][erfc]]:=
Function[{n,x}, -erfc[n-1,x]]
D[erfc[n_,x_],x_]:= Derivative[0,1][erfc][n,x]
D[erfc[n_,x_],{x_,k_}]:=D[D[erfc[n,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[1][erfc]]:=
Function[{x}, -2/(E^x^2*Pi^(1/2))]
D[erfc[x_],x_]:= Derivative[1][erfc][x]
D[erfc[x_],{x_,k_}]:=D[D[erfc[x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

Literal[Derivative[0,1][expIntegralE]]:=
Function[{n,x}, -expIntegralE[n-1,x]]
D[expIntegralE[n_,x_],x_]:= Derivative[0,1][expIntegralE][n,x]
D[expIntegralE[n_,x_],{x_,k_}]:=D[D[expIntegralE[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* AS (27.5) *)
Literal[Derivative[0,1][abramowitz]]:=
Function[{n,x}, -abramowitz[n-1,x]]
D[abramowitz[n_,x_],x_]:= Derivative[0,1][abramowitz][n,x]
D[abramowitz[n_,x_],{x_,k_}]:=D[D[abramowitz[n,x],{x,k-1}],x]/; (IntegerQ[k] && k>1)

(* AS (26.2.41) *)

Literal[Derivative[0,1][NormalIntegral]]:=
Function[{n,x},-NormalIntegral[n-1,x]]
D[NormalIntegral[n_,x_],x_]:= Derivative[0,1][NormalIntegral][n,x]
D[NormalIntegral[n_,x_],{x_,k_}]:=D[D[NormalIntegral[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* Knuth (10.23) *)
Literal[Derivative[0,1][knuthA]]:=
Function[{n,x},knuthA[n-2,x]/2-x^2*knuthA[n,x]/2]
D[knuthA[n_,x_],x_]:= Derivative[0,1][knuthA][n,x]
D[knuthA[n_,x_],{x_,k_}]:=D[D[knuthA[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* Knuth (10.6) *)
Literal[Derivative[0,1][knuthB]]:=
Function[{n,x},knuthB[n-2,x]/2]
D[knuthB[n_,x_],x_]:= Derivative[0,1][knuthB][n,x]
D[knuthB[n_,x_],{x_,k_}]:=D[D[knuthB[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* AS (19.6.2) *)
Literal[Derivative[0,1][parabolicU]]:=
Function[{n,x},-parabolicU[n-1,x]+x/2*parabolicU[n,x]]
D[parabolicU[n_,x_],x_]:= Derivative[0,1][parabolicU][n,x]
D[parabolicU[n_,x_],{x_,k_}]:=D[D[parabolicU[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* AS (19.6.5) *)
Literal[Derivative[0,1][parabolicV]]:=
Function[{n,x},(n-1/2)*parabolicV[n-1,x]+x/2*parabolicV[n,x]]
D[parabolicV[n_,x_],x_]:= Derivative[0,1][parabolicV][n,x]
D[parabolicV[n_,x_],{x_,k_}]:=D[D[parabolicV[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)

(* using AS (19.3.1) *)
Literal[Derivative[0,1][parabolicD]]:=
Function[{n,x},-parabolicD[n+1,x]+x/2*parabolicD[n,x]]
D[parabolicD[n_,x_],x_]:= Derivative[0,1][parabolicD][n,x]
D[parabolicD[n_,x_],{x_,k_}]:=D[D[parabolicD[n,x],{x,k-1}],x]/;
(IntegerQ[k] && k>1)


Protect[D]
(* end module derivatives *)

(* begin module recursions *)

reclist = {
besselI[nnnnn,x] == 
besselI[nnnnn-2, x]-((2 (nnnnn-1))/x)*besselI[nnnnn-1, x],
besselK[nnnnn, x] == 
besselK[-2 + nnnnn, x] + (2*(-1 + nnnnn)*besselK[-1 + nnnnn, x])/x,
(* AS 9.6.26 Seite 120 *)
besselJ[nnnnn,x] == 
-besselJ[-2 + nnnnn,x] + (2*(-1 + nnnnn)*besselJ[-1 + nnnnn, x])/x,
besselY[nnnnn,x] == 
-besselY[-2 + nnnnn,x] + (2*(-1 + nnnnn)*besselY[-1 + nnnnn,x])/x,
(* AS 9.1.27. Seite 105 *)
expIntegralE[nnnnn, x] == 
(x*expIntegralE[-2 + nnnnn,x])/(-1 + nnnnn) +
((-2 + nnnnn - x)*expIntegralE[-1 + nnnnn,x])/(-1 + nnnnn),
(* AS 5.1.14 *)
(*7*)
jacobiP[nnnnn, a, b, x] == 
((-a + a^2 - b + 2*a*b - a^2*b + b^2 - a*b^2 - 2*nnnnn + 4*a*nnnnn -
a^2*nnnnn + 4*b*nnnnn - 4*a*b*nnnnn - b^2*nnnnn + 4*nnnnn^2 -
3*a*nnnnn^2 - 3*b*nnnnn^2 - 2*nnnnn^3)*jacobiP[-2 + nnnnn,a,b,x])/
(nnnnn*(a + b + nnnnn)*(-2 + a + b + 2*nnnnn)) +
((-a^2 + a^3 + a^2*b + b^2 - a*b^2 - b^3 + 2*a^2*nnnnn - 2*b^2*nnnnn +
2*a*x - 3*a^2*x + a^3*x + 2*b*x - 6*a*b*x + 3*a^2*b*x - 3*b^2*x +
3*a*b^2*x + b^3*x + 4*nnnnn*x - 12*a*nnnnn*x + 6*a^2*nnnnn*x -
12*b*nnnnn*x + 12*a*b*nnnnn*x + 6*b^2*nnnnn*x - 12*nnnnn^2*x +
12*a*nnnnn^2*x + 12*b*nnnnn^2*x + 8*nnnnn^3*x)*
jacobiP[-1 + nnnnn,a,b,x])/(2*nnnnn*(a + b + nnnnn)*(-2 + a + b + 2*nnnnn)),
(*9*)
gegenbauerC[nnnnn, b, x] == 
-(((-2 + 2*b + nnnnn)*gegenbauerC[-2 + nnnnn, b, x])/nnnnn)+
  (2*(-1 + b + nnnnn)*x*gegenbauerC[-1 + nnnnn, b, x])/nnnnn,
(*10*)
chebyshevT[nnnnn, x] == 
-chebyshevT[-2 + nnnnn, x] + 2 x chebyshevT[-1 + nnnnn, x],
(*11*)
chebyshevU[nnnnn, x] == 
-chebyshevU[-2 + nnnnn, x] + 2 x chebyshevU[-1 + nnnnn, x],
(*12*)
chebyshevS[nnnnn, x] == 
-chebyshevS[-2 + nnnnn, x] + x chebyshevS[nnnnn-1, x],
(*13*)
chebyshevC[nnnnn, x] == 
-chebyshevC[-2 + nnnnn, x] + x chebyshevC[-1 + nnnnn, x],
(*14*)
chebyshevTstar[nnnnn, x] ==
-chebyshevTstar[-2 + nnnnn, x] + (-2 + 4 x) chebyshevTstar[-1 + nnnnn, x],
(*15*)
chebyshevUstar[nnnnn, x] ==
-chebyshevUstar[-2 + nnnnn, x] + (-2 + 4 x) chebyshevUstar[-1 + nnnnn, x],
(*16*)
(*
legendreP[nnnnn, x] == 
-(((-1 + nnnnn)*legendreP[-2 + nnnnn, x])/nnnnn) +
    ((1 + 2*(-1 + nnnnn))*x*legendreP[-1 + nnnnn, x])/nnnnn,
*)
(*17*)
legendreP[nnnnn, b, x] == 
(1 - b - nnnnn)/(-b + nnnnn)*legendreP[-2 + nnnnn, b, x] +
(-1 + 2*nnnnn)*x/(-b + nnnnn)*legendreP[-1 + nnnnn, b, x],
legendreQ[nnnnn, b, x] == 
((1 - b - nnnnn)*legendreQ[-2 + nnnnn, b, x] +
(-1 + 2*nnnnn)*x*legendreQ[-1 + nnnnn, b, x])/(-b + nnnnn),
legendrePstar[nnnnn, x] == 
-(((-1 + nnnnn)*legendrePstar[-2 + nnnnn, x])/nnnnn) +
((-1 - 2*(-1 + nnnnn) + (2 + 4*(-1 + nnnnn))*x)*
legendrePstar[-1 + nnnnn, x])/nnnnn,
(*18*)
laguerreL[nnnnn, a, x] == 
-(((-1 + a + nnnnn)*laguerreL[-2 + nnnnn, a, x])/nnnnn) +
((1 + a + 2*(-1 + nnnnn) - x)*laguerreL[-1 + nnnnn, a, x])/nnnnn,
(* klappt noch nicht
laguerreL[b, 1 + nnnnn, x] ==
-(((b + nnnnn)*laguerreL[b, -1 + nnnnn, x])/x) +
((nnnnn + x)*laguerreL[b, nnnnn, x])/x,
*)
(*19*)
hermiteH[nnnnn, x] == 
-2 (-1 + nnnnn) hermiteH[-2 + nnnnn, x] + 2 x hermiteH[-1 + nnnnn, x],
(*20*)
hermiteHe[nnnnn, x] == 
-((-1 + nnnnn) hermiteHe[-2 + nnnnn, x]) + x hermiteHe[-1 + nnnnn, x],
(*  AS 22.7.1- 14, genau in der Reihenfolge  *)
(*21*)
hankel1[nnnnn,x]== 
- hankel1[nnnnn-2,x] + (2*(nnnnn-1)/x)*hankel1[nnnnn-1,x],
hankel2[nnnnn,x]== 
- hankel2[nnnnn-2,x] + (2*(nnnnn-1)/x)*hankel2[nnnnn-1,x],
kummerM[nnnnn,b,x]==
1/(nnnnn-1)*((b-nnnnn+1)*kummerM[nnnnn-2,b,x] + 
(2*nnnnn-2-b+x)*kummerM[nnnnn-1,b,x]),
kummerU[nnnnn,b,x]==
-1/((nnnnn-1)*(nnnnn-b))* (kummerU[nnnnn-2,b,x] + 
(b-2*nnnnn+2-x)*kummerU[nnnnn-1,b,x]),
whittakerM[nnnnn, b, x] ==
(3+2*b-2*nnnnn)/(2*b+2*nnnnn-1)*whittakerM[nnnnn-2,b,x]+
(4*nnnnn-4-2*x)/(2*b+2*nnnnn-1)*whittakerM[nnnnn-1,b,x],
whittakerW[nnnnn, b, x] == 
(3/2 + b - nnnnn)*(-3/2 + b + nnnnn)*
whittakerW[-2 + nnnnn,b,x]-(2*(-1+nnnnn)-x)*whittakerW[-1+nnnnn,b,x],
bateman[nnnnn,x] == 
(2 - nnnnn)/nnnnn*bateman[nnnnn-2,x] +  
((2*(-1 + nnnnn) - 2*x)/nnnnn) * bateman[nnnnn-1,x],
(* hypergeometric functions *)
hypergeometric0F1[nnnnn, x] ==
(-2 + nnnnn)*(-1 + nnnnn)/x*hypergeometric0F1[-2 + nnnnn, x]-
(-2 + nnnnn)*(-1 + nnnnn)/x*hypergeometric0F1[-1 + nnnnn, x],
(* AS (15.2.10) *)
(* verified *)
hypergeometricU[nnnnn,b,x]==
1/(nnnnn-1)*((b-nnnnn+1)*hypergeometricU[nnnnn-2,b,x] +
(2*nnnnn-2-b+x)*hypergeometricU[nnnnn-1,b,x]),
hypergeometric1F1[nnnnn,b,x]==
(b-nnnnn+1)/(nnnnn-1)*hypergeometric1F1[nnnnn-2,b,x] +
(2*nnnnn-2-b+x)/(nnnnn-1)*hypergeometric1F1[nnnnn-1,b,x],
(* verified *)
hypergeometric2F0[nnnnn,b,x]==
-1/(-x + nnnnn*x)*hypergeometric2F0[nnnnn-2,b,x]+1/(-x + nnnnn*x)*
(1-x+nnnnn*x-b x)*hypergeometric2F0[nnnnn-1,b,x],
hypergeometric2F1[nnnnn,b,c,x] == -1/((nnnnn-1)*(x-1))*
((2*(nnnnn-1)-c-(nnnnn-1)*x+b*x)*hypergeometric2F1[nnnnn-1,b,c,x]+
(c-nnnnn+1)*hypergeometric2F1[nnnnn-2,b,c,x]),
(* AS (12.1.9)-(12.1.10) *)
struveH[nnnnn,x]==
(x^2*struveH[-3 + nnnnn,x] + 5*x*struveH[-2 + nnnnn,x] -
        4*nnnnn*x*struveH[-2 + nnnnn,x] + 2*struveH[-1 + nnnnn,x] -
        6*nnnnn*struveH[-1 + nnnnn,x] + 4*nnnnn^2*struveH[-1 + nnnnn,x] +
        x^2*struveH[-1 + nnnnn,x])/(-x + 2*nnnnn*x),
(* AS (12.2.4)-(12.2.5) *)
  struveL[nnnnn, x] == (-(x*struveL[-3 + nnnnn, x]) +
(-1 + 4*(-1 + nnnnn))*struveL[-2 + nnnnn, x] +
((-2*(-1 + nnnnn) - 4*(-1 + nnnnn)^2 + x^2)*struveL[-1 + nnnnn, x])/x)/
(1 + 2*(-1 + nnnnn)),
(*22*)
(* special examples article *)
ai[nnnnn,x]==x*ai[nnnnn-2,x]+(nnnnn-2)*ai[nnnnn-3,x],
(*23*)
(* AS (7.2) *)
erfc[nnnnn,x]==1/(2*nnnnn)*erfc[nnnnn-2,x]-x/nnnnn*erfc[nnnnn-1,x],
(* AS (27.5) *)
abramowitz[nnnnn,x]==(nnnnn-1)/2*abramowitz[nnnnn-2,x]+x/2*abramowitz[nnnnn-3,x],
(* AS (26.2.44) *)
NormalIntegral[nnnnn,x]==
1/nnnnn*(NormalIntegral[nnnnn-2,x]-x*NormalIntegral[nnnnn-1,x]),
(* Knuth (10.22) *)
knuthA[nnnnn,x]==
x*knuthA[nnnnn-2,x]/(nnnnn-2)+knuthA[nnnnn-3,x]/(nnnnn-2),
(* Knuth (10.25) *)
knuthB[nnnnn,x]==
x*knuthB[nnnnn-2,x]/(nnnnn-2)+knuthB[nnnnn-3,x]/(nnnnn-2),
(* AS (19.6.4) *)
parabolicU[nnnnn, x]==
-2*parabolicU[-2+nnnnn,x]/(1-2*nnnnn) + 2*x*parabolicU[-1+nnnnn,x]/(1-2*nnnnn),
(* AS (19.6.8) *)
parabolicV[nnnnn, x]==
(-3 + 2*nnnnn)/2*parabolicV[-2 + nnnnn, x] + x*parabolicV[-1 + nnnnn, x],
(* using AS (19.3.1) *)
parabolicD[nnnnn, x]== 
parabolicD[-2 + nnnnn, x] - nnnnn*parabolicD[-2 + nnnnn, x] + 
x*parabolicD[-1 + nnnnn, x]
}

(* end module recursions *)

(* Simplification Rules for Factorial, Binomial, Product *)
(* combinas.m /DOS *)
(* Copyright 1988 Wolfram Research Inc. *)

(* by Roman Maeder *)
(* plus some own parts *)

protection = Unprotect[Factorial, Binomial, Product,Gamma]

Factorial/:
  (n_)!/(m_)! := Product[i, {i, m+1, n}]        /;
        Simplify[n-m] > 0 && IntegerQ[Simplify[n-m]]
Factorial/:
  (n_)!/(m_)! := 1/Product[i, {i, n+1, m}]      /;
        Simplify[m-n] > 0 && IntegerQ[Simplify[m-n]]

Binomial/:
  Binomial[n_, k_]/Binomial[n_, k1_] := (n-k+1)/k /; k1 == k-1
Binomial/:
  Binomial[n_, k1_]/Binomial[n_, k_] := k/(n-k+1) /; k1 == k-1

Product/:
  Product[t_, {x_, a_, n_, 1}]/Product[t_, {x_, a_, n1_, 1}] :=
    (t /. x-> n)                                        /; n1 == n-1
Product/:
  Product[t_, {x_, a_, n1_, 1}]/Product[t_, {x_, a_, n_, 1}] :=
    1/(t /. x-> n)                                      /; n1 == n-1

Product[i_,{i_,i1_,i2_}]:=i1*Product[i,{i,i1+1,i2}] /;
        Simplify[i2-i1]>0 && IntegerQ[Simplify[i2-i1]]

Product[i_,{i_,i1_,i2_}]:=i1 /; Simplify[i2-i1]==0

(* currently
Gamma/:
Gamma[a_]*Gamma[b_]:=Module[{x=1-b,k=a+b},
Pi/Sin[Pi*(1-x)]*Pochhammer[x,k-1]]/;(*(Simplify[a+b]>0) && *)
IntegerQ[Simplify[a+b]]
*)

Protect[Release[protection]]

(* end of combinas.m *)

(* begin Algebraic package *)
AlgebraicDE[F_,y_[x_]]:=AlgebraicDE[F,x,y]

AlgebraicDE[F_,x_,y_]:=Module[ 
        (* Clear as much as possible *)
	{n,k,j,z},
	Clear[list,values];
	plugin[expr_,form_,order_]:=Module[{level},
                level=Length[CoefficientList[expr,y[x]]]-1;
                If[level>=order,plugin[Expand[expr /.
                y[x]^level->y[x]^(level-order)*form[[1,1,2]]],form,order],
                expr]
        ];
	If[FreeQ[F,y[x]],eq=(F /. y->y[x]),eq=F];
	If[SameQ[Head[F],Equal],eq=Expand[eq[[1]]-eq[[2]]]==0,eq=Expand[eq]==0];
	order=Length[CoefficientList[eq[[1]],y[x]]]-1;
	y0=(Solve[eq /. y[x]^order->z,z] /. z->y[x]^order);
	eqlist={};
	ylist={};
	(* normalization done *)
	(* first order *)
	AppendTo[eqlist,D[eq,x]];
	AppendTo[ylist,Solve[eqlist[[1]],y'[x]][[1,1]]];
	term=Cancel[Together[ExpandAll[ylist[[1,2]]/y[x]] /. 
		{y0[[1,1]],y[x]^(-order)->1/y0[[1,1,2]]}]];
	If[FreeQ[term,y[x]],
	Return[Denominator[term] y'[x]-Numerator[term] y[x]==0]];
	Print["No differential equation of order ",1," found"];
	(* higher order *)
	(* for n=2 to order *)
	Do[
	AppendTo[eqlist,D[eqlist[[n-1]],x]];
	AppendTo[ylist,Solve[eqlist[[n]],Derivative[n][y][x]][[1,1]]];
	setting=Sum[A[k] Derivative[k][y][x] /. A[n]->1,{k,0,n}];
	intermediate=setting;
	Do[intermediate=Numerator[Together[intermediate /. ylist[[k]]]],
		{k,n,1,-1}];
	solution=plugin[intermediate,y0,order];
        Clear[intermediate];
        list=CoefficientList[solution,y[x]];
        Clear[solution];
	values=Solve[list==Table[0,{k,1,Length[list]}],Table[A[k],{k,0,n-1}]];
	If[n==order && values=={},Print["AlgebraicDE: Solve command fails"]];
	If[Not[values=={}],
		Return[Map[Factor,Collect[Numerator[Together[setting /. values[[1]]]],Derivative[_][y][x]]]==0]];
        Print["No differential equation of order ",n," found"]
		,
	{n,2,order}]
] 

AlgebraicDEDirect[F_,x_,y_[x_]]:=AlgebraicDEDirect[F,x,y]

AlgebraicDEDirect[F_,x_,y_]:=Module[ (* highest order only *)
	(* Clear as much as possible *)
	{n,k,l,z},
        Clear[list,values];
        plugin[expr_,form_,order_]:=Module[{level},
                level=Length[CoefficientList[expr,y[x]]]-1;
                If[level>=order,plugin[Expand[expr /.
                y[x]^level->y[x]^(level-order)*form[[1,1,2]]],form,order],
                expr]
        ];
	If[FreeQ[F,y[x]],eq=(F /. y->y[x]),eq=F];
	If[SameQ[Head[F],Equal],eq=Expand[eq[[1]]-eq[[2]]]==0,eq=Expand[eq]==0];
	order=Length[CoefficientList[eq[[1]],y[x]]]-1;
	y0=(Solve[eq /. y[x]^order->z,z] /. z->y[x]^order);
	eqlist={};
	ylist={};
	(* normalization done *)
	AppendTo[eqlist,D[eq,x]];
	AppendTo[ylist,Solve[eqlist[[1]],y'[x]][[1,1]]];
	Do[
	AppendTo[eqlist,D[eqlist[[n-1]],x]];
	AppendTo[ylist,Solve[eqlist[[n]],Derivative[n][y][x]][[1,1]]],
	{n,2,order}];
	setting=Sum[A[k] Derivative[k][y][x] /. A[order]->1,{k,0,order}];
	intermediate=setting;
	Do[intermediate=Numerator[Together[intermediate /. ylist[[k]]]],
		{k,order,1,-1}];
	solution=plugin[intermediate,y0,order];
	Clear[intermediate];
	list=CoefficientList[solution,y[x]];
	Clear[solution];
	values=
	Solve[list==Table[0,{k,1,Length[list]}],Table[A[k],{k,order-1,0,-1}]];
	If[Not[values=={}],
                Return[DEout[Numerator[Together[setting /. values[[1]]]],y,x]]];
	Print["No differential equation of order ",order," found"]
] 
(* end Algebraic package *)


Clear[ComplexFactor,ComplexApart]

(* complex factorization and partial fraction decomposition *)
ComplexFactor[f_,x_]:=Module[
        {knum,kden,ff,p,q,solvenum,solveden,tablenum,tableden,
        settingnum,settingden,coeffnum,coeffden},
        Off[Part::selectform];
        ff=Together[f];
        p=Numerator[ff];
        q=Denominator[ff];
        solvenum=Sort[Simplify[Solve[p==0,x]]];
        tablenum=Table[x-solvenum[[k,1,2]],{k,1,Length[solvenum]}];
        settingnum=Product[tablenum[[k]],{k,1,Length[solvenum]}];
        solveden=Sort[Simplify[Solve[q==0,x]]];
        tableden=Table[x-solveden[[k,1,2]],{k,1,Length[solveden]}];
        settingden=Product[tableden[[k]],{k,1,Length[solveden]}];
        coeffnum=Simplify[p/settingnum];
        coeffden=Simplify[q/settingden];
        (coeffnum*settingnum)/(coeffden*settingden)
]

(* complex partial fraction decomposition *)
ComplexApart[f_,x_]:=Module[
        {ff,p,q,r,pp,solve,setting,k,exponent,list,sol,complex},
        ff=Together[f];
        p=Numerator[ff];
        q=Denominator[ff];
        r=PolynomialQuotient[p,q,x];
        pp=p-q*r;
        solve=Sort[Simplify[Solve[q==0,x]]];
        setting=coeff[1]/(x-solve[[1,1,2]]);
        complex=False;
        If[Length[solve]>1,
        Do[If[solve[[k,1,2]]==solve[[k-1,1,2]],
                (exponent=1;
                While[exponent<k && solve[[k,1,2]]==solve[[k-exponent,1,2]],
                      exponent++
                ];
                setting=setting+coeff[k]/(x-solve[[k,1,2]])^exponent),
                setting=setting+coeff[k]/(x-solve[[k,1,2]]),
                setting=setting+coeff[k]/(x-solve[[k,1,2]])
          ],{k,2,Length[solve]}]];
        list=CoefficientList[Numerator[Together[q*setting-pp]],x];
        sol=Simplify[Solve[list==0,Table[coeff[k],{k,1,Length[solve]}]]];
        r+setting/.sol[[1]]
] /; (Exponent[Expand[Denominator[f]],x]>=2)

ComplexApart[f_,x_]:=Module[
        {complexapart,g},
        complexapart[g_]:=ComplexApart[g,x];
        Map[complexapart,Apart[f,x]]
]

(* Simplifications of the Pochhammer symbols *)
ClearAttributes[Pochhammer,Protected]
Pochhammer[1/2,k_-1]:= 2 Pochhammer[1/2,k] / (2k-1)
Pochhammer[1/2,k_]  := (2k)!/(4^k*k!)
Pochhammer[n_,k_]   := (n+k-1)!/(n-1)! /; (IntegerQ[n] && n>=0)
Pochhammer[n_,k_]   := (-1)^k (-n)! / ((-n)-k)! /; (IntegerQ[-n] && (-n)>=0)
Pochhammer[a_,k_] := Pochhammer[2*a-1,2k]/ (4^k* Pochhammer[(2*a-1)/2,k]) /;
                       (Head[a]==Rational && IntegerQ[a+1/2] && a>0)
Pochhammer/: Pochhammer[a_,k_]*Pochhammer[b_,k_] := Pochhammer[2a,2k]/4^k /;
                       (Simplify[b-a]==1/2)
Pochhammer[a_,k_]   := Module[{anzahl},
                             anzahl = -a+1/2;
                             (-1)^anzahl Pochhammer[1-a-anzahl,anzahl] *
                                         Pochhammer[a+anzahl,k-anzahl]
                            ] /; (Head[a]==Rational && IntegerQ[a+1/2] && a<0)
Pochhammer/: Pochhammer[z_Complex,k_]*Pochhammer[cz_Complex,k_] :=
	     Product[(Re[z]+(jj-1))^2+Im[z]^2,{jj,k}] /;
             SameQ[z,Conjugate[cz]]
Pochhammer/: Pochhammer[1/3,k_]*Pochhammer[2/3,k_]:=(3k)!/(k!*27^k)
Pochhammer/: Pochhammer[2/3,k_]*Pochhammer[4/3,k_]:=
        (1 + 3*k)!/(27^k*k!)
(*
Pochhammer/: Pochhammer[b_,k_]*Pochhammer[c_,k_]:=
        Pochhammer[3b,3k]/(27^k Pochhammer[b+2/3,k]) /;
        (Simplify[c-b]==1/3 && IntegerQ[Simplify[b-1/3]] &&
        Not[Simplify[b-1/3]==0])
Pochhammer/: Pochhammer[1/4,k_]*Pochhammer[1/2,k_]*Pochhammer[3/4,k_]:=
        (4k)!/(k! 64^k)
Pochhammer/: Pochhammer[1/5,k_]*Pochhammer[2/5,k_]*Pochhammer[3/5,k_]*
        Pochhammer[4/5,k_]:=(5k)!/(k! 3125^k)
Pochhammer/: Pochhammer[2/5,k_]*Pochhammer[3/5,k_]*Pochhammer[4/5,k_]*
        Pochhammer[6/5,k_]:=(5*(1/5 + k)*(5*k)!)/(3125^k*k!)
Pochhammer/: Pochhammer[3/5,k_]*Pochhammer[4/5,k_]*Pochhammer[6/5,k_]*
        Pochhammer[7/5,k_]:=(25*(1/5 + k)*(2/5 + k)*(5*k)!)/(2*3125^k*k!)
Pochhammer/: Pochhammer[4/5,k_]*Pochhammer[6/5,k_]*Pochhammer[7/5,k_]*
        Pochhammer[8/5,k_]:=(125*(1/5 + k)*(2/5 + k)*(3/5 + k)*(5*k)!)/
        (6*3125^k*k!)
Pochhammer/: Pochhammer[6/5,k_]*Pochhammer[7/5,k_]*Pochhammer[8/5,k_]*
        Pochhammer[9/5,k_]:=(625*(1/5 + k)*(2/5 + k)*(3/5 + k)*(4/5 + k)*
        (5*k)!)/(24*3125^k*k!)
*)
Pochhammer/: Pochhammer[a_,k_]/Pochhammer[b_,k_]:=(a+k-1)/(a-1) /;
        Simplify[a-b]==1
Pochhammer/: Pochhammer[a_,k_]/Pochhammer[b_,k_]:=(b-1)/(b+k-1) /;
        Simplify[b-a]==1
Protect[Pochhammer]

Clear[PowerSeries,PS,AsymptPowerSeries]

Series[function_,{x_,x0_}]:=PowerSeries[function,x,x0]

Protect[Series]

PowerSeries[function_,{x_,x0_}]:=PowerSeries[function,x,x0]

PowerSeries[function_,x_]:= PowerSeries[function,x,0]

PowerSeries[function_,x_,x0_]:=Module[{},
Print["specfun-info: ",InputForm[x]," is not a valid variable."];
HoldForm[PowerSeries[function,x,x0]]]/;!SameQ[Head[x],Symbol]

PowerSeries[function_,x_,x0_]:=Module[{},
Print["specfun-warning: Please Clear[f] before using PowerSeries."]; 
HoldForm[PowerSeries[function,x,x0]]]/;SpecialFunctionsPrintMessages&&
(!SameQ[ToString[Head[Global`f[anything___]]],"f"]|| 
Not[SameQ["f",ToString[Global`f]]]) 

PowerSeries[function_,x_,x0_]:=Module[{},
Print["specfun-warning: Please Clear[jj] before using PowerSeries."];
HoldForm[PowerSeries[function,x,x0]]]/;
Not[SameQ["jj",ToString[Global`jj]]]

(* formal Laurent series at the point zero *)
PowerSeries[function_,x_,0]:=Module[
{
(* variables are local with respect to the package *)
subtemp,init,shift,xpotenz,simplesummand,result,recursfac,recnomil,recdomil,
summand,recnomil0,recdomil0,ddff,ex,pmax,nmax,conomi,domi,dep,de,
listzero,listvar,difflist,sum,finalsum,testlist,list,equ,lnew,length,
aa,j,i,solution,denomil,sollist,mmm,p,(*n,*)errorval,(*a,*)
lcm,nn,
tempre,subst,de00,re00,recoefflist,varlist,re,re01,reseparation,
reanalysis,maxd,reprodsum,findd,higherd,plus1,part12,term,exp,fac,poch,findpoch,
restart,tresult,presum,gcd,gcdindex,ninit,redenomi 
(* *)
},
If[SpecialFunctionsPrintMessages,
Print[specfuninfo]
];
presum=0;
tresult=0;
restart=0;
subst[g_+h_,x,a_]:=subst[g,x,a]+subst[h,x,a];
subst[c_*g_,x,a_]:=c*subst[g,x,a] /; FreeQ[c,x] && FreeQ[c,f];

subst[diff[f,x,k0_],x,a_]:=Pochhammer[k+1,k0]*a[k+k0];
subst[diff[f,x],x,a_]:=(k+1)*a[k+1];
subst[f,x,a_]:=a[k];

subst[x^j_.*diff[f,x,k0_],x,a_]:=Pochhammer[k+1-j,k0]*a[k+k0-j];
subst[x^j_.*diff[f,x],x,a_]:=(k+1-j)*a[k+1-j];
subst[x^j_.*f,x,a_]:=a[k-j];

subst[g_,x,a_]:=subst[Expand[g],x,a] /; (Head[g]==Times);

SetAttributes[ratalgo,HoldFirst];
makecoeff[c_./(d_.x+b___)]:= -c/d (-d/b)^(k+1);
anapoly[c_./(d_.x+b1_.+b2_.)]:= Module[{},
                                      If[SameQ[b1+b2,0],
                                         {{},c/(d*x)},
                                         {{-c/d (-d/(b1+b2))^(k+1)},0 }
                                     ]  ];

anapoly[c_.*((d_.x+b1_.+b2_.)^(b3_.))]:=
       Module[{},
             If[SameQ[b1+b2,0],
                {{},c(d*x)^b3},
                {{c(-d)^b3 (-d/(b1+b2))^(k-b3) Binomial[-b3+k-1,k]},0 }
            ]  ]/;IntegerQ[b3] && Negative[b3];

anapoly[p_]:=Module[{ap1,ap2,r1,r2,pr1,pr2},
                         ap1=First[p];ap2=Rest[p];
                         {r1,pr1}=anapoly[ap1];
                         {r2,pr2}=anapoly[ap2];
                         Return[{Join[r1,r2],pr1+pr2}]
                        ]/;SameQ[Head[p],Plus];

anapoly[pp_]            := {{}                 ,pp};
ratalgo[poly_] := Module[{},
fp=Simplify[Together[poly]];
If[Not[ PolynomialQ[Numerator[fp],x] && PolynomialQ[Denominator[fp],x] ],
   Return[False]
  ];

afp0=ComplexApart[poly,x];
If[SameQ[poly,afp0],
   If[SpecialFunctionsPrintMessages,
         Print["specfun-info: rational algorithm applied"]],
   If[SpecialFunctionsPrintMessages,
         Print["specfun-info: rational algorithm applied (",poly,
	 " = ",afp0,")"]]
  ];
afp =Map[Simplify,afp0];
{tfp,presum}=anapoly[afp/.introducei];
mfp=Simplify[tfp];
mfp1=Apply[Plus,mfp];
mfp2=complexfactor[mfp1];
mfp3=complexmod[mfp2];
mfp4=Simplify[mfp3 /.introducei];
mfp5=simple[mfp4];
mfp6=simple[Together[mfp5]];
mfp7=complexfactor[Map[simple,Expand[mfp6]]];
simplesummand[1]=Simplify[mfp7];
ex[1]=k;
prepprint;
(*prettyprint[poly];*)
returnval=tresult;
Return[True]
];

(* initialisations for pretty-print *)
prepprint:=Module[{},
            xpotenz[1]=x^ex[1];
            tresult= presum + If[SameQ[simplesummand[1],0],0,
                        Global`sum[simplesummand[1] xpotenz[1],{k,0,Infinity}]];
            rparts=1;
            psstart=0;
            border=Infinity;
           ];

(* enhanced limit functions *)
limit[a_,b_] := Module[{l,r,r2,length},
                      Off[Limit::nlm,Power::infy,Infinity::indet];
                      r=a/.b;
                      If[undefined[r],
		        If[asympt,
			  l=Limit[a,b,Direction ->-1],
                          l=Limit[a,b]
			  ];
                       If[Not[SameQ[Head[l],Limit]], r=l],
                      (* else  *)
                       r2= r/.transformspecial1;
                       If[!SameQ[r,r2],
                        If[asympt,
                          l=Limit[a,b,Direction ->-1],
                          l=Limit[a,b]
                          ];
                         If[Not[SameQ[Head[l],Limit]], r=l]
                         ]
                        ](* if undefined *);
                      On[Limit::nlm,Power::infy,Infinity::indet];
                      Return[r]
                     ];

Clear[ListOfIndependentTerms];

ListOfIndependentTerms[list1_,xx_]:= Module[{lnew,
length,first,fraction,sum,i},
 lnew = {};
 length = Length[list1];
first = list1[[1]];
sum = first;
For[i=2, i<=length, i++,
 fraction = Factor[Cancel[first/list1[[i]]]];
 If [RationalQ[fraction,xx],
 sum  += list1[[i]], (* rat. dependent  *)
 AppendTo[lnew,list1[[i]]] (* rat. indep  *)
    ]  (* if  *)
   ];  (* for   *)
Flatten[{sum,ListOfIndependentTerms[lnew,xx]}]
]/;(Length[list1]>1);

ListOfIndependentTerms[list1_,xx_]:= Flatten[{list1}]/;(Length[list1]<2);

lcm[{}]:=1;
lcm[a_]:=Module[{j},
        PolynomialLCM[First[a],lcm[Rest[a]]]
];

(* polynomial expansion with complex zeros *)
factorcomplexlist[{e_List,r___List}]:=
              Module[{},
		 Join[ factorcomplexlist[e],factorcomplexlist[{r}] ]];
factorcomplexlist[{}]:= {};
factorcomplexlist[{npoly___,expo_}]:={{npoly,expo}}/; (Exponent[npoly,k]<2);
factorcomplexlist[{npoly___,expo_}]:=
                 Module[{coeff,list,newpoly,r},
                       coeff=Coefficient[npoly,k,2];
                       list={{coeff,expo}};
                       newpoly=Simplify[npoly/coeff];
                       r=Join[list,factorcomplexlist[{newpoly,expo}]];
                       Return[r]
                      ] /; Exponent[npoly,k]==2 && Coefficient[npoly,k,2]!=1;

factorcomplexlist[{npoly___,expo_}]:=
                 Module[{sol,r1,r2},
                       sol=Solve[npoly==0,k];
                       r1={Simplify[k-sol[[1,1,2]]],expo};
                       r2={Simplify[k-sol[[2,1,2]]],expo};

		       Return[{r1,r2}]
                      ] /; Exponent[npoly,k]==2 && Coefficient[npoly,k,2]==1;

(* test: are all coefficients of the DE constant? -> True, else -> False *)
decoefconst[detest_] :=
           Module[{},
                 devarl1 = Variables[detest];
                 devarl2 = Union[Cases[devarl1,f],
                                 Cases[devarl1,diff[f,x]],
                                 Cases[devarl1,diff[f,x,_]]
                                ];
                 decoefflist = Coefficient[detest,#]& /@ devarl2;
                 logiclist   = Map[freex,decoefflist];
                 Return[Apply[And,logiclist]]
                ];

(* pattern for the hypergeometric series *)
findpoch[c_.*k+s_.] := {c,s/c};

(* transformation of RE in RE of derivative function *)
diffre[re_] := (re/.k->k+redenomi) /.a[k+mx_.]->a[k+mx-redenomi]/(k+mx);

(* simplifications of rational expressions *)
simple[(Pochhammer[a_,k_])/Pochhammer[b_,k1_]]:=
simple[Product[a+ii,{ii,0,k-1}]
/(Product[b+ii,{ii,0,k-1}])]/;Equal[k-k1,0];
(* momentan raus 
simple[e_^(b_*c_)*d_.] := simple[(e^b)^c * d] /; IntegerQ[e] && IntegerQ[b];
*)
simple[(-1)^(2 e_)*c_.] := simple[c];
simple[(e__^k__*b__^k__)*c___] := Module[{},ax=Expand[e b];
                                             If[SameQ[ax,e*b],(ax)^k*c,
                                                simple[(ax)^k*c]
                                         ]     ];
simple[(e__^k__/b__^k__)*c___] := simple[(e/b)^k*c];
simple[e_*b_] := e*b /; FreeQ[e,_^k] || FreeQ[b,_^k];
simple[e_./b_] := e/b /; FreeQ[e,_^k] || FreeQ[b,_^k];
simple[Sqrt[b_]*c___] := Sqrt[-b] * I * simple[c] /; IntegerQ[-b];
simple[e_] := e ;
(* simple[e_]:=FullSimplify[e]; *)
(* CHANGE *)

(* bring the RE in canonical form *)
reseparation[tempre_]:=Module[{v,c},
                             v=Cases[Variables[tempre],a[__]];
                             c=Simplify[Coefficient[Expand[tempre],#]& /@ v];
                             Return[{c,v}]
                            ];

(* analyse the RE *)
reanalysis[coefflist_,varlist_] :=
Module[{i},
(* normalize and sort the RE:
   k is smallest index, sum starts with largest index *)
l = Length[varlist];
mind = findd[varlist[[1]]];

For [i=2, i<=l, i++, mind= Min[findd[varlist[[i]]],mind]];
nrecoefflist = Simplify[coefflist /. k -> k-mind];
nvarlist = varlist /. k -> k-mind;
nrelist = nrecoefflist*nvarlist;
nnrelist= Sort[nrelist,higherd];
maxd = findd[nnrelist[[1]]];
leadco = Simplify[nnrelist[[1]]/a[k+maxd]];
reprod = Simplify[-Rest[nnrelist]/leadco];
reprodsum = Factor[Apply[Plus,reprod]];
gcd = PolynomialGCD[Apply[Plus,-Rest[nnrelist]],leadco];
nnrelist = Cancel[nnrelist/gcd];

(* initialization of RE *)
rinitsol = Simplify[Solve[leadco==0,k]];
rinitlist0=Map[part12,rinitsol];
rinitlist= Map[plus1,rinitlist0];
For [rri=1;condlist={},rri<=Length[rinitlist],rri++,
     Which[SameQ[ Head[rinitlist[[rri]]//N], Complex],
            rinitlist[[rri]]=0, (* complex zero *)
           Not[NumberQ[ rinitlist[[rri]] //N ]],
            AppendTo[condlist,rinitlist[[rri]]];
            rinitlist[[rri]]=0, (* variable zero *)
           SameQ[Head[rinitlist[[rri]]],Rational],
            redenomi=Denominator[rinitlist[[rri]]]
    ]     ];
ninit = If [rinitsol=={}, 0, Max[rinitlist] ];
restart = If [rinitsol=={}, 0, Max[rinitlist] ];
 Do [Print["specfun-warning: ",condlist[[rrii]]," < ",ninit+1," is assumed"],
 {rrii,Length[condlist]}
    ];
If[SpecialFunctionsPrintMessages,
        Print["specfun-info: RE for all k >= ",InputForm[restart/.k->
	Global`k]  ,":"]];
If[SpecialFunctionsPrintMessages,
        Print["         a[",(Global`k+maxd),"] = ",InputForm[reprodsum/.
	{k->Global`k,a->Global`a}]]]
];
RE (* global *) = a[k+maxd]==reprodsum;

(* invert RE *)
reinverse:=Module[{},
(* representation of inverted RE *)
ileadco = Simplify[nnrelist[[2]]/a[k]];
ireprod = Simplify[-nnrelist[[1]]/ileadco];

(* initialization of inverted RE *)
irinitsol = Solve[ileadco==0,k];
irinitlist= If[SameQ[irinitsol,{{}}], {}, Map[part12,irinitsol]];
For[ll=1,ll<=Length[irinitlist],ll++,
    lv:=irinitlist[[ll]];
    If[Not[NumberQ[lv]] || SameQ[Head[lv],Complex],
       irinitlist[[ll]]=Infinity
   ]  ];
restop = Min[ Append[irinitlist,Infinity] ]
];

(* auxiliary functions *)
findd[c_. * aa_[k]] := 0;
findd[c_. * aa_[k+d_.]] := d;
higherd[z_,y_] := findd[z] > findd[y];
plus1[pp___]:=pp + 1;
part12plus1[pp___]:=Part[pp,1,2] + 1;
part12[pp___]:=Part[pp,1,2];
introducei  = Sqrt[qq_Integer?Negative] :> Sqrt[-qq] I;
introducei2 = sqrt[-1] -> I;
introducesqrt  = c_Complex -> Re[c] + Im[c] Sqrt[-1];
introducesqrt2 = c_Complex -> Re[c] + Im[c] sqrt[-1];
factor[z_] := Factor[z//.introducesqrt] //. introducei;
complexfactor[z_] := Factor[z//.introducesqrt2] //. introducei2;
freex[t_] := FreeQ[t,x];
undefined[z_] := SameQ[Head[z],DirectedInfinity] ||
                 SameQ[z,Indeterminate] ||
                 MemberQ[Map[Head,Level[z,-1]],DirectedInfinity] ||
                 MemberQ[Level[z,-1],Indeterminate];

(* internal argument funktion *)
arg[z_Real] := 0 /; z > 0;
arg[z_Real] := Pi /; z < 0;
arg[z_Complex] := Which[SameQ[z,0],     Indeterminate,
                        SameQ[Re[z],0], ArcSin[Im[z]/Abs[z]],
                        Re[z] > 0,           ArcTan[Im[z]/Re[z]],
                        Re[z] < 0 && Im[z]>0,ArcTan[Im[z]/Re[z]]+Pi,
                        True            , ArcTan[Im[z]/Re[z]]-Pi
                       ];
arg[a_.+b_Complex d_.] := Which[SameQ[a,0] && SameQ[Im[b],0], Indeterminate,
                       SameQ[a,0], ArcSin[Im[b] d/abs[a+b d]],
                       True,       ArcTan[Im[b] d/a]
                       ] /; SameQ[Re[b],0];
(*
arg[y_]:=Arg[y];
*)

abs[z_Complex] := Abs[z];
abs[a_.+b_Complex d_.] := Sqrt[a^2+(Im[b] d)^2] /; SameQ[Re[b],0];
abs[y_] := Abs[y];

(* simplification of complex expressions *)
complexmod[((z_Complex)^k_ - (y_Complex)^k_) c_.] :=
          Module[{},
                   c 2 I Abs[z]^k Sin[k arg[z]] ]/;
          SameQ[z,Conjugate[y]] && Positive[Re[z]] &&
          Not[SameQ[Head[arg[z]],ArcTan]];

complexmod[((z_Complex)^k_ - (y_Complex)^k_) c_.] :=
          Module[{},
                   (-1)^k c complexmod[(-z)^k - (-y)^k] ]/;
          SameQ[z,Conjugate[y]] && Negative[Re[z]] &&
          Not[SameQ[Head[arg[-z]],ArcTan]];

complexmod[((a_.+ b1_Complex d_.)^k_ - (a_.+ b2_Complex d_.)^k_) c_.] :=

                   c 2 I abs[a+b1 d]^k Sin[k arg[a+b1 d]] /;
          Positive[a] && SameQ[b1,-b2] &&
          Not[SameQ[Head[arg[a+b1 d]],ArcTan]];

complexmod[((a_.+ b1_Complex d_.)^k_ - (a_.+ b2_Complex d_.)^k_) c_.] :=
                   (-1)^k c complexmod[(-a+b1 d)^k - (-a+b2 d)^k] /;
          Negative[a] && SameQ[b1,-b2] &&
          Not[SameQ[Head[arg[a+b1 d]],ArcTan]];

complexmod[((z_Complex)^k_ + (y_Complex)^k_) c_.] :=
          c 2 abs[z]^k Cos[k arg[z]] /;
          Not[SameQ[Head[arg[z]],ArcTan]];

complexmod[((a_.+ b1_Complex d_.)^k_ + (a_. + b2_Complex d_.)^k_) c_.] :=
	  c 2 abs[a+b1 d]^k Cos[k arg[a+b1 d]] /;
	  SameQ[b1,-b2] && Not[SameQ[Head[arg[a+b1 d]],ArcTan]];

complexmod[z___] := z;

(* integration of a sum *)
fintegrate[simsum_,xex_,psum_,origin_]:=
           Module[{(*const,singular,tsimsum,txex,tpsum*)},
                 {tsimsum,txex,tpsum}={simsum,xex,psum};
                 singular=Integrate[ tsimsum * x^txex /.k->0 ,x];
                 const=limit[origin-singular,x->0];
		 If[presum==0,tpsum = tpsum + singular + const,
		 tpsum = tpsum + singular];
                 txex=txex+1;
                 tsimsum=tsimsum/txex;
                 tsimsum=Simplify[simple[tsimsum]];
                 Return[{tsimsum,txex,tpsum}]
                ];
Recoefconst[dflist1_]:=Module[{
i,i1,i2,i3,i4,form,solve,equlist0,df,length},
length = Length[dflist1];
df[0]=dflist1[[1]];
For[i=1,i<=length+restart-1,++i,df[i] =D[df[i-1],x]];
solve     = Solve[Apply[Plus,nnrelist5]==0,x] //. introducei;
len       = Length[solve] - 1;
varlist   = Table[ai[i1],{i1,0,len}];
Do[xi[i4] = Simplify[solve[[i4+1,1,2]]];
   bi[i4] = limit[df[i4+restart],x->0],
   {i4,0,len}
   ];
form      = Sum[ai[i2] xi[i2]^k, {i2,0,len}];
equlist0  = {};
equlistr  = Table[bi[i3]==(form//.k->i3+restart), {i3,0,len}];

equlist   = Join[equlist0,equlistr];
solve2    = Solve[equlist,varlist];
summand[1]= First[form/k! /. solve2]
];

(* pretty print, disabled *)
SetAttributes[prettyprint,HoldFirst];
(*prettyprint[fkt_]:=Module[{},
output={"         "};
If [Not[SameQ[presum,0]],AppendTo[output,presum]];
For [prlauf=1,prlauf<=rparts,prlauf++,
     If[   (prlauf>1 || Not[SameQ[presum,0]])
        && Not[SameQ[simplesummand[prlauf],0]],
        AppendTo[output," + "]
       ];
     AppendTo[output,
              Which [SameQ[simplesummand[prlauf],0], "",
                     True,ColumnForm[{border,"----",">","----",
                                      SequenceForm["k = ",psstart,"    "]
                                     },
                                     Left,Center
             ]      ]               ];
     AppendTo[output,
              Which [(SameQ[simplesummand[prlauf],0] &&
                      (Not[SameQ[presum,0]] || (prlauf>1))
                     ) || SameQ[simplesummand[prlauf],1], "",
                     True,simplesummand[prlauf]
             ]      ];
     AppendTo[output," "];
     AppendTo[output,
              Which [(SameQ[xpotenz[prlauf],1] &&
                      Not[SameQ[simplesummand[prlauf],1]]
                     ) || SameQ[simplesummand[prlauf],0],"",
                     True,xpotenz[prlauf]
    ]        ]      ];
output = Apply[SequenceForm,output];
If[SpecialFunctionsPrintMessages,Print[output]]
];  *)

(* conversion in a power series *)
SetAttributes[ps,HoldFirst];
SetAttributes[psint,HoldFirst];
modilist={};
ps[fkt_,max_,nmax0_] :=
Module[{dfi,dfib,mi},
      (* If [ratalgo[fkt],Return[returnval],rat = False]; *)
      rat=False;
      {code,returnval}=psint[fkt,max,nmax0];
      If[Not[SameQ[code,0]] && Not[SameQ[code,4]],
         For[dfi=0,dfi<=pmax (*&& dfi<p*),dfi++,
             ClearAttributes[ratalgo,HoldFirst];
	     rat = ratalgo[df[dfi]];
             If[rat,
		 If[SpecialFunctionsPrintMessages,
                Print["specfun-info: rational derivative: D[f,{x,",dfi,"}] = "]];
                If[SpecialFunctionsPrintMessages,
                Print["         ",df[dfi]]];
                For[dfib=dfi-1,dfib>=0,dfib--,
                    {simplesummand[1],ex[1],presum}=
                      (* Das hier scheint Bloedsinn zu sein *)
		      fintegrate[simplesummand[1],ex[1],presum,df[dfib]];
		    (* normalization with startindex=0 *)
		    (* Das hier scheint Bloedsinn zu sein *)
                    presum = presum - ((simplesummand[1] x^ex[1])/.k->0);
                    prepprint;
		    ClearAttributes[prettyprint,HoldFirst];
                    (*prettyprint[df[dfib]];*)
                    SetAttributes[prettyprint,HoldFirst]
                   ];
                SetAttributes[ratalgo,HoldFirst];
                Return[tresult]
               ];
             SetAttributes[ratalgo,HoldFirst]
        ]  ];
    If[!rat&&SameQ[code,3],Return[HoldForm[PowerSeries[function,x,0]]]];
      Which[SameQ[code,0],
            Return[returnval],
            SameQ[code,1],
            For[mi=1,mi<=Length[modilist],mi++,
                modfkt=Apply[modilist[[mi]],{fkt}];
                If[Not[SameQ[modfkt,fkt]],
                   If[SpecialFunctionsPrintMessages,
                         Print["specfun-info: ",fkt," modified to:"]];
                   If[SpecialFunctionsPrintMessages,
                         Print["         ",modfkt ]];
                   ClearAttributes[psint,HoldFirst];
                   {c2,returnval}=psint[modfkt,max,nmax0];
                   SetAttributes[psint,HoldFirst];
                   If[c2!=0 || c2!=1 || c2!=4, 
		      Return[HoldForm[PowerSeries[function,x,0]]]]
               ]  ],
            SameQ[code,3],
            Return[returnval],
            SameQ[code,4],
            Return[HoldForm[PowerSeries[function,x,0]]]
            ];
      Return[HoldForm[PowerSeries[function,x,0]]]
     ];  (* ps  *)

(* 
   returncodes psint:
   0, ok / PS found
   1, DE not found
   2, no initialization found
   3, RE type not supported
   4, PS does not exist
*)

psint[fkt_,max_,nmax0_]:=Module[{(* ff,pmax,Pde,de,dep,p,nn,
       dflist,co,sum, m,ix,aa0,ifold,rpart,i*)},
errorval=(*SequenceForm["ps[",*) HoldForm[fkt](*, ",", max, "]"]*);
pmax = max;
nmax = nmax0;
df[0] = fkt;

DE=de=SimpleDE[df[0],x,F][[1]];
de=de/.{F[x]->f,Derivative[kkk_][F][x]->
diff[f,x,kkk]};
If[SpecialFunctionsPrintMessages,Print["specfun-info: DE:"]];
If[SpecialFunctionsPrintMessages,Pde = de/.{f->Global`f[x],diff[f,x]->Global`f'[x],
diff[f,x,o_]->Derivative[o][Global`f][x]};
Print["         ",Pde /.x->Global`x," == 0"]];
Do[df[kkk]=D[df[kkk-1],x],{kkk,1,DEOrder[DE,F,x]}];
dflist=Table[df[kkk],{kkk,0,DEOrder[DE,F,x]}];

(* conversion in a RE *)
Clear[n];
re00= subst[de,x,a];
{recoefflist,varlist}=reseparation[re00];
re=re01=Apply[Plus,recoefflist*varlist];
(* functions with fractional exponents *)
redenomi=1;
reanalysis[recoefflist,varlist];

If[Not[SameQ[redenomi,1]],
   If[SpecialFunctionsPrintMessages,
         Print["specfun-info: RE modified to (k -> ",
	  (k/redenomi)/.k->Global`k,")"]];
   varlist2=nvarlist /. a[k+mmmm_]->a[k+(mmmm redenomi)];
   recoefflist2=Simplify[Expand[nrecoefflist] /. k^e_. -> (k/redenomi)^e];
   re=Apply[Plus,recoefflist2*varlist2];
   reanalysis[recoefflist2,varlist2];
  ];
fmod:=x->x^redenomi;
(* initialization of all RE types *)
psstart=0;
lvarlist=Length[varlist];
(* test for RE type *)
Which[

(* functions with finite representation *)
lvarlist==1,
If[SpecialFunctionsPrintMessages,
        Print["specfun-info: ps with finite number of non-zero coefficients"]];
If[SameQ[ninit,0],
   If[SpecialFunctionsPrintMessages,Print["specfun-info: PS does not exist"]];
   Return[{4,errorval}]
  ];
presum = 0;

For [ix=0,ix<ninit,ix++,
     exp=ix/redenomi;
     subtemp=  Simplify[D[df[0]/.fmod,{x,ix}]];
     subtemp= subtemp/.transformspecial2;
     temp = limit[ subtemp ,x->0] *x^exp/ix!;
     If[undefined[temp],
        If[SpecialFunctionsPrintMessages,Print["specfun-info: a[",ix,"]=",temp]];
        If[SpecialFunctionsPrintMessages,Print["specfun-info: PS does not exist"]];
        Return[{4,errorval}],
        presum = presum+temp;
    ]  ];
initshift=0;
tresult=presum;
summand[1]=0;
simplesummand[1]=0;
xpotenz[1]=0;
rparts = 1, (* number of parts of the resulting expression *)
(* functions of hypergeometric type *)
lvarlist==2,
mfold = Max[ findd[nvarlist[[1]]], findd[nvarlist[[2]]] ];
If[Not[FreeQ[gcd,k]],
solgcd=Solve[gcd==0,k];
If[Length[solgcd]>1,"specfun-info: too difficult recurrence equation";
Return[{fkt,4}]
];
gcdindex=solgcd[[1,1,2]];
presum=
limit[(df[0]/.fmod)*x^(-gcdindex),x->0]x^gcdindex;
,
(* Else *)
presum=0;
gcdindex=0
];

If[SpecialFunctionsPrintMessages,
        Print["specfun-info: function of hypergeometric type"]];
reinverse;
(* 1-symmetric functions *)
If [mfold==1,
    If[rinitsol!={}, If[SpecialFunctionsPrintMessages,
        Print["specfun-info: for all k <= ",restart-1,": a[k]=0"] ]];
    If[irinitsol!={}, If[SpecialFunctionsPrintMessages,
        Print["specfun-info: for all k >= ",restop+1,": a[k]=0"] ]]
   ];

originfkt=df[0];
(* logarithmic singularities *)
integrate=False;
tempdenomi= denomi/.transformspecial2;
If[(* NEW CONDITION (SameQ[Cases[Variables[de],f],{}] &&
   (SameQ[maxd,dep] || Not[NumberQ[Coefficient[de,diff[f,x,dep]]]])) *)
   (SameQ[Cases[Variables[de],f],{}] &&
   (Not[NumberQ[Coefficient[de,diff[f,x,maxd]]]]))
   && limit[tempdenomi,x->0]==0,
   integrate=True;
   If[SpecialFunctionsPrintMessages,
        Print["specfun-info: working with f' = ",df[1]]];
   {rec1,rev1}=reseparation[diffre[re]];
    reanalysis[rec1,rev1];
   reinverse;
   df[0]=df[1];
   psstart=1;
   If[Not[FreeQ[gcd,k]],
   solgcd=Solve[gcd==0,k];
   If[Length[solgcd]>1,"specfun-info: too difficult recurrence equation";
   Return[{fkt,4}]
   ];
   gcdindex=solgcd[[1,1,2]];
   presum=
   limit[(df[0]/.fmod)*x^(-gcdindex),x->0]x^gcdindex,
   (* Else *)
   presum=0;
   gcdindex=0
   ] 
  ];

(* essential singularities *)
reverse=False;
Off[Series::esss];
(*IfHead[Series[df[0],{x,0,0}]]==Series, no more supported *)
If[False,
   reverse=True;
  If[SpecialFunctionsPrintMessages,
        Print["specfun-info: working with ",f[x^(-1)]]];
   newcoefflist=If[integrate,
                   {rec1[[2]],(-1)^(mfold-1) rec1[[1]]},
                   {recoefflist[[2]],recoefflist[[1]]}/.k->-k
                  ];
   newvarlist=If[integrate,rev1,{varlist[[2]],a[2k-varlist[[1]][[1]]]}];

   df[0]=If[integrate,D[originfkt/.x->1/x,x],df[0]/.x->1/x];
   reanalysis[newcoefflist,newvarlist]
  ];
singmod=x->x^(If[reverse,-1,1]);
(* initial coefficients *)
initshift=0;
shift[1]=Null;
For [aa0=-restart;
  ddff[aa0]=Together[((df[0]-presum)/.fmod)*x^(-restart)],
aa0<=-restart+nmax,
 aa0++;ddff[aa0]=ddff[aa0-1],
     For [aa=0; inter=ddff[aa0] ,
        aa<=mfold+nmax, aa++;
	inter=D[inter,x],
          inter = inter/.transformspecial2;
	  init[1] = limit[inter,x->0] / aa!;
          init[1] = init[1]/.transformspecial2;
	  If [undefined[init[1]],
              If[SpecialFunctionsPrintMessages,
              Print["specfun-info: no initialization found for PS
(a[",aa,"]=",
                    init[1],")"]];
              Break[],
              If[SpecialFunctionsPrintMessages,
                 Print["specfun-info: a[",aa,"] = ",init[1]]];
         If [Not[SameQ[init[1],0]], 
	 initindex=shift[1]=aa; 
	 Break[]   ] ]   ];
     If [SameQ[shift[1],Null],
         If[SpecialFunctionsPrintMessages,
	 If[SameQ[ToString[Global`f],"f"], ff=Global`f,ff=f];
	 Print["specfun-info: for n < ",aa,
               " no initialization found for PS: ",x^aa0 ff]],
         initshift=aa0;
         Break[]
    ]   ];
If [SameQ[shift[1],Null], Return[{2,errorval}]];


border=Infinity;
tresult = 0;
rparts = mfold; (* number of parts of the resulting expression *)

(* initialization of multi-part FPS *)
If [mfold>1,
    For [ifold=2,ifold<=mfold,ifold++,
         temp = ifold - 1;
	 tempinit = D[ddff[initshift],{x,initindex+temp}];
	 tempinit = tempinit/.transformspecial2;
         init[ifold]=limit[tempinit,x->0] /
                     (initindex+temp)!;
         If[SpecialFunctionsPrintMessages,
                Print["specfun-info: a[",initindex+temp,"] = ",init[ifold]]];
         shift[ifold] = shift[1] + temp
   ]    ];
(* type of symmetry: shift=1 (odd), shift=0 (even) *)
If [mfold==2,
    Which[Not[SameQ[init[2],0]],
          If[SpecialFunctionsPrintMessages,
                Print["specfun-info: PS divided into 2 parts",
                " (non-symmetric 2-fold function)"]],
          OddQ[initindex+initshift],
          If[SpecialFunctionsPrintMessages,
                Print["specfun-info: shifted 2-fold symmetric function",
                " (e.g. odd)"]],
          EvenQ[initindex+initshift],
          If[SpecialFunctionsPrintMessages,
                Print["specfun-info: 2-fold symmetric function (e.g. even)"]]
   ]     ];
On[Series::esss];
(* calculation of the parts of the resulting expression *)
For [rpart=1,rpart<=rparts,rpart++,
     If[SameQ[init[rpart],0],
     summand[rpart]=0,

     (* RE for the coefficients *)
     recoefflistsort = nnrelist /. a[__]->1;
     recoefflist1 = recoefflistsort /. k -> mfold*k+shift[rpart]-initshift;
     recursfac[rpart] = Factor[-(recoefflist1[[2]]/recoefflist1[[1]])];
     (* summand in the hypergeometric FPS *)
     recnomil0[rpart] = FactorList[Numerator[recursfac[rpart]]];
     recnomil[rpart]  = factorcomplexlist[recnomil0[rpart]];
     recdomil0[rpart] = FactorList[Denominator[recursfac[rpart]]];
     recdomil[rpart]  = factorcomplexlist[recdomil0[rpart]];
     nomi = 1;
     domi = 1;
     nomifac = 1;
     domifac = 1;
	  For [i=1,i<=Length[recnomil[rpart]],i++,
          {term,exp}={First[recnomil[rpart][[i]]],Last[recnomil[rpart][[i]]]};
          If [FreeQ[term,k],
              nomifac = nomifac * term^exp,
              {fac,poch} = findpoch[term];
              nomifac = nomifac * fac^exp;
              nomi = nomi * Pochhammer[poch,k]^exp
         ]   ];
     For [i=1,i<=Length[recdomil[rpart]],i++,
          {term,exp}={First[recdomil[rpart][[i]]],Last[recdomil[rpart][[i]]]};
          If [FreeQ[term,k],
              domifac = domifac * term^exp,
              {fac,poch} = findpoch[term];
              domifac = domifac * fac^exp;
              domi = domi * Pochhammer[poch,k]^exp
             ] (* if freeQ *)
	 ] (* for i *);

     Off[GreaterEqual::nord];
     summand[rpart]= Simplify[(nomifac/domifac)^k*(nomi/domi)] //.introducei;
     On[GreaterEqual::nord]

     ] (* if SameQ *);
     Off[Power::infy,Infinity::indet];
     (* sum representation *)
     If[SameQ[summand[rpart],0],
        simplesummand[rpart] = 0;
        ex[rpart] = (shift[rpart]-initshift) / redenomi;
	 If[integrate,init[rpart]=init[rpart]/++ex[rpart]];
        If[reverse,ex[rpart]=-ex[rpart]];
	xpotenz[rpart] = x^ex[rpart];
        result[rpart]  = simplesummand[rpart],
        simplesummand[rpart] = simple[Simplify[summand[rpart] * init[rpart]]];
        simplesummand[rpart] = Factor[simplesummand[rpart]];
        ex[rpart] = Simplify[(mfold k + shift[rpart] - initshift)/redenomi];
        If[integrate,
          {simplesummand[rpart],ex[rpart],presum}=
          fintegrate[simplesummand[rpart],ex[rpart],presum,originfkt/.singmod];
          ];

        (* normalization of the sums with startindex=0 *)
	If [Not[SameQ[psstart,0]],
            Off[Power::infy];
            norm=Sum[simplesummand[rpart] x^ex[rpart], {k,0,psstart-1}];
            On[Power::infy];
            If [Not[undefined[norm]], presum=presum-norm; 
	    psstart=0]
           ];

        If[reverse,ex[rpart]=-ex[rpart]];
        xpotenz[rpart] = x^ex[rpart];

        result[rpart] = Global`sum[simplesummand[rpart]*xpotenz[rpart],
                            {k,psstart,border}
                           ] 
       ](* if sameq summand  *);
       On[Power::infy,Infinity::indet];
     tresult = tresult + result[rpart]
    ];
Do[
If[PolynomialQ[nnrelist[[2]]/(a[k]*(k-restart-kkk)),k],
presum=presum+limit[D[(df[0]/.fmod)*x^(-restart),{x,kkk}],x->0]*
x^(restart+kkk)],{kkk,0,mfold-1}];
tresult = presum + tresult;
,

(*  explike case *)
decoefconst[de],
If[SpecialFunctionsPrintMessages,
        Print["specfun-info: DE has constant coefficients"]];
nnrelist2 = nnrelist*k!;
nnrelist3 = nnrelist2/. a[k_]->b[k]/k!;
nnrelist3 =  Simplify[nnrelist3];
If[SpecialFunctionsPrintMessages,
        Print["specfun-info: modified RE (a[k] -> k! a[k]):"]];
If[SpecialFunctionsPrintMessages,
        Print["         ",Apply[Plus,nnrelist3]/.{b->Global`a,
	k->Global`k}," == 0"]];
nnrelist4 = (nnrelist3 /. b[k_]->x^k) / x^k;
gap=0;
nnrelist5 = nnrelist4 x^gap;
recoefconst = Recoefconst[dflist];
simplesummand0 = summand[1] //. introducei;
simplesummand1 = complexfactor[Simplify[simplesummand0]];
simplesummand[1] = complexfactor[Simplify[complexmod[simplesummand1]]];
xpotenz[1] = x^(Simplify[k/redenomi]);
initshift=0;
(*
presum = Sum[limit[df[lx],x->0]x^lx/lx!,{lx,0,restart}];
??? *)
presum=0;
tresult= presum + Global`sum[simplesummand[1] * xpotenz[1],{k,restart,Infinity}];
rparts = 1;
border = Infinity,

(* RE not supported *)
True,
If[SpecialFunctionsPrintMessages,Print["specfun-info: RE type not supported"]];
Return[{3,errorval}]
];
(*prettyprint[fkt];*)
Return[{0,tresult}]
];

(* main program *)
If[Not[FreeQ[function,GegenbauerC[kkk_,0,xxx_]]],
Gegenbauer0Print[function];
Return[HoldForm[PowerSeries[function,x,0]]]
];
If[Not[FreeQ[function,GegenbauerC[kkk_,aaa_,xxx_]]],
GegenbauerWarning[function,{}];
];

If[!FreeQ[fkt,F]||!FreeQ[x,F],
 If[SpecialFunctionsPrintMessages,
 Print["specfun-warning: the symbol F is used in the differential equation."]
   ]
  ];
(* HERE order could be omitted *)
order0 = order = 5;	
ps[function,order,order0]/.{jj->Global`jj,k->Global`k}
]/;FreeQ[function,Global`k]&&FreeQ[x,Global`k]&&FreeQ[x0,Global`k]&&
  SameQ["k",ToString[Global`k]] 

PowerSeries[function_,x_,x0_]:=Module[{},
If[SameQ["k",ToString[Global`k]],
Print["specfun-warning: Please unassign k with Clear[k] before using this function."]
  ];
HoldForm[PowerSeries[function,x,x0]]
]/;!(FreeQ[function,Global`k]&&FreeQ[x,Global`k]&&FreeQ[x0,Global`k]&&
SameQ["k",ToString[Global`k]])

PowerSeries[function_,x_,Infinity]:=Module[{temp},
asympt = False;
temp = PowerSeries[function/.x->1/x,x,0];
temp/.x->1/x
]

(* formal Laurent series at an arbitrary point *)
PowerSeries[func_,y_,y0_]:=Module[{temp(*x*)},
      If[SpecialFunctionsPrintMessages, funcp = func /.y->x+y0;
      Print["specfun-info: working with ",funcp /. x->Global`x]];
temp = PowerSeries[(func /. y->x+y0),x,0];
temp/. (x->y-y0)
]/;!SameQ[ToString[y0],"x"]

PowerSeries[func_,y_,y0_]:=Module[{},
Print["specfun-warning: Please use another symbol than x as third argument"];
HoldForm[PowerSeries[func,y,y0]]
]

(* shortform *)
PS[anything___]:=PowerSeries[anything]
FPS[anything___]:=PowerSeries[anything]

AsymptPowerSeries[function_,x_]:=Module[{},
Print[InputForm[x]," is not a valid variable."];
HoldForm[AsymptPowerSeries[function,x]]]/;!SameQ[Head[x],Symbol]

AsymptPowerSeries[function_,x_]:= AsymptPowerSeries[function,x]

AsymptPowerSeries[function_,x_]:=Module[{temp},
asympt = True;
temp = PowerSeries[function/.x->1/x,x,0];
asympt = False;
temp/.x->1/x
]/;FreeQ[function,Global`k]&&FreeQ[x,Global`k]&&FreeQ[x0,Global`k]&&
   SameQ["k",ToString[Global`k]]

AsymptPowerSeries[function_,x_]:=Module[{},
If[SameQ["k",ToString[Global`k]],
Print["specfun-warning: Please unassign k with Clear[k] before using this function."]
  ];
HoldForm[AsymptPowerSeries[function,x]]
]/;!(FreeQ[function,Global`k]&&FreeQ[x,Global`k]&&FreeQ[x0,Global`k]&&
    SameQ["k",ToString[Global`k]])

(* SDE and FR *)
(* begin identity.m *)

Clear[DEOut,SumDE,DESum,ProductDE,DEProduct,PowerDE,DEPower]

CompositionDE[f___]:=DEComposition[f]

DEOut[de_,F_,x_]:=Module[{X,DE,delist,k,n},
	If[SameQ[Head[de],Equal],DE=Expand[de[[1]]-de[[2]]],DE=Expand[de]];
        DE=(DE /. F[x]->1);
        DE=(DE /. Derivative[n_][F][x]->X^n);
        delist=CoefficientList[DE,X];
        Sum[Factor[delist[[k]]] Derivative[k-1][F][x],
        {k,Length[delist],2,-1}]+Factor[delist[[1]]] F[x]==0
]

DEComposition[de1_,F_,x_,r_]:=Module[
	{order,j,xx,list,sol,de,fde,h},
	If[SameQ[Head[de1],Equal],fde=de1[[1]]-de1[[2]],fde=de1];
	order=DEOrder[fde,F,x];
	list=Table[D[h[x]==F[r],{x,j}],{j,0,order}];
	sol=Solve[list,Table[Derivative[j][F][r],{j,0,order}]];
	de=(fde /. x->r) /. sol[[1]];
	DEOut[Numerator[Together[de]],h,x]/.h->F
]

SumDE[f___]:=DESum[f]

DESum[de1_,de2_,F_[x_]]:=DESum[de1,de2,F,x]

DESum[de1_,de2_,F_,x_]:=Module[
	{i,jj,k,fde,flist,gde,glist,forder,gorder,frule,grule,done,
	delist,variab,variablist,solution,h,f,g},
        If[SpecialFunctionsPrintMessages, 
	Print["specfun-info: DESum entered"]];
	(* normalization of differential equations *)
        If[SameQ[Head[de1],Equal],fde=de1[[1]]-de1[[2]],fde=de1];
        If[SameQ[Head[de2],Equal],gde=de2[[1]]-de2[[2]],gde=de2];
        fde=(fde /. F[x]->1);
        fde=(fde /. Derivative[jj_][F][x]->X^jj);
        flist=CoefficientList[fde,X];
        fde=(fde /. X^(Length[flist]-1)->term);
        fde=Derivative[Length[flist]-1][f][x]==
        Sum[-Derivative[jj][f][x]*flist[[jj+1]]/flist[[Length[flist]]],
        {jj,0,Length[flist]-2}];
        fde=Map[Together,fde];
        gde=(gde /. F[x]->1);
        gde=(gde /. Derivative[jj_][F][x]->X^jj);
        glist=CoefficientList[gde,X];
        gde=(gde /. X^(Length[glist]-1)->term);
        gde=Derivative[Length[glist]-1][g][x]==
        Sum[-Derivative[jj][g][x]*glist[[jj+1]]/glist[[Length[glist]]],
        {jj,0,Length[glist]-2}];
        gde=Map[Together,gde];
        (* initial orders *)
        forder=DEOrder[fde,f,x];
        gorder=DEOrder[gde,g,x];
        (* generating replacements rules for derivatives of f *)
	frule={};
	Do[frule=Append[frule,fde /. Equal->Rule];
		fde=Map[Together,D[fde,x] //. frule]
	,{k,forder,forder+gorder}];
	(* generating replacements rules for derivatives of g *)
	grule={};
	Do[grule=Append[grule,gde /. Equal->Rule];
		gde=Map[Together,D[gde,x] //. grule]
	,{k,gorder,forder+gorder}];
	(* iterative search for DE of sum *)
	done=False;
	For[k=Max[forder,gorder],k<=forder+gorder && Not[done],k++,
		delist=Table[D[h[x]==f[x]+g[x],{x,jj}],{jj,0,k}];
		delist=(delist /. frule);
		delist=(delist /. grule);
		delist=MapAll[Together,delist];
		variab=Flatten[Union[
			Table[Derivative[i][f][x],{i,0,forder-1}],
			Table[Derivative[jj][g][x],{jj,0,gorder-1}]]];
		variablist=Table[variab[[jj]]->var[jj],{jj,1,Length[variab]}];
		delist=(delist /. variablist);
		delist=
		Table[delist[[jj,1]]-delist[[jj,2]],{jj,1,Length[delist]}];
		delist=Map[Together,delist];
		delist=Map[Numerator,delist];
		delist=(delist /.
		{Derivative[jj_][h][x]->H[jj],h[x]->H[0]});
		Off[Solve::svars];
		solution=Solve[delist==Table[0,{jj,1,Length[delist]}],
			Table[H[jj],{jj,0,Length[delist]-1}],
			Table[var[jj],{jj,1,Length[variab]}]];
		On[Solve::svars];
		If[Not[SameQ[solution,{{}}]],
			solution=Numerator[Together[
			solution[[1,1,1]]-solution[[1,1,2]]]];
			done=True]
	];
	solution=(solution /. {H[0]->F[x],H[jj_]->Derivative[jj][F][x]});
	DEOut[solution,F,x]
]

ProductDE[f___]:=DEProduct[f]

DEProduct[de1_,de2_,F_[x_]]:=DEProduct[de1,de2,F,x]

DEProduct[de1_,de2_,F_,x_]:=Module[
	{i,jj,k,fde,flist,gde,glist,forder,gorder,frule,grule,done,
	delist,variab,variablist,solution,h,f,g},
	If[SpecialFunctionsPrintMessages, 
	Print["specfun-info: DEProduct entered"]];
	(* normalization of differential equations *) 
	If[SameQ[Head[de1],Equal],fde=de1[[1]]-de1[[2]],fde=de1];
	If[SameQ[Head[de2],Equal],gde=de2[[1]]-de2[[2]],gde=de2];
	fde=(fde /. F[x]->1);
	fde=(fde /. Derivative[jj_][F][x]->X^jj);
	flist=CoefficientList[fde,X];
	fde=(fde /. X^(Length[flist]-1)->term);
	fde=Derivative[Length[flist]-1][f][x]==
	Sum[-Derivative[jj][f][x]*flist[[jj+1]]/flist[[Length[flist]]],
	{jj,0,Length[flist]-2}];
	fde=Map[Together,fde];
	gde=(gde /. F[x]->1);
	gde=(gde /. Derivative[jj_][F][x]->X^jj);
	glist=CoefficientList[gde,X];
	gde=(gde /. X^(Length[glist]-1)->term);
	gde=Derivative[Length[glist]-1][g][x]==
	Sum[-Derivative[jj][g][x]*glist[[jj+1]]/glist[[Length[glist]]],
	{jj,0,Length[glist]-2}];
	gde=Map[Together,gde];
	(* initial orders *)
	forder=DEOrder[fde,f,x];
	gorder=DEOrder[gde,g,x];
	(* generating replacements rules for derivatives of f *)
	frule={};
	Do[frule=Append[frule,fde /. Equal->Rule];
		fde=Map[Together,D[fde,x] //. frule]
	,{k,forder,forder*gorder}];
	grule={};
	(* generating replacements rules for derivatives of g *)
	grule={};
	Do[grule=Append[grule,gde /. Equal->Rule];
		gde=Map[Together,D[gde,x] //. grule]
	,{k,gorder,forder*gorder}];
	(* iterative search for DE of product *)
	done=False;
	For[k=Max[forder,gorder],k<=forder*gorder && Not[done],k++,
		delist=Table[D[h[x]==f[x]*g[x],{x,jj}],{jj,0,k}];
		delist=(delist /. frule);
		delist=(delist /. grule);
		delist=MapAll[Together,delist];
		variab=Flatten[Table[Derivative[i][f][x]*Derivative[jj][g][x],
		{i,0,forder-1},{jj,0,gorder-1}]];
		variablist=Table[variab[[jj]]->var[jj],{jj,1,Length[variab]}];
		delist=(delist /. variablist);
		delist=
		Table[delist[[jj,1]]-delist[[jj,2]],{jj,1,Length[delist]}];
		delist=Map[Together,delist];
		delist=Map[Numerator,delist];
		delist=(delist /.
		{Derivative[jj_][h][x]->H[jj],h[x]->H[0]});
		Off[Solve::svars];
		solution=Solve[delist==Table[0,{jj,1,Length[delist]}],
			Table[H[jj],{jj,0,Length[delist]-1}],
			Table[var[jj],{jj,1,Length[variab]}]];
		On[Solve::svars];
		If[Not[SameQ[solution,{{}}]],
			solution=Numerator[Together[
			solution[[1,1,1]]-solution[[1,1,2]]]];
			done=True]
	];
	solution=(solution /. {H[0]->F[x],H[jj_]->Derivative[jj][F][x]});
	DEOut[solution,F,x]
]

PowerDE[f___]:=DEPower[f]

DEPower[de_,F_,x_,1]:=de

DEPower[de_,F_,x_,n_]:=Module[{},
	DEProduct[DEPower[de,F,x,n-1],de,F,x]
] /; IntegerQ[n] && n>1 && OddQ[n]

DEPower[de_,F_,x_,n_]:=Module[{tmp},
	tmp=DEPower[de,F,x,n/2];
	DEProduct[tmp,tmp,F,x]
] /; IntegerQ[n] && n>1 && EvenQ[n]

Clear[SumRE,RESum,ProductRE,REProduct,PowerRE,REPower]

SumRE[f___]:=RESum[f]

RESum[de1_,de2_,F_[x_]]:=RESum[de1,de2,F,x]

RESum[re1_,re2_,A_,k_]:=Module[
	{i,jj,fre,flist,gre,glist,forder,gorder,frule,grule,done,
	relist,variab,variablist,solution,kk,c,numberlist,min,max,X,a,b},
        If[SpecialFunctionsPrintMessages, 
	Print["specfun-info: RESum entered"]];
	(* normalization of recurrence equations *)
        If[SameQ[Head[re1],Equal],fre=re1[[1]]-re1[[2]],fre=re1];
        If[SameQ[Head[re2],Equal],gre=re2[[1]]-re2[[2]],gre=re2];
	fre=Expand[fre];
	numberlist=Union[Map[Plus[#,-k]&,Cases[Cases[fre,A[k+_.],2],k+_.,2]]];
	min=Min[numberlist];
	max=Max[numberlist];
	fre=A[k+max]==Solve[fre==0,A[k+max]][[1,1,2]];
	fre=fre/.A->a;
	fre=(fre /. k->k-min);
        fre=Map[Together,fre];
	forder=max-min;
	gre=Expand[gre];
        numberlist=Union[Map[Plus[#,-k]&,Cases[Cases[gre,A[k+_.],2],k+_.,2]]];
        min=Min[numberlist];
        max=Max[numberlist];
        gre=A[k+max]==Solve[gre==0,A[k+max]][[1,1,2]];
        gre=gre/.A->b;
	gre=(gre /. k->k-min);
        gre=Map[Together,gre];
        gorder=max-min;
        (* generating replacements rules for shifts of f *)
	frule={};
	Do[frule=Append[frule,fre /. Equal->Rule];
		fre=Map[Together,(fre/.k->k+1) //. frule]
	,{jj,forder,forder+gorder}];
	(* generating replacements rules for shifts of g *)
	grule={};
	Do[grule=Append[grule,gre /. Equal->Rule];
		gre=Map[Together,(gre/.k->k+1) //. grule]
	,{jj,gorder,forder+gorder}];
	(* iterative search for RE of sum *)
	done=False;
	For[kk=Max[forder,gorder],kk<=forder+gorder && Not[done],kk++,
		relist=Table[c[k+jj]==a[k+jj]+b[k+jj],{jj,0,kk}];
		relist=(relist /. frule);
                relist=(relist /. grule);
                variab=Flatten[Union[
                        Table[a[k+i],{i,0,forder-1}],
                        Table[b[k+jj],{jj,0,gorder-1}]]];
		variablist=Table[variab[[jj]]->var[jj],{jj,1,Length[variab]}];
		relist=(relist /. variablist);
		relist=
		Table[relist[[jj,1]]-relist[[jj,2]],{jj,1,Length[relist]}];
		relist=Map[Together,relist];
		relist=Map[Numerator,relist];
		relist=(relist /. c[k+jj_.]->H[jj]);
		Off[Solve::svars];
		solution=Solve[relist==Table[0,{jj,1,Length[relist]}],
			Table[H[jj],{jj,0,Length[relist]-1}],
			Table[var[jj],{jj,1,Length[variab]}]];
		On[Solve::svars];
		If[Not[SameQ[solution,{{}}]],
			solution=Numerator[Together[
			solution[[1,1,1]]-solution[[1,1,2]]]];
			done=True]
	];
	solution=(solution /. H[jj_]->X^jj);
	solution=CoefficientList[solution,X];
	solution=Map[Factor,solution];
	solution=Sum[solution[[jj]] A[k-1+jj],{jj,1,Length[solution]}]==0
]

ProductRE[f___]:=REProduct[f]

REProduct[de1_,de2_,F_[x_]]:=REProduct[de1,de2,F,x]

REProduct[re1_,re2_,A_,k_]:=Module[
	{i,jj,fre,flist,gre,glist,forder,gorder,frule,grule,done,
	relist,variab,variablist,solution,kk,c,numberlist,min,max,X,a,b},
        If[SpecialFunctionsPrintMessages, 
	Print["specfun-info: REProduct entered"]];
	(* normalization of recurrence equations *)
        If[SameQ[Head[re1],Equal],fre=re1[[1]]-re1[[2]],fre=re1];
        If[SameQ[Head[re2],Equal],gre=re2[[1]]-re2[[2]],gre=re2];
	fre=Expand[fre];
	numberlist=Union[Map[Plus[#,-k]&,Cases[Cases[fre,A[k+_.],2],k+_.,2]]];
	min=Min[numberlist];
	max=Max[numberlist];
	fre=A[k+max]==Solve[fre==0,A[k+max]][[1,1,2]];
	fre=fre/.A->a;
	fre=(fre /. k->k-min);
        fre=Map[Together,fre];
	forder=max-min;
	gre=Expand[gre];
        numberlist=Union[Map[Plus[#,-k]&,Cases[Cases[gre,A[k+_.],2],k+_.,2]]];
        min=Min[numberlist];
        max=Max[numberlist];
        gre=A[k+max]==Solve[gre==0,A[k+max]][[1,1,2]];
        gre=gre/.A->b;
	gre=(gre /. k->k-min);
        gre=Map[Together,gre];
        gorder=max-min;
        (* generating replacements rules for shifts of f *)
	frule={};
	Do[frule=Append[frule,fre /. Equal->Rule];
		fre=Map[Together,(fre/.k->k+1) //. frule]
	,{jj,forder,forder*gorder}];
	(* generating replacements rules for shifts of g *)
	grule={};
	Do[grule=Append[grule,gre /. Equal->Rule];
		gre=Map[Together,(gre/.k->k+1) //. grule]
	,{jj,gorder,forder*gorder}];
	(* iterative search for RE of product *)
	done=False;
	For[kk=Max[forder,gorder],kk<=forder*gorder && Not[done],kk++,
		relist=Table[c[k+jj]==a[k+jj]*b[k+jj],{jj,0,kk}];
		relist=(relist /. frule);
                relist=(relist /. grule);
                relist=MapAll[Expand,relist];
		variab=Flatten[Table[a[k+i]*b[k+jj],
		{i,0,forder-1},{jj,0,gorder-1}]];
		variablist=Table[variab[[jj]]->var[jj],{jj,1,Length[variab]}];
		relist=(relist /. variablist);
		relist=
		Table[relist[[jj,1]]-relist[[jj,2]],{jj,1,Length[relist]}];
		relist=Map[Together,relist];
		relist=Map[Numerator,relist];
		relist=(relist /. c[k+jj_.]->H[jj]);
		Off[Solve::svars];
		solution=Solve[relist==Table[0,{jj,1,Length[relist]}],
			Table[H[jj],{jj,0,Length[relist]-1}],
			Table[var[jj],{jj,1,Length[variab]}]];
		On[Solve::svars];
		If[Not[SameQ[solution,{{}}]],
			solution=Numerator[Together[
			solution[[1,1,1]]-solution[[1,1,2]]]];
			done=True]
	];
	solution=(solution /. H[jj_]->X^jj);
	solution=CoefficientList[solution,X];
	solution=Map[Factor,solution];
	solution=Sum[solution[[jj]] A[k-1+jj],{jj,1,Length[solution]}]==0
]

PowerRE[f___]:=REPower[f]

REPower[re_,A_,k_,1]:=re

REPower[re_,A_,k_,n_]:=Module[{},
        REProduct[REPower[re,A,k,n-1],re,A,k]
] /; IntegerQ[n] && n>1 && OddQ[n]

REPower[re_,A_,k_,n_]:=Module[{tmp},
        tmp=REPower[re,A,k,n/2];
        REProduct[tmp,tmp,A,k]
] /; IntegerQ[n] && n>1 && EvenQ[n]

Clear[theta,backsubst]

theta[f_,x_]:=x D[f,x]

backsubst[eq1_+eq2_,n_,f_,x_]:=backsubst[eq1,n,f,x]+backsubst[eq2,n,f,x]
backsubst[c_*eq_,n_,f_,x_]:=c*backsubst[eq,n,f,x] /;
        (FreeQ[c,n] && FreeQ[c,f] && FreeQ[c,x])

backsubst[a_[n_+m_.],n_,f_,x_]:=f[x]/x^m
backsubst[n_^j_.*a_[n_+m_.],n_,f_,x_]:=theta[backsubst[n^(j-1)*a[n+m],n,f,x],x]
backsubst[p_*a_[n_+m_.],n_,f_,x_]:=
backsubst[Expand[p*a[n+m]],n,f,x] /;
        PolynomialQ[p,n]

(* Fri Apr 29 10:29:04 MET DST 1994
Unprotect[REtoDE]

Clear[REtoDE]

REtoDE[f_,a_,k_,F_,x_]:=RETODE[f,a,k,F,x]
REtoDE[f_,a_,k_]:= RETODE[f,a,k,F,x]
*)

RETODE[re_,a_,k_]:=RETODE[re,a,k,Global`f,Global`x]

RETODE[re_,a_,k_,F_,x_]:=Module[
  {recursion,containsk,recursionfactor,recursionpart,jj,de,n},
  If[SameQ[Head[re],Equal],recursion=re[[1]]-re[[2]],recursion=re];
  recursion = Collect[recursion,a[k]];
  (*
  recursionfactor=1;
  Do[
  recursionpart[jj]=(recursion[[jj]]/(recursion[[jj]] /. a[anything_]->1))[[1]];
  containsk[jj]=recursionpart[jj]
  ,
  {jj,2,Length[recursion]}];
  recursionfactor=Product[containsk[jj],{jj,2,Length[recursion]}];
  recursion=Collect[recursion*recursionfactor,a[k]];
  *)
  de = backsubst[(recursion/.k->n),n,F,x];
  de = Numerator[Together[de]];
  While[NumberQ[Denominator[Together[de/x]]],de= Expand[de/x]];
  DEOut[de,F,x]
]

Clear[SymbolicSumDE,SymbolicSumRE,ConvolutionRE]

(* SymbolicSumRE[a,k,n] gibt eine RE fuer Sum[b[k],{k,0,n}] aus *)

SymbolicSumRE[b_,k_,n_,a_]:=Module[
	{re,de1,de2,de,x},
	re=FindRecursion[b,k,a];
	de1=RETODE[re,a,k,F,x];
	de2=F[x]+(-1+x)*F'[x]; (* SimpleDE[1/(1-z),z] *)
	de=DEProduct[de1,de2,F,x];
	re=DEtoRE[de,F,x,a,n]
]

ConvolutionRE[b_,c_,a_[k_],n_]:=ConvolutionRE[b,c,k,n,a]

ConvolutionRE[b_,c_,k_,n_,a_]:=Module[
        {G,x,rec1,rec2,de1,de2,de},
        rec1=FindRecursion[b,k,a];
        rec2=FindRecursion[c,k,a];
        de1=REtoDE[rec1,a,k,F,x];
        de2=REtoDE[rec2,a,k,F,x];
        de=DEProduct[de1,de2,F,x];
        DEtoRE[de,F,x,a,n]
]

ConvolutionRE[b_,c_,k_,n_]:=ConvolutionRESum[b,c,k,n,a]

Clear[VerifyDE,SymbolicDerivativeRE,RationalQ,VerifyIdentity,RodriguesDE]

Off[General::spell1]

RationalQ[f_,x_]:=Module[{fac},
fac:=Factor[f];
PolynomialQ[Numerator[fac],x] && PolynomialQ[Denominator[fac],x]
]

On[General::spell1]

SymbolicDerivativeRE[re_,a_,k_,n_]:=SymbolicDerivativeRE[re,a,k,n,a]

SymbolicDerivativeRE[re_,a_,k_,n_,c_]:=Module[
	{re1,nn,mfold,REPRODSUM,newreprodsum,new,EQ},
	If[SameQ[Head[re],Equal],re1=(Expand[re[[1]]-re[[2]]] /. k->nn),
	re1=(Expand[re] /. k->nn)];
	(* hypergeometric type ? *)
	If[Not[Length[Union[Cases[re1,a[nn_],2]]]==2],
		Print[f," is not of hypergeometric type"];Null,
		(* else *)
		(*sol=Solve re1,*)
    	        mfold=Max[(Cases[re1,a[nn_],3] /. a[nn_]->nn)-nn];
                re1=a[nn+mfold]==Solve[re1==0,a[nn+mfold]][[1,1,2]];
                REPRODSUM=Simplify[re1[[2]]/a[nn]];
                newreprodsum=REPRODSUM /. nn->nn+n;
                new=Together[Simplify[Pochhammer[nn+n+1,mfold]/
                Pochhammer[nn+1,mfold]*newreprodsum]];
                num=Numerator[new];
                den=Denominator[new];
                EQ=den*c[nn+mfold]-num*c[nn];
	        (EQ==0 /. nn->k)
	]
]

RodriguesDE[f_,x_,n_,F_]:=Module[
        {de1,re1,re2,de2,c,k,a},
        de1=SDE[f,x,F];
        re1=DEtoRE[de1,F,x,a,k];
        If[Not[Length[Union[Cases[re1[[1]],a[nn_],2]]]==2],
                Print[f," is not of hypergeometric type"];
                de2=HoldForm[RodriguesDE[f,x,n]],
                (* else *)
                re2=SymbolicDerivativeRE[re1,a,k,n,c];
                de2=DEOut[RETODE[re2,c,k,F,x],F,x]
        ];
        de2
]

Clear[HypergeometricDR, HypergeometricRE, HypergeometricDE]

HypergeometricDR[P_,Q_,x_,n_]:=Module[
        {var,subst},
        If[FreeQ[P,n]&&FreeQ[Q,n],Return[]];
        If[Not[FreeQ[P,n]]&&Not[FreeQ[Q,n]],Return[]];
        If[Not[FreeQ[Q,n]],var=n-1;subst=n-1];
        If[Not[FreeQ[P,n]],var=n;subst=n+1];
        Derivative[1][pFq[P,Q,x]]==
        var/x*pFq[P/.n->subst,Q/.n->subst,x]-var/x*pFq[P,Q,x]
] /; SameQ[Head[n],Symbol]

HypergeometricRE[P_,Q_,x_]:=HypergeometricRE[P,Q,x,P[[1]]]

HypergeometricRE[P_,Q_,x_,n_]:=HypergeometricRE[P,Q,x,n,a]

HypergeometricRE[P_,Q_,x_,n_,a_]:=Module[
	{DE,DEList,RE,t,th,plist,qlist,max,result,avar,bvar,
	y,nn,xxx,jj,num,den,len},
	plist=P;
	qlist=Q;
        DE=Expand[t*Product[t+qlist[[j]]-1,{j,1,Length[qlist]}]-
        x*Product[t+plist[[j]],{j,1,Length[plist]}]];
        DEList=CoefficientList[DE,t];
        If[Not[FreeQ[P,n]],
	max=Max[Length[plist],Length[qlist]+1];
	th[F[avar_, y_]]:=-avar*F[avar, y]+avar*F[1 + avar, y];
        th[avar_*bvar_]:=avar*th[bvar] /; FreeQ[avar,y];
        th[avar_+bvar_]:=th[avar]+th[bvar]
	];
        If[Not[FreeQ[Q,n]],
	max=0;
	th[F[avar_, y_]]:=-(avar-1)*F[avar, y]+(avar-1)*F[avar-1, y];
	th[avar_*bvar_]:=avar*th[bvar] /; FreeQ[avar,y];
	th[avar_+bvar_]:=th[avar]+th[bvar]
	];
	If[FreeQ[P,n]&&FreeQ[Q,n],Return[]];
	If[Not[FreeQ[P,n]]&&Not[FreeQ[Q,n]],Return[]];
	RE=Sum[DEList[[j]] Nest[th[#]&,F[n,x],j-1],{j,1,Length[DEList]}];
	RESULT=result=
	Map[Simplify,Solve[RE==0,F[n+max,x]][[1,1]] /. {Rule->Equal}];
	len=Min[Map[#[[1]]-n&,Cases[{result[[2]]},F[nn_,xxx_],Infinity]]];
        result=result /. F[nn_,xxx_]->X^(nn-n-len);
	result=Map[Together,result];
        num=CoefficientList[Numerator[result[[2]]],X];
        den=Factor[Denominator[result[[2]]]];
	(*
	pFq[P,Q,x]==
	Sum[Factor[num[[jj]]/den]*
	pFq[P/.n->jj+n+len-1,Q/.n->jj+n+len-1,x],{jj,1,Length[num]}]
	*)
	Factor[den/.n->n-len]*a[n+max-len]+
	Sum[Factor[-num[[jj]]/.n->n-len]*
	a[jj+n-1],{jj,1,Length[num]}] == 0
] /; SameQ[Head[n],Symbol]

theta[f_,x_]:=x D[f,x]

HypergeometricDE[P_,Q_,x_]:=HypergeometricDE[P,Q,x,F]

HypergeometricDE[P_,Q_,x_,F_]:=Module[
	{plist,qlist,n,DE,DEList},
	plist=P;
	qlist=Q;
	DE=Expand[t*Product[t+qlist[[j]]-1,{j,1,Length[qlist]}]-
        x*Product[t+plist[[j]],{j,1,Length[plist]}]];
	DEList=CoefficientList[DE,t];
	DEOut[
	Sum[DEList[[j]] Nest[theta[#,x]&,F[x],j-1]/x,{j,1,Length[DEList]}],
	F,x]
]

(* Here we define SimpleDE new by descent *)

Clear[SDE]

SDE[f_,x_]:=SDE[f,x,F]

(* constants *)
SDE[a_,x_,F_]:=F'[x] == 0 /; FreeQ[a,x]

(* elementary functions *)

SDE[x_^n_,x_,F_]:=-(n F[x]) + x F'[x] == 0 /; FreeQ[n,x]

SDE[r_,x_,F_]:=Module[{p,q,tmp,X,coefflist},
	tmp=Together[r];
	p=Numerator[tmp];
	q=Denominator[tmp];
	tmp=(D[p,x]/p-D[q,x]/q) -X;
	tmp=Numerator[Together[tmp]];
	coefflist=Factor[CoefficientList[tmp,X]];
	coefflist[[1]] F[x] + coefflist[[2]] F'[x] == 0
] /; RationalQ[r,x]

SDE[a_^x_,x_,F_]:=-(F[x] Log[a]) + F'[x] == 0 /; FreeQ[a,x]

SDE[Log[x_],x_,F_]:=F'[x] + x F''[x] == 0

SDE[Sin[x_],x_,F_]:=F[x] + F''[x] == 0

SDE[Cos[x_],x_,F_]:=F[x] + F''[x] == 0

SDE[ArcSin[x_],x_,F_]:=x F'[x] + (-1 + x^2) F''[x] == 0

SDE[ArcCos[x_],x_,F_]:=x F'[x] + (-1 + x^2) F''[x] == 0

SDE[ArcTan[x_],x_,F_]:=2 x F'[x] + (1 + x^2) F''[x] == 0

SDE[ArcCot[x_],x_,F_]:=2 x F'[x] + (1 + x^2) F''[x] == 0

SDE[Sinh[x_],x_,F_]:=-F[x] + F''[x] == 0

SDE[Cosh[x_],x_,F_]:=-F[x] + F''[x] == 0

SDE[ArcSinh[x_],x_,F_]:=x F'[x] + (1 + x^2) F''[x] == 0

SDE[ArcCosh[x_],x_,F_]:=x F'[x] + (-1 + x^2) F''[x] == 0

SDE[ArcTanh[x_],x_,F_]:=2 x F'[x] + (-1 + x^2) F''[x] == 0

SDE[ArcCoth[x_],x_,F_]:=2 x F'[x] + (-1 + x ^2) F''[x] == 0

SDE[Erf[x_],x_,F_]:=2 x F'[x] + F''[x] == 0

SDE[Erfc[x_],x_,F_]:=2 x F'[x] + F''[x] == 0

SDE[ExpIntegralEi[x_],x_,F_]:=(1 - x) F'[x] + x F''[x] == 0

SDE[SinIntegral[x_],x_,F_]:=x F'[x] + 2 F''[x] + x F'''[x]

SDE[CosIntegral[x_],x_,F_]:=x F'[x] + 2 F''[x] + x F'''[x] == 0

SDE[AiryAi[x_],x_,F_]:=-(x F[x]) + F''[x] == 0

SDE[AiryAiPrime[x_],x_,F_]:=
-2*F[x] - x*Derivative[1][F][x] + Derivative[3][F][x] == 0

SDE[AiryBi[x_],x_,F_]:=-(x F[x]) + F''[x] == 0

SDE[AiryBiPrime[x_],x_,F_]:=
-2*F[x] - x*Derivative[1][F][x] + Derivative[3][F][x] == 0

(* special functions *)
SDE[ExpIntegralE[n_,x_],x_,F_]:=
(1 - n) F[x] + (2 - n + x) F'[x] + x F''[x] == 0 /; FreeQ[n,x]

SDE[Gamma[n_,x_],x_,F_]:=(1 - n + x) F'[x] + x F''[x] == 0 /; FreeQ[n,x]

SDE[Erfc[n_,x_],x_,F_]:=-2 n F[x] + 2 x F'[x] + F''[x] == 0 /; FreeQ[n,x]

SDE[BesselJ[n_,x_],x_,F_]:=(-n^2 + x^2) F[x] + x F'[x] + x^2 F''[x] == 0 /;
FreeQ[n,x]

SDE[BesselY[n_,x_],x_,F_]:=(-n^2 + x^2) F[x] + x F'[x] + x^2 F''[x] == 0 /;
FreeQ[n,x]

SDE[BesselI[n_,x_],x_,F_]:=(-n^2 - x^2) F[x] + x F'[x] + x^2 F''[x] == 0 /;
FreeQ[n,x]

SDE[BesselK[n_,x_],x_,F_]:=(-n^2 - x^2) F[x] + x F'[x] + x^2 F''[x] == 0 /;
FreeQ[n,x]

SDE[Hankel1[n_,x_],x_,F_]:=
(-n^2 + x^2) F[x] + x F'[x] + x^2 F''[x] == 0 /; FreeQ[n,x]

SDE[Hankel2[n_,x_],x_,F_]:=
(-n^2 + x^2) F[x] + x F'[x] + x^2 F''[x] == 0 /; FreeQ[n,x]

SDE[KummerM[n_,m_,x_],x_,F_]:=
-(n F[x]) + (m - x) F'[x] + x F''[x] == 0 /; FreeQ[n,x] && FreeQ[m,x]

SDE[KummerU[n_,m_,x_],x_,F_]:=
-(n F[x]) + (m - x) F'[x] + x F''[x] == 0 /; FreeQ[n,x] && FreeQ[m,x]

SDE[WhittakerM[n_,m_,x_],x_,F_]:=
(1 - 4 m^2 + 4 n x - x^2) F[x] + 4 x^2 F''[x] == 0 /; FreeQ[n,x] && FreeQ[m,x]

SDE[WhittakerW[n_,m_,x_],x_,F_]:=
(1 - 4 m^2 + 4 n x - x^2) F[x] + 4 x^2 F''[x] == 0 /; FreeQ[n,x] && FreeQ[m,x]

SDE[LegendreP[a_,b_,x_],x_,F_]:=(a + a^2 - b^2 - a x^2 - a^2 x^2) F[x] +
2 x (-1 + x^2) F'[x] + (-1 + x^2)^2 F''[x] == 0 /; FreeQ[a,x] && FreeQ[b,x]

SDE[LegendreQ[a_,b_,x_],x_,F_]:=(a + a^2 - b^2 - a x^2 - a^2 x^2) F[x] +
2 x (-1 + x^2) F'[x] + (-1 + x^2)^2 F''[x] == 0 /; FreeQ[a,x] && FreeQ[b,x]

SDE[JacobiP[n_,a_,b_,x_],x_,F_]:=n (n + a + b + 1) F[x] +
(b - a - (a + b + 2) x) F'[x] + (1 - x^2) F''[x] == 0 /; FreeQ[n,x] &&
FreeQ[a,x] && FreeQ[b,x]

SDE[GegenbauerC[n_,0,x_],x_,F_]:= SDE[ChebyshevT[n,x],x,F] /; FreeQ[n,x]

SDE[GegenbauerC[n_,a_,x_],x_,F_]:=
(-2 a n - n^2) F[x] + (x + 2 a x) F'[x] + (-1 + x^2) F''[x] == 0 /;
FreeQ[n,x] && FreeQ[a,x]

SDE[ChebyshevT[n_,x_],x_,F_]:=
-(n^2 F[x]) + x F'[x] + (-1 + x^2) F''[x] == 0 /; FreeQ[n,x]

SDE[ChebyshevU[n_,x_],x_,F_]:=
(-2 n - n^2) F[x] + 3 x F'[x] + (-1 + x^2) F''[x] == 0 /; FreeQ[n,x]

SDE[LegendreP[n_,x_],x_,F_]:=
(-n - n^2) F[x] + 2 x F'[x] + (-1 + x^2) F''[x] == 0 /; FreeQ[n,x]

SDE[LaguerreL[n_,a_,x_],x_,F_]:=n F[x] + (1 + a - x) F'[x] + x F''[x] == 0 /;
FreeQ[n,x] && FreeQ[a,x]

SDE[LaguerreL[n_,x_],x_,F_]:=n F[x] + (1 - x) F'[x] + x F''[x] == 0 /;
FreeQ[n,x]

SDE[HermiteH[n_,x_],x_,F_]:=2 n F[x] - 2 x F'[x] + F''[x] == 0 /; FreeQ[n,x]

SDE[EllipticK[x_],x_,F_]:=-F[x] + 4 (1 - 2 x) F'[x] + 4 (1 - x) x F''[x] == 0

SDE[EllipticE[x_],x_,F_]:=F[x] + 4 (1 - x) F'[x] + 4 (1 - x) x F''[x] == 0

SDE[Hypergeometric0F1[a_,x_],x_,F_]:=F[x] - a F'[x] - x F''[x] == 0 /;
FreeQ[a,x]

SDE[Hypergeometric1F0[a_,x_],x_,F_]:=a F[x] + (-1 + x) F'[x] == 0 /;
FreeQ[a,x]

SDE[HypergeometricU[a_,b_,x_],x_,F_]:=
-(a F[x]) + (b - x) F'[x] + x F''[x] == 0 /; FreeQ[a,x] && FreeQ[b,x]

SDE[Hypergeometric1F1[a_,b_,x_],x_,F_]:=
-(a F[x]) + (b - x) F'[x] + x F''[x] == 0 /; FreeQ[a,x] && FreeQ[b,x]

SDE[Hypergeometric2F0[a_,b_,x_],x_,F_]:=
-(a b F[x]) + (1 - x - a x - b x) F'[x] - x^2 F''[x] == 0 /; 
FreeQ[a,x] && FreeQ[b,x]

SDE[Hypergeometric2F1[a_,b_,c_,x_],x_,F_]:=
-(a b F[x]) + (c - x - a x - b x) F'[x] + (1 - x) x F''[x] == 0 /;
FreeQ[a,x] && FreeQ[b,x] && FreeQ[c,x]

SDE[Hypergeometric3F2[a_,b_,c_,d_,e_,x_],x_,F_]:=-(a b c F[x]) + 
(d e - x - a x - b x - a b x - c x - a c x - b c x) F'[x] + 
x (1 + d + e - 3 x - a x - b x - c x) F''[x] + (1 - x) x^2 F'''[x] == 0 /;
FreeQ[a,x] && FreeQ[b,x] && FreeQ[c,x] && FreeQ[d,x] && FreeQ[e,x]

SDE[Hypergeometric2F3[a_,b_,c_,d_,e_,x_],x_,F_]:=-(a b F[x]) +
(c d e - x - a x - b x) F'[x] + (1 + c + d + c d + e + c e + d e - x) x F''[x] +
(3 + c + d + e) x^2 F'''[x] + x^3 F''''[x] == 0 /;
FreeQ[a,x] && FreeQ[b,x] && FreeQ[c,x] && FreeQ[d,x] && FreeQ[e,x]

SDE[HypergeometricPFQ[P_,Q_,x_],x_,F_]:=Module[
	{plist,qlist,n,DE,DEList},
	plist=P;
	qlist=Q;
	DE=Expand[t*Product[t+qlist[[j]]-1,{j,1,Length[qlist]}]-
        x*Product[t+plist[[j]],{j,1,Length[plist]}]];
	DEList=CoefficientList[DE,t];
	DEOut[
	Sum[DEList[[j]] Nest[theta[#,x]&,F[x],j-1]/x,{j,1,Length[DEList]}],
	F,x]
] /; FreeQ[P,x] && FreeQ[Q,x]

SDE[StruveH[n_,x_],x_,F_]:=(n^2 + n^3 + x^2 - n x^2) F[x] + 
x (-n - n^2 + x^2) F'[x] + (2 - n) x^2 F''[x] + x^3 F'''[x] == 0 /;
FreeQ[n,x]

SDE[StruveL[n_,x_],x_,F_]:=(3 n^2 - n^3 + x^2 - n x^2) F[x] + 
x (-2 + n - n^2  - x^2) F'[x] + n x^2 F''[x] + x^3 F'''[x] == 0 /;
FreeQ[n,x]

SDE[Ai[n_,x_],x_,F_]:=
(-1 - n) F[x] - x F'[x] + F'''[x] == 0 /; FreeQ[n,x]

SDE[Abramowitz[n_,x_],x_,F_]:=2 F[x] + (1 - n) F''[x] + x F'''[x] == 0 /;
FreeQ[n,x]

SDE[NormalIntegral[n_,x_],x_,F_]:=-(n F[x]) + x F'[x] + F''[x] == 0 /;
FreeQ[n,x]

SDE[KnuthA[n_,x_],x_,F_]:=(-2 + 7 n - n^2 - x^3 + 2 n x^3) F[x] +
(6 x + 4 n x + 2 x^4) F'[x] + 8 x^2 F''[x] + 8 F'''[x] == 0 /; FreeQ[n,x]

SDE[KnuthB[n_,x_],x_,F_]:=
(-10 + 7 n - n^2) F[x] + (-18 x + 4 n x) F'[x] - 
4 x^2 F''[x] + 8 F'''[x] == 0 /; FreeQ[n,x]

SDE[ParabolicU[n_,x_],x_,F_]:=(-4 n - x^2) F[x] + 4 F''[x] == 0 /;
FreeQ[n,x]

SDE[ParabolicD[n_,x_],x_,F_]:=(2 + 4 n - x^2) F[x] + 4 F''[x] == 0 /;
FreeQ[n,x]

SDE[ParabolicV[n_,x_],x_,F_]:=(-4 n - x^2) F[x] + 4 F''[x] == 0 /;
FreeQ[n,x]

SDE[Bateman[n_,x_],x_,F_]:=(2 n - x) F[x] + x F''[x] == 0 /; FreeQ[n,x]

SDE[Krawtchouk[n_,N_,p_,x_],p_,F_]:=
n (-1 + n - N) F[p] + (-1 + n + 2 p - 2 n p + N p - x) F'[p] +
(-1 + p) p F''[p] == 0 /; FreeQ[n,p] && FreeQ[N,p] && FreeQ[x,p]

SDE[Charlier[n_,mu_,x_],mu_,F_]:=-(n x F[mu]) + mu (-1 + mu - n - x) F'[mu] - 
mu^2 F''[mu] == 0 /; FreeQ[n,mu] && FreeQ[x,mu]

SDE[Meixner[n_,gamma_,mu_,x_],mu_,F_]:=-(n x F[mu]) + mu (-1 + mu +
gamma mu - n + mu n - x + mu x) F'[mu] + (-1 + mu) mu^2 F''[mu] == 0 /;
FreeQ[n,mu] && FreeQ[x,mu] && FreeQ[gamma,mu]

SDE[DiscreteLaguerre[n_,rho_,alpha_,x_],rho_,F_]:=
n (alpha + x) F[rho] + (-n - rho - alpha rho + n rho + x - rho x) F'[rho] + 
(1 - rho) rho F''[rho] == 0 /; FreeQ[n,rho] && FreeQ[alpha,rho] && FreeQ[x,rho]

(* descent programming *)

(* Rodrigues type *)
SDE[Derivative[n_][f_][x_],x_,F_]:=RodriguesDE[f[x],x,n,F]

SDE[Derivative[0,n_][f_][a_,x_],x_,F_]:=RodriguesDE[f[a,x],x,n,F]

SDE[D[f_,{x_,n_}],x_,F_]:=RodriguesDE[f,x,n,F]

SDE[Derivative[null1___,n_,null2___][f_][a___,y_,b___],x_,F_]:=
RodriguesDE[f[a,y,b],x,n,F] /;
Module[{null1list,null2list,kkkk},
Off[ReplaceAll::argr];
Off[ReplaceAll::argrx];
FreeQ[{a},x] && FreeQ[{b},x] &&
SameQ[null1list={null1},Table[0,{kkkk,1,Length[null1list]}]] &&
SameQ[null2list={null2},Table[0,{kkkk,1,Length[null2list]}]]
]

(* power series type *)
SDE[Global`sum[expr_.*x_^k_,{k_,0,Infinity}],x_,F_]:=
SumtoDE[Global`sum[expr*x^k,{k,0,Infinity}],x,F]

(*
SDE[Global`sum[expr_.*x_^(m_.k_+b_.),{k_,0,Infinity}],x_,F_]:=Module[
	{comp},
	comp=DEComposition[SumtoDE[Global`sum[expr*x^k,{k,0,Infinity}],x,F],F,x,x^m];
	DEProduct[comp,SDE[x^b,x,F],F,x]
] /; IntegerQ[m]
*)

(*
SimpleDE[Sum[1/k! x^k,{k,0,Infinity}],x,F]
SimpleDE[Sum[1/k! x^k,{k,1,Infinity}],x,F]

SimpleDE[D[JacobiP[n,a,b,1-1/x],{x,k}],x,F]

Beachte: 
SimpleDE[Sum[1/k! x^k,{k,-1,Infinity}],x,F]
ist KEIN vernuenftiger Input !

*)

(* infinity sums *)
SDE[Global`sum[expr_.*r_^(m_.k_+b_.),{k_,0,Infinity}],x_,F_]:=Module[
	{comp},
	comp=DEComposition[SumtoDE[
	Global`sum[expr*x^k,{k,0,Infinity}],x,F],F,x,r^m];
        DEProduct[comp,SDE[r^b,x,F],F,x]
] /; IntegerQ[m] && RationalQ[r,x]

SDE[Global`sum[expr_.*r_^(m_.k_+b_.),{k_,k0_,Infinity}],x_,F_]:=Module[{tmp},
	tmp=(expr/.k->k+k0);	
	SDE[r^(m*k0+b)*Global`sum[tmp*r^(m*k),{k,0,Infinity}],x,F]
] /; IntegerQ[m] && RationalQ[r,x] && IntegerQ[k0] && Not[SameQ[k0,0]]

(* voruebergehend *)
(*
SDE[Sum[expr_.*r_^(m_.k_+b_.),{k_,k0_,Infinity}],x_,F_]:=
SDE[Sum[expr*r^(m k+b),{k,0,Infinity}]-
Sum[expr*r^(m k+b),{k,0,k0-1}],x,F] /; IntegerQ[m] && RationalQ[r,x] &&
IntegerQ[k0] && k0>=1
*)

(* sum algorithm *)
(* old
SDE[f_+g_,x_,F_]:=SumDE[SDE[f,x,F],SDE[g,x,F],F,x]
*)

SDE[f_+g_,x_,F_]:=Module[{fde,gde,result},
        fde=SDE[f,x,F];
        gde=SDE[g,x,F];
        If[Not[SameQ[Head[fde],HoldForm] || SameQ[Head[gde],HoldForm] ||
                SameQ[Head[fde],SDE] || SameQ[Head[gde],SDE]],
        result=SumDE[fde,gde,F,x],
        result=HoldForm[SDE[f+g,x,F]]];
        result
]

(* linearity *)
SDE[a_*f_,x_,F_]:=SDE[f,x,F] /; FreeQ[a,f] && FreeQ[a,x]

(* product algorithm *)
(* old
SDE[f_*g_,x_,F_]:=ProductDE[SDE[f,x,F],SDE[g,x,F],F,x]
*)

SDE[f_*g_,x_,F_]:=Module[{fde,gde,result},
        fde=SDE[f,x,F];
        gde=SDE[g,x,F];
        If[Not[SameQ[Head[fde],HoldForm] || SameQ[Head[gde],HoldForm] ||
                SameQ[Head[fde],SDE] || SameQ[Head[gde],SDE]],
        result=ProductDE[fde,gde,F,x],
        result=HoldForm[SDE[f*g,x,F]]];
        result
]

(* iterative products *)
SDE[f_^n_,x_,F_]:=PowerDE[SDE[f,x,F],F,x,n] /; IntegerQ[n] && n>0

(* composition algorithm *)

(* composition with rational functions *)
SDE[f_^r_,x_,F_]:=CompositionDE[SDE[f^x,x,F],F,x,r] /;
Not[FreeQ[r,x]] && RationalQ[r,x] && Not[SameQ[r,x]]

SDE[f_[a___,r_,b___],x_,F_]:=CompositionDE[SDE[f[a,x,b],x,F],F,x,r] /; 
Not[FreeQ[r,x]] && RationalQ[r,x] && Not[SameQ[r,x]] 

(* other compositions *)
SDE[f_[a___,r_,b___],x_,F_]:=simpleDE[f[a,r,b],x,5,F] /;
Not[FreeQ[r,x]] && Not[RationalQ[r,x]]

SDE[f_^r_,x_,F_]:=simpleDE[f^r,x,5,F] /;
Not[FreeQ[r,x]] && Not[RationalQ[r,x]]

(* derivatives and antiderivatives *)
SDE[Integrate[f_,x_],x_,F_]:=Module[{tmp},
	tmp=SDE[f,x,F];
	tmp=tmp /. Derivative[n_][F][x]->Derivative[n+1][F][x];
	tmp=tmp /. F[x]->F'[x]
]

SDE[Integrate[f_,{t_,a_,x_}],x_,F_]:=Module[{tmp},
	tmp=SDE[f,t,F]/.t->x;
	tmp=tmp /. Derivative[n_][F][x]->Derivative[n+1][F][x];
	tmp=tmp /. F[x]->F'[x]
] /; FreeQ[a,x] && FreeQ[a,t]

SDE[Integrate[f_,{t_,x_,b_}],x_,F_]:=Module[{tmp},
	tmp=SDE[f,t,F]/.t->x;
	tmp=tmp /. Derivative[n_][F][x]->Derivative[n+1][F][x];
	tmp=tmp /. F[x]->F'[x]
] /; FreeQ[b,x] && FreeQ[b,t]

SDE[f___]:=HoldForm[HolonomicDE[f]];

SimpleDE[expr_,f_[x_]]:=SDE[expr,x,f]

SimpleDE[f_,x_]:=SDE[f,x,Global`f]

SimpleDE[f_,x_,F_]:=Module[{solutionde},
If[SpecialFunctionsPrintMessages,
Print[specfuninfo]];
solutionde=SDE[f,x,F];
If[SpecialFunctionsPrintMessages,Print["specfun-info: DE:"]];
solutionde
] (* Module SimpleDE *)

(* alias for SpecialFunctions`Private`simpleDE *)
holonomicDE[term_,F_[x_],max_]:=Map[Factor,SpecialFunctions`Private`simpleDE[term,x,max,F][[1]]]==0
holonomicDE[term_,F_[x_]]:=holonomicDE[term,F[x],5]

(* Here we define FindRecursion new by descent *)

Clear[FR]

FR[f_,n_]:=FR[f,n,a]

Off[Sin::argx]
Off[Cos::argx]

(* Bastelei *)
FR[Sin[n_,x_],n_,a_]:=a[n+2]+a[n]==0 /; FreeQ[x,n]
FR[Cos[n_,x_],n_,a_]:=a[n+2]+a[n]==0 /; FreeQ[x,n]

(* standard first order functions *)
(* constants *)
FR[f_,n_,a_]:=a[n] - a[n+1] == 0 /; FreeQ[f,n]

(* powers *)
FR[m_^(b_.*n_+c_.),n_,a_]:=m^b a[n] - a[1 + n] == 0 /; 
FreeQ[b,n] && FreeQ[m,n] && FreeQ[c,n]

(* rational functions *)
FR[r_,n_,a_]:=Module[{den},
	den=Denominator[Together[r]];
	den=den*(den /. n->n+1);
	Factor[den*(r /. n->n+1)]*a[n] - Factor[den*r]*a[n+1] == 0
] /; RationalQ[r,n]

(* all kinds of factorial expressions *)

(* advanced case  (p/q n + b)! for p>0 *)
FR[(m_. n_ + b_.)!^order_.,n_,a_]:=Module[{p,q,result},
	If[SameQ[Head[m],Rational],
		p=Numerator[m];q=Denominator[m],
		p=m;q=1
	];
	result=Pochhammer[m n + b + 1,p]^order a[n] - a[n + q];
	result=Map[Times[q^(p order),#]&,result];
	Map[Factor,result] == 0
] /; FreeQ[b,n] &&
(order>0) && ((SameQ[Head[m],Rational] && m>0) || (IntegerQ[m] && m>=1))

FR[(m_. n_ + b_.)!^order_.,n_,a_]:=Module[{p,q,result},
	If[SameQ[Head[m],Rational],
		p=Numerator[m];q=Denominator[m],
		p=m;q=1
	];
	result=a[n] - Pochhammer[m n + b + 1,p]^(-order) a[n + q];
	result=Map[Times[q^(-p order),#]&,result];
	Map[Factor,result] == 0
] /; FreeQ[b,n] &&
(order<0) && ((SameQ[Head[m],Rational] && m>0) || (IntegerQ[m] && m>=1))

(* advanced case  (p/q n + b)! for p<0 *)
FR[(m_. n_ + b_.)!^order_.,n_,a_]:=Module[{p,q,result},
	If[SameQ[Head[m],Rational],
		p=Numerator[m];q=Denominator[m],
		p=m;q=1
	];
	result=a[n] - Pochhammer[b + m n + p + 1,-p]^order a[n + q];
	result=Map[Times[1/q^(p order),#]&,result];
	Map[Factor,result] == 0
] /; (order>0) && ((SameQ[Head[m],Rational] && m<0) || (IntegerQ[m] && m<=-1))

FR[(m_. n_ + b_.)!^order_.,n_,a_]:=Module[{p,q,result},
	If[SameQ[Head[m],Rational],
		p=Numerator[m];q=Denominator[m],
		p=m;q=1
        ];
	result=Pochhammer[b + m n + p + 1,-p]^(-order) a[n] - a[n + q];
	result=Map[Times[1/q^(-p order),#]&,result];
	Map[Factor,result] == 0
] /; (order<0) && ((SameQ[Head[m],Rational] && m<0) || (IntegerQ[m] && m<=-1))

(* nonstandardized input *)
FR[Factorial[expr_]^order_.,n_,a_]:=FR[Factorial[Expand[expr]]^order,n,a] /;
PolynomialQ[expr,n] && Exponent[expr,n]<2

(* Gamma expressions *)
FR[Gamma[f_]^order_.,n_,a_]:=FR[(f-1)!^order,n,a]

FR[1/Gamma[f_]^order_.,n_,a_]:=FR[1/(f-1)!^order,n,a]

(* Binomial expressions *)
FR[Binomial[b_,c_]^order_.,n_,a_]:=
FR[Simplify[b!^order*(1/c!^order)*1/(b-c)!^order],n,a]

FR[1/Binomial[b_,c_]^order_.,n_,a_]:=
FR[Simplify[(1/b!^order)*c!^order*(b-c)!^order],n,a]

(* Pochhammer expressions *)
FR[Pochhammer[b_,c_]^order_.,n_,a_]:=FR[
Simplify[(b+c-1)!^order*(1/(b-1)!)^order],n,a]

FR[1/Pochhammer[b_,c_]^order_.,n_,a_]:=FR[
Simplify[(1/(b+c-1)!^order)*(b-1)!^order],n,a]

(* special functions *)

FR[PolyGamma[0,n_],n_,a_]:= n*a[n] - (2*n+1)*a[n+1] + (n+1)*a[n+2] == 0

FR[ExpIntegralE[n_,x_],n_,a_]:=
-(x a[n]) + (-n + x) a[1 + n] + (1 + n) a[2 + n] == 0 /; FreeQ[x,n]

(* AS 5.1.45) *)
FR[ExpIntegralE[N_,x_],n_,a_]:=FR[x^(N-1)*Gamma[1-N,x],n,a]

FR[Gamma[n_,x_],n_,a_]:=-(n x) a[n] + (1 + n + x) a[1 + n] - a[2 + n] == 0 /; 
FreeQ[x,n]

(* AS (6.5.12) *)
FR[Gamma[N_,x_],n_,a_]:=FR[(N-1)!-x^N/N*HypergeometricPFQ[{1},{1+N},x],n,a]

FR[Erfc[n_,x_],n_,a_]:=-a[n] + 2 x a[1 + n] + 2 (2 + n) a[2 + n] == 0 /;
FreeQ[x,n]

(* AS (7.2.12) *)
FR[Erfc[N_,x_],n_,a_]:=
FR[1/(2^N*Gamma[N/2+1])*HypergeometricPFQ[{(N+1)/2},{1/2},x^2]-
x/(2^(N-1)*Gamma[(N+1)/2])*HypergeometricPFQ[{N/2+1},{3/2},x^2],n,a]

FR[BesselJ[n_,x_],n_,a_]:=x a[n] - 2 (1 + n) a[1 + n] + x a[2 + n] == 0 /; 
FreeQ[x,n]

(* AS (9.1.69) *)
FR[BesselJ[N_,x_],n_,a_]:=FR[(x/2)^N/N!*HypergeometricPFQ[{},{N+1},-x^2/4],n,a]

FR[BesselY[n_,x_],n_,a_]:=x a[n] - 2 (1 + n) a[1 + n] + x a[2 + n] == 0 /; 
FreeQ[x,n]

FR[BesselI[n_,x_],n_,a_]:=-(x a[n]) + 2 (1 + n) a[1 + n] + x a[2 + n] == 0 /; 
FreeQ[x,n]

(* AS (9.6.47) *)
FR[BesselI[N_,x_],n_,a_]:=FR[(x/2)^N/N!*HypergeometricPFQ[{},{N+1},x^2/4],n,a]

FR[BesselK[n_,x_],n_,a_]:=-(x a[n]) - 2 (1 + n) a[1 + n] + x a[2 + n] == 0 /; 
FreeQ[x,n]

(* AS (9.6.48) *)
FR[BesselK[N_,x_],n_,a_]:=FR[WhittakerW[0,N,2x],n,a]

FR[Hankel1[n_,x_],n_,a_]:=
x a[n] - 2 (1 + n) a[1 + n] + x a[2 + n] == 0 /; FreeQ[x,n]

FR[Hankel2[n_,x_],n_,a_]:=
x a[n] - 2 (1 + n) a[1 + n] + x a[2 + n] == 0 /; FreeQ[x,n]

FR[KummerM[n_,m_,x_],n_,a_]:=
(1 - m + n) a[n] + (-2 + m - 2 n - x) a[1 + n] + (1 + n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

FR[KummerM[n_,m_,x_],m_,a_]:=
m (1 + m) a[m] -((1 + m) (m + x)) a[1 + m] + (1 + m - n) x a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

FR[KummerM[N_,M_,x_],n_,a_]:=FR[Hypergeometric1F1[N,M,x],n,a]

FR[KummerU[n_,m_,x_],n_,a_]:=
-a[n] + (2 - m + 2 n + x) a[1 + n] + (-2 + m - n) (1 + n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

(* AS (13.4.16) *)
FR[KummerU[n_,m_,x_],m_,a_]:=
(m - n) a[m] + (-m - x) a[1 + m] + x a[2 + m] == 0 /; FreeQ[x,m] && FreeQ[n,m]

FR[KummerU[N_,M_,x_],n_,a_]:=
FR[Gamma[1-M]*Gamma[M]*(KummerM[N,M,x]/(Gamma[1+N-M]*Gamma[M]) -
 x^(1-M)*KummerM[1+N-M,2-M,x]/(Gamma[N]*Gamma[2-M])),n,a]

FR[WhittakerM[n_,m_,x_],n_,a_]:=(1 - 2 m + 2 n) a[n] + 
2 (-2 - 2 n + x) a[1 + n] + (3 + 2 m + 2 n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

FR[WhittakerM[n_,m_,x_],m_,a_]:=
16*(1 + m)*(2 + m)*(1 + 2*m)*(3 + 2*m)^2*x*a[m] + 
16*(1 + m)*(2 + m)*(3 + 2*m)*(-3 - 8*m - 4*m^2 + 2*n*x)*a[1 + m] + 
(1 + 2*m)*(-3 - 2*m + 2*n)*(3 + 2*m + 2*n)*x*a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

(* AS (13.1.32) *)
FR[WhittakerM[N_,M_,x_],n_,a_]:=
FR[x^M*HypergeometricPFQ[{1/2+M-N},{1+2M},x],n,a]

(* AS (13.4.29) *)
FR[WhittakerW[n_,m_,x_],n_,a_]:=(1 - 2 m + 2 n) (1 + 2 m + 2 n) a[n] + 
4 (2 + 2 n - x) a[1 + n] + 4 a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

(* AS (13.1.34), combined methods *)
FR[WhittakerW[n_,m_,x_],m_,a_]:=(3 + 2*m)*(1 + 2*m + 2*n)*x*a[m] + 
4*(1 + m)*(3 + 8*m + 4*m^2 - 2*n*x)*a[1 + m] + 
(1 + 2*m)*(-3 - 2*m + 2*n)*x*a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

(* AS (13.1.34) *)
FR[WhittakerW[N_,M_,x_],n_,a_]:=
FR[Gamma[-2M]/Gamma[1/2-M-N]*WhittakerM[N,M,x]+
Gamma[2M]/Gamma[1/2+M-N]*WhittakerM[N,-M,x],n,a]

FR[LegendreP[n_,m_,x_],n_,a_]:=
-((1 + m + n) a[n]) + (3 + 2 n) x a[1 + n] + (-2 + m - n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

(* Gautschi p. 55, (6.1) *)
(*
FR[LegendreP[n_,m_,x_],m_,a_]:=(m - n) (1 + m + n) a[m] +
2 (1 + m) x a[1 + m]/Sqrt[-1 + x^2] + a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]
*)

(* AS (8.1.2) *)
FR[LegendreP[N_,M_,x_],n_,a_]:=FR[((x+1)/(x-1))^(M/2)/Gamma[1-M]*
HypergeometricPFQ[{-N,N+1},{1-M},(1-x)/2],n,a]

FR[LegendreQ[n_,m_,x_],n_,a_]:=
-((1 + m + n) a[n]) + (3 + 2 n) x a[1 + n] + (-2 + m - n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

(* Gautschi p. 55, (6.1) *)
(*
FR[LegendreQ[n_,m_,x_],m_,a_]:=(m - n) (1 + m + n) a[m] +
2 (1 + m) x a[1 + m]/Sqrt[-1 + x^2] + a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]
*)

(* AS (8.1.3) *)
FR[LegendreQ[N_,M_,x_],n_,a_]:=
FR[E^(I M Pi)*2^(-N-1)*Gamma[N+M+1]/Gamma[N+3/2]*x^(-N-M-1)*(x^2-1)^(M/2)*
HypergeometricPFQ[{1+N/2+M/2,1/2+N/2+M/2},{N+3/2},1/x^2],n,a]

FR[JacobiP[n_,A_,B_,x_],n_,a_]:=
2 (1 + A + n) (1 + B + n) (4 + A + B + 2 n) a[n] +
(3 + A + B + 2 n) (-A^2 + B^2 - 8 x - 6 A x - A^2 x - 6 B x - 2 A B x -
B^2 x - 12 n x - 4 A n x - 4 B n x - 4 n^2 x) a[1 + n] +
2 (2 + n) (2 + A + B + n) (2 + A + B + 2 n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[A,n] && FreeQ[B,n]

FR[JacobiP[n_,A_,B_,x_],A_,a_]:= 2 (1 + A + n) a[A] + 
(-4 - 3 A - B - 2 n + 2 x + A x + B x + 2 n x) a[1 + A] + 
(2 + A + B + n) (1 - x) a[2 + A] == 0 /;
FreeQ[x,A] && FreeQ[n,A] && FreeQ[B,A]

FR[JacobiP[n_,A_,B_,x_],B_,a_]:=2 (1 + B + n) a[B] + 
(-4 - A - 3 B - 2 n - 2 x - A x - B x - 2 n x) a[1 + B] + 
(2 + A + B + n) (1 + x) a[2 + B] == 0 /;
FreeQ[x,B] && FreeQ[n,B] && FreeQ[A,B]

(* hypergeometric representation *)
FR[JacobiP[N_,alpha_,beta_,x_],n_,a_]:=FR[Binomial[N+alpha,N]*
Hypergeometric2F1[-N,N+alpha+beta+1,alpha+1,(1-x)/2],n,a]

FR[GegenbauerC[n_,m_,x_],n_,a_]:=
(2 m + n) a[n] - 2 (1 + m + n) x a[1 + n] + (2 + n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

FR[GegenbauerC[n_,m_,x_],m_,a_]:=(2 m + n) (1 + 2 m + n) a[m] +
2 m (-3 - 4 m - 2 n + 2 x^2 + 2 m x^2 + 2 n x^2) a[1 + m] +
4 m (1 + m) (1 - x) (1 + x) a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

(* hypergeometric representation *)
FR[GegenbauerC[N_,lambda_,x_],n_,a_]:=FR[Pochhammer[2*lambda,N]/N!*
Hypergeometric2F1[-N,N+2*lambda,lambda+1/2,(1-x)/2],n,a]

FR[ChebyshevT[n_,x_],n_,a_]:=a[n] - 2 x a[1 + n] + a[2 + n] == 0 /;
FreeQ[x,n]

(* hypergeometric representation *)
FR[ChebyshevT[N_,x_],n_,a_]:=FR[Hypergeometric2F1[-N,N,1/2,(1-x)/2],n,a]

FR[Cos[m_.*Pi*n_],n_,a_]:=FR[Exp[I m Pi]^n,n,a] /; IntegerQ[m]
FR[Cos[n_*x_],n_,a_]:=a[n] - 2 Cos[x] a[1 + n] + a[2 + n] == 0 /;
FreeQ[x,n]

FR[ChebyshevU[n_,x_],n_,a_]:=a[n] - 2 x a[1 + n] + a[2 + n] == 0 /;
FreeQ[x,n]

(* hypergeometric representation *)
FR[ChebyshevU[N_,x_],n_,a_]:=FR[(N+1)*Hypergeometric2F1[-N,N+1,3/2,(1-x)/2],n,a]

FR[Sin[m_.*Pi*n_],n_,a_]:=a[n]-a[n-1] == 0 /; IntegerQ[m]
FR[Sin[n_*x_.],n_,a_]:=a[n] - 2 Cos[x] a[1 + n] + a[2 + n] == 0 /;
FreeQ[x,n]

FR[LegendreP[n_,x_],n_,a_]:=
(1 + n) a[n] - (3 + 2 n) x a[1 + n] + (2 + n) a[2 + n] == 0 /;
FreeQ[x,n]

(* hypergeometric representation *)
FR[LegendreP[N_,x_],n_,a_]:=FR[Hypergeometric2F1[-N,N+1,1,(1-x)/2],n,a]

FR[LaguerreL[n_,m_,x_],n_,a_]:=
(1 + m + n) a[n] + (-3 - m - 2 n + x) a[1 + n] + (2 + n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

FR[LaguerreL[n_,m_,x_],m_,a_]:=(1 + m + n) a[m] + 
(-1 - m - x) a[1 + m] + x a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

FR[LaguerreL[n_,x_],n_,a_]:=
(1 + n) a[n] + (-3 - 2 n + x) a[1 + n] + (2 + n) a[2 + n] == 0 /;
FreeQ[x,n]

(* hypergeometric representation *)
FR[LaguerreL[N_,alpha_,x_],n_,a_]:=FR[Binomial[N+alpha,N]*
Hypergeometric1F1[-N,alpha+1,x],n,a]

FR[LaguerreL[N_,x_],n_,a_]:=FR[Hypergeometric1F1[-N,1,x],n,a]

FR[HermiteH[n_,x_],n_,a_]:=2 (1 + n) a[n] - 2 x a[1 + n] + a[2 + n] == 0 /;
FreeQ[x,n]

(* hypergeometric representation *)
FR[HermiteH[N_,x_],n_,a_]:=FR[(-1)^(N/2)/(N/2)!*N!*
Hypergeometric1F1[-N/2,1/2,x^2],n,a]

FR[factor_.*HypergeometricPFQ[plist_,qlist_,x_],n_,a_]:=Module[{k,j},
FR[Global`sum[factor*Product[Pochhammer[plist[[j]],k],{j,1,Length[plist]}]/
(k!*Product[Pochhammer[qlist[[j]],k],{j,1,Length[qlist]}])*x^k,
{k,0,Infinity}],n,a]]
		
FR[Hypergeometric0F1[n_,x_],n_,a_]:=
-(n (1 + n) a[n]) + n (1 + n) a[1 + n] + x a[2 + n] == 0 /;
FreeQ[x,n]

FR[factor_.*Hypergeometric0F1[N_,x_],n_,a_]:=
FR[factor*HypergeometricPFQ[{},{N},x],n,a]

FR[Hypergeometric1F0[n_,x_],n_,a_]:=a[n] + (-1 + x) a[1 + n] == 0 /;
FreeQ[x,n]

FR[factor_.*Hypergeometric1F0[N_,x_],n_,a_]:=
FR[factor*HypergeometricPFQ[{N},{},x],n,a]

FR[Hypergeometric1F1[-n_,n_+B_,x_],n_,a_]:=
  (1 + n)*(B + n)*(1 + B + n)*(B + 2*n)*(1 + B + 2*n)*(2 + n - x)*a[n] +
    (1 + B + n)*(B + 2*n)*(1 + B + 2*n)*
     (-2*B - 2*n - 3*B*n - 3*n^2 - B*n^2 - n^3 - 6*x - 9*n*x - 3*n^2*x +
       6*x^2 + B*x^2 + 5*n*x^2 - x^3)*a[1 + n] +
    (B + 2*n)*(1 + B + 2*n)*(2 + B + 2*n)*(3 + B + 2*n)*(1 + n - x)*x*
     a[2 + n] == 0

FR[Hypergeometric1F1[-n_,-n_+B_,x_],n_,a_]:=
  (1 + n)*x*a[n] + (1 - B + n)*(-2 + B - n - x)*a[1 + n] +
    (1 - B + n)*(2 - B + n)*a[2 + n] == 0

FR[Hypergeometric1F1[n_,m_,x_],n_,a_]:=
(1 - m + n) a[n] + (-2 + m - 2 n - x) a[1 + n] + (1 + n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

FR[Hypergeometric1F1[n_,m_,x_],m_,a_]:=
m (1 + m) a[m] -((1 + m) (m + x)) a[1 + m] + (1 + m - n) x a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

FR[factor_.*Hypergeometric1F1[N_,M_,x_],n_,a_]:=
FR[factor*HypergeometricPFQ[{N},{M},x],n,a]

FR[HypergeometricU[n_,m_,x_],n_,a_]:=
-a[n] + (2 - m + 2 n + x) a[1 + n] + (-2 + m - n) (1 + n) a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

(* AS (13.4.16) *)
FR[HypergeometricU[n_,m_,x_],m_,a_]:=
(m - n) a[m] + (-m - x) a[1 + m] + x a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

FR[HypergeometricU[N_,M_,x_],n_,a_]:=FR[KummerU[N,M,x],n,a]

FR[Hypergeometric2F0[n_,m_,x_],n_,a_]:=
a[n] + (-1 - x + m x - n x) a[1 + n] + (1 + n) x a[2 + n] == 0 /;
FreeQ[x,n] && FreeQ[m,n]

FR[Hypergeometric2F0[n_,m_,x_],m_,a_]:=
a[m] + (-1 - x + n x - m x) a[1 + m] + (1 + m) x a[2 + m] == 0 /;
FreeQ[x,m] && FreeQ[n,m]

FR[factor_.*Hypergeometric2F0[N_,M_,x_],n_,a_]:=
FR[factor*HypergeometricPFQ[{N,M},{},x],n,a]

FR[Hypergeometric2F1[n_,m_,o_,x_],n_,a_]:=(-1 - n + o) a[n] +
(2 + 2 n - o - x + m x - n x) a[n + 1] + (1 + n) (-1 + x) a[n + 2] == 0 /;
FreeQ[x,n] && FreeQ[m,n] && FreeQ[o,n]

FR[Hypergeometric2F1[n_,m_,o_,x_],m_,a_]:=(-1 - m + o) a[m] +
(2 + 2 m - o - x + n x - m x) a[m + 1] + (1 + m) (-1 + x) a[m + 2] == 0 /;
FreeQ[x,m] && FreeQ[n,m] && FreeQ[o,m]

FR[Hypergeometric2F1[n_,m_,o_,x_],o_,a_]:=o (1 + o) (1 - x) a[o] +
(1 + o) (-o + x - m x - n x + 2 o x) a[1 + o] +
(-1 + m - o) (1 - n + o) x a[2 + o] == 0 /;
FreeQ[x,o] && FreeQ[n,o] && FreeQ[m,o]

FR[Hypergeometric2F1[-n_,-n_+A_.,B_,x_],n_,a_]:=
  (-1 + A - n)*(A - B - n)*(1 + n)*(B + n)*(3 - A + B + 2*n)*(-1 + x)^2*
     a[n] + (-2 + A - B - 2*n)*(A - B - n)*(B + n)*
     (-2 + 2*A - B + A*B - B^2 - 4*n + 2*A*n - 2*B*n - 2*n^2 - x + 2*A*x -
       A^2*x - 3*B*x + A*B*x - 4*n*x + 2*A*n*x - 2*B*n*x - 2*n^2*x)*a[1 + n]\
      + (-1 + A - B - 2*n)*(-1 + A - B - n)*(B + n)*(1 + B + n)*(-A + B + n)*
     a[2 + n] == 0

FR[Hypergeometric2F1[-n_,n_+A_.,B_,x_],n_,a_]:=
  (-1 - A + B - n)*(1 + n)*(A + n)*(B + n)*(3 + A + 2*n)*a[n] +
    (A + n)*(B + n)*(2 + A + 2*n)*
     (2 + 2*A - B + A*B + 4*n + 2*A*n + 2*n^2 - 3*x - 4*A*x - A^2*x -
       8*n*x - 4*A*n*x - 4*n^2*x)*a[1 + n] -
    (A + n)*(1 + A + n)*(B + n)*(1 + B + n)*(1 + A + 2*n)*a[2 + n] == 0

FR[factor_.*Hypergeometric2F1[A_,B_,C_,x_],n_,a_]:=
FR[factor*HypergeometricPFQ[{A,B},{C},x],n,a]

FR[Hypergeometric2F3[A_,b_,c_,d_,e_,x_],A_,a_]:=
(-1 - A + c)*(-1 - A + d)*(1 + A - e)*a[A] +
(-8 - 19*A - 15*A^2 - 4*A^3 + 4*c + 7*A*c + 3*A^2*c + 4*d + 7*A*d +
3*A^2*d - 2*c*d - 2*A*c*d + 4*e + 7*A*e + 3*A^2*e - 2*c*e -
2*A*c*e - 2*d*e - 2*A*d*e + c*d*e + x + A*x - b*x)*a[1 + A] +
(1 + A)*(19 + 21*A + 6*A^2 - 5*c - 3*A*c - 5*d - 3*A*d + c*d - 5*e -
3*A*e + c*e + d*e - x)*a[2 + A] +
(1 + A)*(2 + A)*(-9 - 4*A + c + d + e)*a[3 + A] +
(1 + A)*(2 + A)*(3 + A)*a[4 + A] == 0 /;
FreeQ[x,A] && FreeQ[b,A] && FreeQ[c,A] && FreeQ[d,A] && FreeQ[e,A]

FR[Hypergeometric2F3[A_,b_,c_,d_,e_,x_],b_,a_]:=
(-1 - b + c)*(-1 - b + d)*(1 + b - e)*a[b] +
(-8 - 19*b - 15*b^2 - 4*b^3 + 4*c + 7*b*c + 3*b^2*c + 4*d + 7*b*d +
3*b^2*d - 2*c*d - 2*b*c*d + 4*e + 7*b*e + 3*b^2*e - 2*c*e -
2*b*c*e - 2*d*e - 2*b*d*e + c*d*e + x - A*x + b*x)*a[1 + b] +
(1 + b)*(19 + 21*b + 6*b^2 - 5*c - 3*b*c - 5*d - 3*b*d + c*d - 5*e -
3*b*e + c*e + d*e - x)*a[2 + b] +
(1 + b)*(2 + b)*(-9 - 4*b + c + d + e)*a[3 + b] +
(1 + b)*(2 + b)*(3 + b)*a[4 + b] == 0 /;
FreeQ[x,b] && FreeQ[A,b] && FreeQ[c,b] && FreeQ[d,b] && FreeQ[e,b]

FR[Hypergeometric2F3[A_,b_,c_,d_,e_,x_],c_,a_]:=
c*(1 + c)*(2 + c)*(3 + c)*a[c] +
(1 + c)*(2 + c)*(3 + c)*(-5 - 3*c + d + e)*a[1 + c] +
(2 + c)*(3 + c)*(14 + 13*c + 3*c^2 - 4*d - 2*c*d - 4*e - 2*c*e + d*e -
x)*a[2 + c] + (3 + c)*(-18 - 21*c - 8*c^2 - c^3 + 6*d + 5*c*d +
c^2*d + 6*e + 5*c*e + c^2*e - 2*d*e - c*d*e + 5*x - A*x - b*x +
2*c*x)*a[3 + c] + (-3 + b - c)*(3 - A + c)*x*a[4 + c] == 0 /;
FreeQ[x,c] && FreeQ[A,c] && FreeQ[b,c] && FreeQ[d,c] && FreeQ[e,c]

FR[Hypergeometric2F3[A_,b_,c_,d_,e_,x_],d_,a_]:=
d*(1 + d)*(2 + d)*(3 + d)*a[d] +
(1 + d)*(2 + d)*(3 + d)*(-5 + c - 3*d + e)*a[1 + d] +
(2 + d)*(3 + d)*(14 - 4*c + 13*d - 2*c*d + 3*d^2 - 4*e + c*e - 2*d*e -
x)*a[2 + d] + (3 + d)*(-18 + 6*c - 21*d + 5*c*d - 8*d^2 + c*d^2 -
d^3 + 6*e - 2*c*e + 5*d*e - c*d*e + d^2*e + 5*x - A*x - b*x + 2*d*x)*
a[3 + d] + (-3 + b - d)*(3 - A + d)*x*a[4 + d] == 0 /;
FreeQ[x,d] && FreeQ[A,d] && FreeQ[b,d] && FreeQ[c,d] && FreeQ[e,d]

FR[Hypergeometric2F3[A_,b_,c_,d_,e_,x_],e_,a_]:=
e*(1 + e)*(2 + e)*(3 + e)*a[e] +
(-5 + c + d - 3*e)*(1 + e)*(2 + e)*(3 + e)*a[1 + e] +
(2 + e)*(3 + e)*(14 - 4*c - 4*d + c*d + 13*e - 2*c*e - 2*d*e + 3*e^2 -
x)*a[2 + e] + (3 + e)*(-18 + 6*c + 6*d - 2*c*d - 21*e + 5*c*e +
5*d*e - c*d*e - 8*e^2 + c*e^2 + d*e^2 - e^3 + 5*x - A*x - b*x +
2*e*x)*a[3 + e] + (-3 + b - e)*(3 - A + e)*x*a[4 + e] == 0 /;
FreeQ[x,e] && FreeQ[A,e] && FreeQ[b,e] && FreeQ[c,e] && FreeQ[d,e]

FR[factor_.*Hypergeometric2F3[N_,M_,O_,P_,Q_,x_],n_,a_]:=
FR[factor*HypergeometricPFQ[{N,M},{O,P,Q},x],n,a]

FR[Hypergeometric3F2[A_,b_,c_,d_,e_,x_],A_,a_]:=
(-1 - A + d) (-1 - A + e) a[A] +
(-4 - 7 A - 3 A^2 + 2 d + 2 A d + 2 e + 2 A e - d e + x + 2 A x + A^2 x -
b x - A b x - c x - A c x + b c x) a[1 + A] +
(1 + A) (5 + 3 A - d - e - 3 x - 2 A x + b x + c x) a[2 + A] +
(1 + A) (2 + A) (-1 + x) a[3 + A] == 0 /;
FreeQ[x,A] && FreeQ[b,A] && FreeQ[c,A] && FreeQ[d,A] && FreeQ[e,A]

FR[Hypergeometric3F2[A_,b_,c_,d_,e_,x_],b_,a_]:=
(-1 - b + d) (-1 - b + e) a[b] +
(-4 - 7 b - 3 b^2 + 2 d + 2 b d + 2 e + 2 b e - d e + x - A x + 2 b x -
A b x + b^2 x - c x + A c x - b c x) a[1 + b] +
(1 + b) (5 + 3 b - d - e - 3 x + A x - 2 b x + c x) a[2 + b] +
(1 + b) (2 + b) (-1 + x) a[3 + b] == 0 /;
FreeQ[x,b] && FreeQ[A,b] && FreeQ[c,b] && FreeQ[d,b] && FreeQ[e,b]

FR[Hypergeometric3F2[A_,b_,c_,d_,e_,x_],c_,a_]:=
(-1 - c + d) (-1 - c + e) a[c] +
(-4 - 7 c - 3 c^2 + 2 d + 2 c d + 2 e + 2 c e - d e + x - A x - b x +
A b x + 2 c x - A c x - b c x + c^2 x) a[1 + c] +
(1 + c) (5 + 3 c - d - e - 3 x + A x + b x - 2 c x) a[2 + c] +
(1 + c) (2 + c) (-1 + x) a[3 + c] == 0 /;
FreeQ[x,c] && FreeQ[A,c] && FreeQ[b,c] && FreeQ[d,c] && FreeQ[e,c]

FR[Hypergeometric3F2[A_,b_,c_,d_,e_,x_],d_,a_]:=
d (1 + d) (2 + d) (1 - x) a[d] +
(1 + d) (2 + d) (-2 - 2 d + e + 3 x - A x - b x - c x + 3 d x) a[1 + d] + 
(2 + d) (2 + 3 d + d^2 - e - d e - 7 x + 3 A x + 3 b x -
A b x + 3 c x - A c x - b c x - 9 d x + 2 A d x + 2 b d x +
2 c d x - 3 d^2 x) a[2 + d] +
(-2 + A - d) (-2 + c - d) (2 - b + d) x a[3 + d] == 0 /;
FreeQ[x,d] && FreeQ[A,d] && FreeQ[b,d] && FreeQ[c,d] && FreeQ[e,d]

FR[Hypergeometric3F2[A_,b_,c_,d_,e_,x_],e_,a_]:=
e (1 + e) (2 + e) (1 - x) a[e] +
(1 + e) (2 + e) (-2 + d - 2 e + 3 x - A x - b x - c x + 3 e x) a[1 + e] + 
(2 + e) (2 - d + 3 e - d e + e^2 - 7 x + 3 A x + 3 b x -
A b x + 3 c x - A c x - b c x - 9 e x + 2 A e x + 2 b e x +
2 c e x - 3 e^2 x) a[2 + e] +
(-2 + A - e) (-2 + c - e) (2 - b + e) x a[3 + e] == 0 /;
FreeQ[x,e] && FreeQ[A,e] && FreeQ[b,e] && FreeQ[c,e] && FreeQ[d,e]

FR[factor_.*Hypergeometric3F2[A_,B_,C_,D_,E_,x_],n_,a_]:=
(*
Module[{k},
FR[Sum[factor*Pochhammer[A,k]*Pochhammer[B,k]*Pochhammer[C,k]/(
k!*Pochhammer[D,k]*Pochhammer[E,k])*x^k,{k,0,Infinity}],n,a]]
*)
FR[factor*HypergeometricPFQ[{A,B,C},{D,E},x],n,a]

FR[StruveH[n_,x_],n_,a_]:=-(x^2 a[n]) + (7 + 4 n) x a[1 + n] -
(20 + 18 n + 4 n^2 + x^2) a[2 + n] + (5 + 2 n) x a[3 + n] == 0 /;
FreeQ[x,n]

(* AS (12.1.3) *)
FR[StruveH[N_,x_],n_,a_]:=Module[{k},
FR[(x/2)^(N+1)*Sum[(-1)^k*(x/2)^(2k)/(Gamma[k+3/2]*Gamma[k+N+3/2]),
{k,0,Infinity}],n,a]
]

FR[StruveL[n_,x_],n_,a_]:=x^2 a[n] - (7 + 4 n) x a[1 + n] + 
(20 + 18 n + 4 n^2 - x^2) a[2 + n] + (5 + 2 n) x a[3 + n] == 0 /;
FreeQ[x,n]

(* AS (12.2.1) *)
FR[StruveL[N_,x_],n_,a_]:=Module[{k},
FR[(x/2)^(N+1)*Sum[(x/2)^(2k)/(Gamma[k+3/2]*Gamma[k+N+3/2]),
{k,0,Infinity}],n,a]
]

FR[Ai[n_,x_],n_,a_]:=(-1 - n) a[n] - x a[1 + n] + a[3 + n] == 0 /;
FreeQ[x,n]

FR[Abramowitz[n_,x_],n_,a_]:=
-(x a[n]) + (-2 - n) a[1 + n] + 2 a[3 + n] == 0 /; FreeQ[x,n]

FR[NormalIntegral[n_,x_],n_,a_]:=
-a[n] + x a[1 + n] + (2 + n) a[2 + n] == 0 /; FreeQ[x,n]

(* AS (26.2.40) *)
(* NormalIntegral[n_,x_]==1/Sqrt[2 Pi]*E^(-x^2/4)*ParabolicU[n+1/2,x] *)

FR[NormalIntegral[N_,x_],n_,a_]:=FR[ParabolicU[N+1/2,x],n,a]

FR[KnuthA[n_,x_],n_,a_]:=-a[n] - x a[1 + n] + (1 + n) a[3 + n] == 0 /;
FreeQ[x,n]

FR[KnuthB[n_,x_],n_,a_]:=-a[n] - x a[1 + n] + (1 + n) a[3 + n] == 0 /;
FreeQ[x,n]

(* hypergeometric representation of Knuth functions, p. 49 
FR[KnuthB[N_,x_],n_,a_]:=
FR[1/(3^((N+1)/3)*Gamma[(N+1)/3])*
HypergeometricPFQ[{(2-N)/6,(5-N)/6},{1/3,2/3},x^3/6]+
1/(3^((N-1)/3)*Gamma[(N-1)/3])*x/2*
HypergeometricPFQ[{(4-N)/6,(7-N)/6},{2/3,4/3},x^3/6]+
1/(3^((N-3)/3)*Gamma[(N-3)/3])*x^2/8*
HypergeometricPFQ[{(6-N)/6,(9-N)/6},{4/3,5/3},x^3/6],n,a]
*)

FR[ParabolicU[n_,x_],n_,a_]:=
-2 a[n] + 2 x a[1 + n] + (3 + 2 n) a[2 + n] == 0 /; FreeQ[x,n]

(* AS (19.12.2) 
FR[ParabolicU[N_,x_],n_,a_]:=
FR[2^(-N/2)*WhittakerW[-N/2,-1/4,x^2/2],n,a]
*)
(* AS (19.12.3) *)
FR[ParabolicU[N_,x_],n_,a_]:=
FR[2^(-1/4-N/2)/Gamma[3/4+N/2]*HypergeometricPFQ[{N/2+1/4},{1/2},x^2/2]-
2^(1/4-N/2)/Gamma[1/4+N/2]*
HypergeometricPFQ[{N/2+3/4},{3/2},x^2/2],n,a]

FR[ParabolicD[n_,x_],n_,a_]:=(1 + n) a[n] - x a[1 + n] + a[2 + n] == 0 /;
FreeQ[x,n]

(* AS (19.3.7) *)
FR[ParabolicD[N_,x_],n_,a_]:=FR[ParabolicU[-N-1/2,x],n,a]

FR[ParabolicV[n_,x_],n_,a_]:=-((1 + 2 n) a[n]) - 2 x a[1 + n] + 
2 a[2 + n] == 0 /; FreeQ[x,n]

(* AS (19.4.2) *)
FR[ParabolicV[N_,x_],n_,a_]:=FR[
Gamma[1/2+N]*(Pi/(Gamma[N]*Gamma[1-N])*ParabolicU[N,x]+ParabolicU[N,-x]),n,a]

FR[Bateman[n_,x_],n_,a_]:=
n a[n] + 2 (1 + n - x) a[1 + n] + (2 + n) a[2 + n] == 0 /; FreeQ[x,n]

FR[Bateman[N_,x_],n_,a_]:=FR[-2*E^(-x)*
HypergeometricPFQ[{1-N},{2},2x],n,a]

FR[Krawtchouk[n_,N_,p_,x_],n_,a_]:=
(n - N) (-1 + p) p a[n] + (1 + n - 2 p - 2 n p + N p - x) a[1 + n] + 
(2 + n) a[2 + n] == 0 /; FreeQ[N,n] && FreeQ[x,n] && FreeQ[p,n]

FR[Krawtchouk[n_,N_,p_,x_],N_,a_]:=
(1 + N - x) a[N] + (-3 + n - 2 N + 2 p + N p + x) a[1 + N] + 
(2 - n + N) (1 - p) a[2 + N] == 0 /; FreeQ[n,N] && FreeQ[x,N] && FreeQ[p,N]

FR[Krawtchouk[n_,N_,p_,x_],x_,a_]:=
(-1 + p) (1 + x) a[x] + (1 - n - 2 p + N p + x - 2 p x) a[1 + x] + 
p (1 - N + x) a[2 + x] == 0 /; FreeQ[n,x] && FreeQ[N,x] && FreeQ[p,x]

FR[Krawtchouk[n_,N_,p_,x_],m_,a_]:=
FR[(-1)^n*Binomial[N,n]*p^n*Hypergeometric2F1[-n,-x,-N,1/p],m,a]

FR[Charlier[n_,mu_,x_],n_,a_]:=
(1 + n) a[n] + (-1 - mu - n + x) a[1 + n] + mu a[2 + n] == 0 /;
FreeQ[mu,n] && FreeQ[x,n]

FR[Charlier[n_,mu_,x_],x_,a_]:=
(-1 - x) a[x] + (1 + mu - n + x) a[1 + x] - mu a[2 + x] == 0 /;
FreeQ[mu,x] && FreeQ[n,x]

FR[Charlier[n_,mu_,x_],m_,a_]:=
FR[Hypergeometric2F0[-n,-x,-1/mu],m,a]

FR[Meixner[n_,gamma_,mu_,x_],n_,a_]:=
(1 + n) (gamma + n) a[n] + 
(-1 - mu - gamma mu - n - mu n + x - mu x) a[1 + n] + mu a[2 + n] == 0 /;
FreeQ[gamma,n] && FreeQ[mu,n] && FreeQ[x,n]

FR[Meixner[n_,gamma_,mu_,x_],gamma_,a_]:=(gamma + n) a[gamma] + 
(-1 - 2 gamma + mu + gamma mu - n + mu n - x + mu x) a[1 + gamma] + 
(1 - mu) (1 + gamma + x) a[2 + gamma] == 0 /;
FreeQ[n,gamma] && FreeQ[mu,gamma] && FreeQ[x,gamma]

FR[Meixner[n_,gamma_,mu_,x_],x_,a_]:=
(1 + x) a[x] + (-1 - mu - gamma mu + n - mu n - x - mu x) a[1 + x] + 
mu (1 + gamma + x) a[2 + x] == 0 /; FreeQ[n,x] && FreeQ[mu,x] && FreeQ[gamma,x]

FR[Meixner[n_,gamma_,mu_,x_],m_,a_]:=
FR[Pochhammer[gamma,n]*Hypergeometric2F1[-n,-x,gamma,1-1/mu],m,a]

FR[DiscreteChebyshev[n_,N_,x_],n_,a_]:=FR[Hahn[n,N,0,0,x],n,a] /;
FreeQ[N,n] && FreeQ[x,n]

FR[DiscreteChebyshev[n_,N_,x_],N_,a_]:=FR[Hahn[n,N,0,0,x],N,a] /;
FreeQ[n,N] && FreeQ[x,N]

FR[DiscreteChebyshev[n_,N_,x_],x_,a_]:=FR[Hahn[n,N,0,0,x],x,a] /;
FreeQ[n,x] && FreeQ[N,x]

FR[DiscreteChebyshev[n_,N_,x_],m_,a_]:= R[Hahn[n,N,0,0,x],m,a]

FR[DiscreteLaguerre[n_,rho_,alpha_,x_],n_,a_]:=(1 + alpha + n) rho a[n] + 
(-2 - n - rho - alpha rho - n rho + x - rho x) a[1 + n] + 
(2 + n) a[2 + n] == 0 /; FreeQ[rho,n] && FreeQ[alpha,n] && FreeQ[x,n]

FR[DiscreteLaguerre[n_,rho_,alpha_,x_],alpha_,a_]:=(1 + alpha + n) a[alpha] + 
(-2 - 2 alpha - n + rho + alpha rho + n rho - x + rho x) a[1 + alpha] +
(1 - rho) (1 + alpha + x) a[2 + alpha] == 0 /; 
FreeQ[rho,alpha] && FreeQ[n,alpha] && FreeQ[x,alpha]

FR[DiscreteLaguerre[n_,rho_,alpha_,x_],x_,a_]:=
x a[x] + (n - rho - alpha rho - n rho - x - rho x) a[1 + x] + 
rho (1 + alpha + x) a[2 + x] == 0 /;
FreeQ[n,x] && FreeQ[rho,x] && FreeQ[alpha,x]

FR[DiscreteLaguerre[n_,rho_,alpha_,x_],m_,a_]:=FR[
Pochhammer[1+alpha,n]*rho^n/n!*
Hypergeometric2F1[-n,-x+1,1+alpha,1-1/rho],m,a]

FR[Hahn[n_,N_,alpha_,beta_,x_],n_,a_]:=
(N - n - 1) (n + 1 + alpha) (beta + 1 + n) (2 n + 4 + beta + alpha)*
(n + 1 + alpha + beta + N) a[n] - 
(3+2*n+beta+alpha)*(4+6*n+8*x+5*beta+alpha+2*alpha*x*beta-2*n*N*beta-
alpha*N*beta+4*x*n*alpha-2*alpha*N*n+6*x*alpha-4*N+x*alpha^2-n*alpha^2+
4*n*x*beta+2*beta^2-6*N*n+6*x*beta+12*x*n+5*n*beta+2*n^2-3*N*beta-alpha^2-
2*N*n^2+4*x*n^2+n^2*beta-alpha*n^2-N*beta^2+x*beta^2+n*beta^2-alpha*n+
alpha*beta-3*alpha*N)*a[n+1]+
(n + 2) (n + 2 + alpha + beta) (2 n + 2 + beta + alpha) a[n+2] ==0 /;
FreeQ[N,n] && FreeQ[alpha,n] && FreeQ[beta,n] && FreeQ[x,n]

FR[Hahn[n_,N_,alpha_,beta_,x_],N_,a_]:=
(1 + alpha + beta + n + N) (N - x) a[N] + 
(-1 - alpha + n + alpha n + beta n + n^2 - 3 N - 2 alpha N - beta N -
2 N^2 + 2 x + alpha x + beta x + 2 N x) a[1 + N] + 
(-1 + n - N) (-1 - alpha - N + x) a[2 + N] == 0 /;
FreeQ[n,N] && FreeQ[alpha,N] && FreeQ[beta,N] && FreeQ[x,N]

FR[Hahn[n_,N_,alpha_,beta_,x_],alpha_,a_]:=
(1 + alpha + n) (1 + alpha + beta + n + N) a[alpha] + 
(-3 - 5 alpha - 2 alpha^2 - 2 beta - 2 alpha beta - 3 n - 3 alpha n -
beta n - n^2 - 3 N - 2 alpha N - beta N - 2 n N + 2 x + alpha x + 
beta x + 2 n x) a[1 + alpha] + 
(2 + alpha + beta + n) (1 + alpha + N - x) a[2 + alpha] == 0 /;
FreeQ[n,alpha] && FreeQ[N,alpha] && FreeQ[beta,alpha] && FreeQ[x,alpha]

FR[Hahn[n_,N_,alpha_,beta_,x_],beta_,a_]:=
(1 + beta + n) (1 + alpha + beta + n + N) a[beta] + 
(-5 - 3 alpha - 6 beta - 2 alpha beta - 2 beta^2 - 5 n - alpha n - 
3 beta n - n^2 - N - beta N - 2 x - alpha x - beta x - 2 n x) a[1 + beta] + 
(2 + alpha + beta + n) (2 + beta + x) a[2 + beta] == 0 /;
FreeQ[n,beta] && FreeQ[N,beta] && FreeQ[alpha,beta] && FreeQ[x,beta]

FR[Hahn[n_,N_,alpha_,beta_,x_],x_,a_]:=(-1 + alpha + N - x) (1 + x) a[x] + 
(5 - alpha + 2 beta + n + alpha n + beta n + n^2 - 3 N - beta N + 6 x -
alpha x + beta x - 2 N x + 2 x^2) a[1 + x] + 
(-2 + N - x) (2 + beta + x) a[2 + x] == 0 /;
FreeQ[n,x] && FreeQ[N,x] && FreeQ[alpha,x] && FreeQ[beta,x]

FR[Hahn[n_,N_,alpha_,beta_,x_],m_,a_]:=
FR[(-1)^n/n!*Pochhammer[beta+x+1,n]*Pochhammer[N-x-n,n]*
HypergeometricPFQ[{-n,-x,alpha+N-x},{N-x-n,-beta-x-n},1],m,a]

(* indefinite and infinite sums *)

FR[Global`sum[expr_,{k_,0_,n_+m_}],n_,a_]:=Module[{fr,kk},
	fr=FR[Global`sum[expr,{k,0,n}],n,a][[1]];
	fr=fr/.n->n+m;
	Map[Factor,fr/.a[kk_]->a[kk-m]] == 0
]

FR[Global`sum[expr_,{k_,k1_,k2_}],n_,a_]:=
FR[Global`sum[expr/.k->k+k1,{k,0,k2-k1}],n,a] /; 
FreeQ[expr,n] && FreeQ[k1,n] && Not[SameQ[k1,0]]

Off[Sum::itform]

MaxZeilbergerOrder=5

(*
FR[factor_.*Sum[expr_,{k_,k1_,k2_}],n_,a_]:=Module[
	{aaa,re,de1,de2,de,x,F,zb,order,X,eq1,eq2,coefflist,jj,aa,tmpexpr,kk},
	zb={};
	tmpexpr=factor*expr /. Pochhammer[aa_,jj_]->Gamma[aa+jj]/Gamma[aa];
	tmpexpr=tmpexpr /. Gamma[aa_]->(aa-1)!;
	order=1;
	If[Not[FreeQ[expr,n]],
	While[SameQ[zb,{}]&&order<=MaxZeilbergerOrder,
        If[SpecialFunctionsPrintMessages,
	Print["specfun-info: Zeilberger algorithm entered, order = ",order]];
	zb=Simplify[fastZeil`Zb[tmpexpr,{k,k1,k2},n,order]];order=order+1],
	(* End If *)
	zb="Zeilberger algorithm not applicable"];
	If[(SameQ[order,MaxZeilbergerOrder+1] || 
		(FreeQ[expr,n] && (* SameQ[zb,"input not interpretable"]*) 
		SameQ[Head[zb],String]
		))
		&& FreeQ[expr,n],
		(* second try, currently Koepf *)
		If[SameQ[k2,n] && FreeQ[k1,n],
		If[SpecialFunctionsPrintMessages,
		Print["specfun-info: Zeilberger algorithm fails"];
		Print["specfun-info: Koepf algorithm entered"]];
		re=FR[tmpexpr,k,aaa];
		re=Map[Times[k+1-k1,#]&,re[[1]]]==0;
		de1=RETODE[re,aaa,k,F,x];
		de2=F[x]+(-1+x)*F'[x]; (* SimpleDE[1/(1-z),z] *)
		de=DEProduct[de1,de2,F,x];
		(* here assumed k2=n, and k1 independent of n *)
		zb=DEtoRE[de,F,x,aaa,n],
		Return[HoldForm[FR[factor*Sum[expr,{k,k1,k2}],n,a]]]];
		(* Return[] *), (* Else *)
        If[SameQ[Head[zb],String],
	Return[HoldForm[FR[factor*Sum[expr,{k,k1,k2}],n,a]]]];
	If[SameQ[order,1],Return[FR[zb[[1,2]],n,a]]];
	zb=(zb/.fastZeil`Delta[kk_,nn_]->0);
	zb=(zb/.fastZeil`F[kk_,nn_]->a[nn]);
	If[SameQ[zb[[1,2]],0],zb=(zb[[1,1]]/.fastZeil`SUM->a) == 0,
        If[SpecialFunctionsPrintMessages,
	Print["specfun-info: inhomogeneous RE encountered: ",zb]];
	eq1=zb[[1]];
        eq1=(eq1/.fastZeil`F[k, kk_]->fastZeil`SUM[kk]);
	eq2=zb[[1]]/.n->n+1;
	zb=eq2[[1]]-eq2[[2]] eq1[[1]]/eq1[[2]];
	(* Achtung: Hier muss noch ausgebaut werden:
	   FindRecursion[eq1,n,a] zeigt, welche Linearkombination zum
	   Ziel fuehrt... *)
	zb=Numerator[Together[zb]];
	(* zb=(zb/.fastZeil`SUM[n+kk_.]->X^kk); *)
	zb=(zb/.fastZeil`F[k,n+kk_.]->X^kk);
	coefflist=CoefficientList[zb,X];
	zb=Sum[Factor[coefflist[[jj]]] a[n+jj-1],{jj,1,Length[coefflist]}]
	== 0
	]; (* End If *)
	]; (* End Else *)
	
	zb/.aaa->a
]
*)

FR[factor_.*Global`sum[expr_,{k_,k1_,k2_}],n_,a_]:=Module[
	{aaa,re,de1,de2,de,x,F,zb,order,X,eq1,eq2,coefflist,jj,aa,tmpexpr,kk},
	zb={};
	tmpexpr=factor*expr /. Pochhammer[aa_,jj_]->Gamma[aa+jj]/Gamma[aa];
	tmpexpr=tmpexpr /. Gamma[aa_]->(aa-1)!;
	order=1;
	If[Not[FreeQ[expr,n]],
	While[SameQ[zb,{}]&&order<=MaxZeilbergerOrder,
        If[SpecialFunctionsPrintMessages,
	Print["specfun-info: Zeilberger algorithm entered, order = ",order]];
	zb=fastZeil`Zb[tmpexpr,{k,k1,k2},n,order];order=order+1],
	(* End If *)
	zb="Zeilberger algorithm not applicable"];
	If[(SameQ[order,MaxZeilbergerOrder+1] || 
		(FreeQ[expr,n] && (* SameQ[zb,"input not interpretable"]*) 
		SameQ[Head[zb],String]
		))
		&& FreeQ[expr,n],
		(* second try, currently Koepf *)
		If[SameQ[k2,n] && FreeQ[k1,n],
		If[SpecialFunctionsPrintMessages,
		Print["specfun-info: Zeilberger algorithm fails"];
		Print["specfun-info: Koepf algorithm entered"]];
		re=FR[tmpexpr,k,aaa];
		re=Map[Times[k+1-k1,#]&,re[[1]]]==0;
		de1=RETODE[re,aaa,k,F,x];
		de2=F[x]+(-1+x)*F'[x]; (* SimpleDE[1/(1-z),z] *)
		de=DEProduct[de1,de2,F,x];
		(* here assumed k2=n, and k1 independent of n *)
		zb=DEtoRE[de,F,x,aaa,n],
		Return[HoldForm[FR[factor*Sum[expr,{k,k1,k2}],n,a]]]];
		(* Return[] *), (* Else *)
        If[SameQ[Head[zb],String],
	Return[HoldForm[FR[factor*Sum[expr,{k,k1,k2}],n,a]]]];
	If[SameQ[order,1],Return[FR[zb[[1,2]],n,a]]];
(* in Mathematica 4 gibt es hier eine andere Reihenfolge!
	If[SameQ[zb[[1,2]],0],zb=(zb[[1,1]]/.fastZeil`SUM->a) == 0,
*)
	If[SameQ[zb[[1,2]],0],zb=(zb[[1,1]]/.fastZeil`SUM->a) == 0,
        If[SpecialFunctionsPrintMessages,
	Print["specfun-info: inhomogeneous RE encountered: ",zb]];
	eq1=zb[[1]];
	eq2=zb[[1]]/.n->n+1;
	zb=eq2[[1]]-eq2[[2]] eq1[[1]]/eq1[[2]];
	(* Achtung: Hier muss noch ausgebaut werden:
	   FindRecursion[eq1,n,a] zeigt, welche Linearkombination zum
	   Ziel fuehrt... *)
	zb=Numerator[Together[zb]];
	zb=(zb/.fastZeil`SUM[n+kk_.]->X^kk);
	coefflist=CoefficientList[zb,X];
	zb=Sum[Factor[coefflist[[jj]]] a[n+jj-1],{jj,1,Length[coefflist]}]
	== 0
	]; (* End If *)
	]; (* End Else *)
	
	zb/.aaa->a
]

(* sum algorithm *)
(* old
FR[f_+g_,n_,a_]:=SumRE[FR[f,n,a],FR[g,n,a],a,n] 
*)
FR[f_+g_,n_,a_]:=Module[{fre,gre,result},
	fre=FR[f,n,a];
	gre=FR[g,n,a];
	If[Not[SameQ[Head[fre],HoldForm] || SameQ[Head[gre],HoldForm] ||
		SameQ[Head[fre],FR] || SameQ[Head[gre],FR]],
	result=SumRE[fre,gre,a,n],
	result=HoldForm[FR[f+g,n,a]]];
	result
]

(* product algorithm *)
(* old
FR[f_*g_,n_,a_]:=ProductRE[FR[f,n,a],FR[g,n,a],a,n]
*)

FR[f_*g_,n_,a_]:=Module[{fre,gre,result},
        fre=FR[f,n,a];
        gre=FR[g,n,a];
        If[Not[SameQ[Head[fre],HoldForm] || SameQ[Head[gre],HoldForm] ||
                SameQ[Head[fre],FR] || SameQ[Head[gre],FR]],
	result=ProductRE[fre,gre,a,n],
        result=HoldForm[FR[f*g,n,a]]];
	result
]

(* iterative products *)
FR[f_^m_,n_,a_]:=PowerRE[FR[f,n,a],a,n,m] /; IntegerQ[m] && m>0

FR[f_^m_,n_,a_]:=PowerRE[FR[1/f,n,a],a,n,-m] /; IntegerQ[m] && m<0

(* shifts *)
(* HypergeometricPFQ fehlt *)
FR[f_[b___,n_+n0_,c___],n_,a_]:=Module[{tmp,kk},
	tmp=FR[f[b,n,c],n,a][[1]];
	tmp=(tmp /. n->n+n0);
	tmp=(tmp /. a[kk_]->a[kk-n0]);
	tmp=(tmp /. a[kk_]->a[Hold[Simplify[kk]]]);
	tmp=(tmp /. Hold[kk_]->kk);
	Map[Factor,tmp] == 0
] /;
Module[{tmp},
Off[FreeQ::level];
tmp=FreeQ[{b},n] && FreeQ[{c},n] && FreeQ[n0,n];
On[FreeQ::level];
tmp]
(*
/; FreeQ[b,n] && FreeQ[c,n] && FreeQ[n0,n]
*)

FR[f_[b___,-n_,c___],n_,a_]:=Module[{tmp,kk,numberlist,max},
        tmp=FR[f[b,n,c],n,a][[1]];
	numberlist=Union[Map[Plus[#,-n]&,Cases[Cases[tmp,a[n+_.],3],n+_.,2]]];
        max=Max[numberlist];
        tmp=(tmp /. n->-n);
        tmp=(tmp /. a[kk_]->a[-kk]);
	tmp=(tmp /. a[kk_]->a[Hold[Simplify[kk]]]);
        tmp=(tmp /. Hold[kk_]->kk);
	Map[Factor,tmp /. n->n+max] == 0
] /;
Module[{tmp},
Off[FreeQ::level];
tmp=FreeQ[{b},n] && FreeQ[{c},n];
On[FreeQ::level];
tmp]

(* currently eliminated 
FR[f_[b___,-n_+n0_,c___],n_,a_]:=Module[{tmp,kk,numberlist,max},
        tmp=FR[f[b,-n,c],n,a][[1]];
        numberlist=Union[Map[Plus[#,-n]&,Cases[Cases[tmp,a[n+_.],3],n+_.,2]]];
        max=Max[numberlist];
        tmp=(tmp /. n->n-n0);
        tmp=(tmp /. a[kk_]->a[kk+n0]);
	tmp=(tmp /. a[kk_]->a[Hold[Simplify[kk]]]);
        tmp=(tmp /. Hold[kk_]->kk);
	Map[Factor,tmp] == 0
] /; 
Module[{tmp},
Off[FreeQ::level];
tmp=FreeQ[{b},n] && FreeQ[{c},n] && FreeQ[n0,n];
On[FreeQ::level];
tmp]
*)

FR[f___]:=HoldForm[HolonomicRE[f]];

Null

(* end identity.m *)


Clear[simpleDE,DEtoRE,SimpleRE]

(*
simpleDE[fkt_,x_]:=simpleDE[fkt,x,5,Global`f]

simpleDE[fkt_,x_,max_]:=simpleDE[fkt,x,max,Global`f]/;
	     SameQ[Head[max],Integer]||SameQ[Head[max],DirectedInfinity]

simpleDE[fkt_,x_,F_]:=simpleDE[fkt,x,5,F]/;
	     SameQ[Head[F],Symbol]

simpleDE[fkt_,x_,max_,F_]:=Module[{},
Print["specfun-info: ",x," is not a valid variable"];
HoldForm[simpleDE[fkt,x,max,F]]]/;!SameQ[Head[x],Symbol]

simpleDE[fkt_,x_,max_,f_]:=Module[{},
Print["specfun-warning: Please Clear[f], or use another symbol as fourth
argument of FindRecursion."];
HoldForm[simpleDE[fkt,x,max,f]]]/;(!SameQ[Head[f],Symbol]||
                     !SameQ[ToString[Head[f[anything___]]],"f"])
*)

simpleDE[fkt_,x_,max_,F_]:=Module[
{init,shift,xpotenz,simplesummand,result,recursfac,recnomil,recdomil,
summand,recnomil0,recdomil0,ddff,df,ex,pmax,conomi,domi,dep,de,
listzero,listvar,difflist,sum,finalsum,testlist,list,equ,lnew,length,
j,i,solution,denomil,sollist,m,p,de0,n,errorval,a,newlist,
lcm,nn},
(*
If[SpecialFunctionsPrintMessages,Print[specfuninfo]];
*)

ListOfIndependentTerms[list1_,xx_]:= Module[{lnew, length,first,fraction,sum,i},
 lnew = {};
 length = Length[list1];
first = list1[[1]];

sum = first;
For[i=2, i<=length, i++,
 fraction = Factor[Cancel[first/list1[[i]]]];
 If [RationalQ[fraction,xx],
 sum  += list1[[i]], (* rat. dependent  *)
 AppendTo[lnew,list1[[i]]] (* rat. indep  *)
    ]  (* if  *)
   ];  (* for   *) 
Flatten[{sum,ListOfIndependentTerms[lnew,xx]}]
]/;(Length[list1]>1);

ListOfIndependentTerms[list1_,xx_]:= Flatten[{list1}]/;(Length[list1]<2);

lcm[{}]:=1;
lcm[a_]:=Module[{j},
PolynomialLCM[First[a],lcm[Rest[a]]]
];

(* main  *)
dep=pmax; (* init for search of rat. derivative *)

If[Not[FreeQ[fkt,GegenbauerC[kkk_,0,xxx_]]],
Gegenbauer0Print[fkt];
Return[HoldForm[simpleDE[fkt,x,max,F]]]
];
If[Not[FreeQ[fkt,GegenbauerC[kkk_,aaa_,xxx_]]],
GegenbauerWarning[fkt,{}]];

If[!FreeQ[fkt,F]||!FreeQ[x,F],
Print[
"specfun-warning: the symbol F is used in the differential equation."]];
errorval=(*SequenceForm["ps[",*) HoldForm[fkt](*, ",", max, "]"]*);
pmax = max;
df[0] = fkt/.transformspecial1;
If[SameQ[df[0],0],
   co[0]=0,
   (* search for a differential equation of maximal order pmax (default=5) *)
   (* search for a differential equation of order 1 *)
   df[1] = D[df[0],x];
    sum  = df[1] + a[0] * df[0];
    length = Length[reclist];
    For[i= 1,i<=length,++i,
    If[Not[FreeQ[sum,Head[reclist[[i,1]]]]],
    sum  = SimpByRecursion[sum,reclist[[i]] ];
    ];  (* if not  *)
    ];  (* for *)
   co[0] = Together[Expand[ -df[1]/df[0] ]]
  ];

nomi=Numerator[co[0]];
domi=Denominator[co[0]];
dep=pmax; (*init fuer rat. derivative search*)
If [RationalQ[co[0],x],
    de = diff[f,x]*domi + nomi * f;
    dep= 1,

    (* search for a differential equation of higher order *)
    de = Null;
    listzero = {0};
    listvar  = {a[0]};
    difflist = {f,diff[f,x,1]};

    For [p=2, p<=pmax, p++,
         df[p] = D[df[p-1],x];
	 (* formal setting of differential equation *)
         sum   = df[p] + Sum[a[ii]*df[ii],{ii,0,p-1}];
    length = Length[reclist];
    For[i= 1,i<=length,++i,
      If[Not[FreeQ[sum,Head[reclist[[i,1]]]]],
      sum  = SimpByRecursion[sum,reclist[[i]] ];
        ];  (* if not  *)
       ];  (* for *)
	 finalsum = Numerator[Together[sum]];
         testlist= Level[Expand[finalsum],1];
         list= Level[Expand[finalsum],1];
         equ = {};
         (* find rational independent terms *)
          equ  = ListOfIndependentTerms[list,x];
         equ1[p]=  equ;
          (* find coefficients of differential equation *)
         listzero=Table[0,{Length[equ]}];
         AppendTo [listvar,a[p-1]];
	 AppendTo [difflist,diff[f,x,p]];
         Off[Solve::svars];
         solution = Solve[equ==listzero,listvar];
         On[Solve::svars];
         If [solution!={},
	 If[SameQ[listzero, Simplify[equ /. solution[[1]]]],
	     denomil={};
             sollist = solution[[1]];
             For [m=1, m<=p, m++, 
                  index = sollist[[m,1]] /. a[in_] -> in;
                  co[index] = Simplify[sollist[[m,2]]];
                  AppendTo[denomil, Denominator[Together[co[index]]] ]
                 ];
             denomi = lcm[denomil];
             co[p] = 1;
             de = co[0] * f;
             For [m=1, m<=p, m++, de= co[m] * diff[f,x,m] + de];
             de = Expand[de];
             de = If[SameQ[Head[de],diff],
                         de*denomi,
                         Sum[ de[[si]]*denomi, {si,Length[de]}]
                        ];
             de = Simplify[de];
             de = Collect[de,difflist];
             dep= p;
             Break[]
        ]   ]] (* for p *);
    If [Equal[de,Null], 
        If[SpecialFunctionsPrintMessages,
	Print["specfun-info: DE not found in ",pmax," step(s)"]];
        Return[HoldForm[simpleDE[fkt,x,max,F]]]
       ] (* Equal *)
      ] (* if rat.Q *);
de=(de /. {f->F[x],diff[f,x]->F'[x],diff[f,x,p_]->Derivative[p][F][x]});
DE = (de == 0);
de == 0
(* factored form
DEOut[de,F,x] *)
] (* simpleDE  *)

Clear[NonLinear]

NonLinear[de_,y_,x_]:=Module[
	{pos1,pos2,DE},
	If[SameQ[Head[de],Equal],DE=Expand[de[[1]]-de[[2]]],DE=Expand[de]];
	DE=(DE /. y[x]->t[0]);
	DE=(DE /. Derivative[n_][y][x]->t[n]);
	pos1=Position[DE,a_.*t[b_]*t[c_]];
	pos2=Position[DE,a_.*t[b_]^c_];
	Not[SameQ[pos1,{}]] || Not[SameQ[pos2,{}]]
]

DEtoRE[de_,F_,x_]:=DEtoRE[de,F,x,Global`a,Global`k]

DEtoRE[de_,F_[x_]]:=DEtoRE[de,F,x,Global`a,Global`k]

DEtoRE[de_,F_[x_],x_]:=DEtoRE[de,F,x,Global`a,Global`k]

DEtoRE[de_,F_[x_],a_[k_]]:=DEtoRE[de,F,x,a,k]

DEtoRE[de_,F_[x_],x_,a_,k_]:=DEtoRE[de,F,x,a,k]

Off[Global`k::shdw]

DEtoRE[de_,F_,x_,Global`a,Global`k]:= Module[{},
Print["specfun-warning: Please Clear[a] and Clear[k], or use other symbols
as fourth and fifth argument of DEtoRE."];
HoldForm[DEtoRE[de,F,x,Global`a,Global`k]]]/;(!SameQ[Head[Global`a],Symbol]||
Not[SameQ[ToString[Head[Global`a[anything___]]],"a"]])&&
     !SameQ[Head[Global`k],Symbol]

DEtoRE[de_,F_,x_,a_,Global`k]:= Module[{},
Print["specfun-warning: Please use another symbol as fifth argument of DEtoRE."];
HoldForm[DEtoRE[de,F,x,a,Global`k]]]/;!SameQ[Head[Global`k],Symbol]

DEtoRE[de_,F_,x_,Global`a,k_]:=Module[{},
Print["specfun-warning: Please Clear[a] or use another symbol as
fourth argument.\n"];
HoldForm[DEtoRE[de,F,x,Global`a,k]]]/;(!SameQ[Head[Global`a],Symbol]||
Not[SameQ[ToString[Head[Global`a[anything___]]],"a"]])

DEtoRE[de_,F_,x_,a_,k_]:= Module[{},
Print["specfun-warning: Nonlinear differential equations are not supported."];
HoldForm[DEtoRE[de,F,x,a,k]]]/;NonLinear[de,F,x]

DEtoRE[de_,F_,x_,a_,k_]:=Module[
{tempre,subst,de00,f,recoefflist,varlist,re,re00,reseparation,
l,i,reanalysis,maxd,reprodsum,findd,higherd,plus1,part12},
(*
If[SpecialFunctionsPrintMessages, Print[specfuninfo]];
*)
findd[c_. * a[k]] := 0;
findd[c_. * a[k+d_.]] := d;
findd[c_. * a[k+d_.]] := d;
higherd[z_,y_] := findd[z] > findd[y];
plus1[pp___]:=pp + 1;
part12[pp___]:=Part[pp,1,2];

If[SameQ[Head[de],Equal],de00=de[[1]]-de[[2]],de00=de];
de00=(de00
/.{F[x]->f,F'[x]->diff[f,x],Derivative[p_][F][x]->diff[f,x,p]});
subst[g_+h_,x]:=subst[g,x]+subst[h,x];
subst[c_*g_,x]:=c*subst[g,x] /; FreeQ[c,x] && FreeQ[c,f];
subst[diff[f,x,k0_],x]:=Pochhammer[k+1,k0]*a[k+k0];
subst[diff[f,x],x]:=(k+1)*a[k+1];
subst[f,x]:=a[k];
subst[x^j_.*diff[f,x,k0_],x]:=Pochhammer[k+1-j,k0]*a[k+k0-j];
subst[x^j_.*diff[f,x],x]:=(k+1-j)*a[k+1-j];
subst[x^j_.*f,x]:=a[k-j];
subst[g_,x]:=subst[Expand[g],x] /; (Head[g]==Times);
(* separation of variables and coefficients *)
reseparation[tempre_]:=Module[
        {v,c},
        v=Cases[Variables[tempre],a[__]];
        c=Simplify[Coefficient[Expand[tempre],#]&/@ v];
Return[{c,v}]
];
RE=re00= subst[de00,x];
{recoefflist,varlist}=reseparation[re00];
re=Apply[Plus,recoefflist*varlist];
l = Length[varlist];
mind = findd[varlist[[1]]];
For [i=2, i<=l, i++, mind= Min[findd[varlist[[i]]],mind]];
(Map[Factor,re /. k -> k-mind]==0)
] (* DEtoRE *)

SimpleRE[fkt_,x_,a_[k_],k_,max_]:=SimpleRE[fkt,x,a,k,max]

SimpleRE[fkt_,x_]:=SimpleRE[fkt,x,Global`a,Global`k]

SimpleRE[fkt_,x_,a_[k_],k_]:=SimpleRE[fkt,x,a,k,5]

SimpleRE[fkt_,x_,a_,k_]:=SimpleRE[fkt,x,a,k,5]

SimpleRE[fkt_,x_,a_[k_]]:=SimpleRE[fkt,x,a,k,5]

SimpleRE[fkt_,x_,a_,k_,max_]:=Module[{},
Print["specfun-warning: Please Clear[f] before using SimpleRE."];
HoldForm[SimpleRE[fkt,x,a,k,max]]]/;(Not[SameQ[Head[Global`f],Symbol]]||
    !SameQ[ToString[Head[Global`f[anything___]]],"f"])

SimpleRE[fkt_,x_,a_,k_,max_]:=Module[{},
Print["specfun-warning: Please Clear[a] or use another symbol as
third argument.\n"];
HoldForm[SimpleRE[fkt,x,a,k,max]]]/;(!SameQ[Head[a],Symbol]||
    !SameQ[ToString[Head[Global`a[anything___]]],"a"])

SimpleRE[fkt_,x_,a_,k_,max_]:=Module[
	{PSP,hold},
	If[SpecialFunctionsPrintMessages,
	Print[specfuninfo]];
	PSP = SpecialFunctionsPrintMessages;
        If[PSP,specfunprintoff];
	hold = DEtoRE[SimpleDE[fkt,x,Global`f],Global`f,x,a,k];
	If[PSP,specfunprint];
	hold
]

Off[General::spell1]

RationalQ[f_,x_]:=Module[{fac},
fac:=Factor[f];
PolynomialQ[Numerator[fac],x] && PolynomialQ[Denominator[fac],x]
]

On[General::spell1]

Clear[
FindLowestFirstParameter,SimpByRecursion,SimpByRecursion1,Recursion,
AddToNlist]

SimpByRecursion[expr_]:= Module[{expr1,expr2,length,i},
    expr1 = expr/.transformspecial1;
    expr2 = expr/.transformspecial1;
    length = Length[reclist];
    For[i= 1,i<=length,++i,
    If[Not[FreeQ[expr1,Head[reclist[[i,1]]]]],
    expr1= SimpByRecursion[expr1,reclist[[i]]]
      ]; (* if not  *)
       ];  (* for *)
If[SameQ[expr2,expr],expr1,expr1/.transformspecial2]
]

SimpByRecursion[expr1_,norec_]:= Module[{},
Print["specfun-warning: Please call SimpByRecursion with one argument."];
HoldForm[SimpByRecursion[expr1,norec]]
]/;!SameQ[Head[norec],Equal]

SimpByRecursion[expr1_,recursion_]:=Module[{A,func,n,low,i,tail,argli,
expr2,expr3, aetzi,fetzi,lowlist,highlist,highlist3,lowlist3,reclowlist,
rechighlist,reclow,low3,high3,hold},

Recursion[arglist_,arglii_,recursion1_]:=  Module[{n,length,recu,i},
length = Length[arglii];
recu = recursion1;
For[i = 1, i <= length,++i,
recu = recu/. arglii[[i]] -> arglist[[i]] 
    ];
recu
];

SimpByRecursion1[AA_,AA_[arglist_],low1_,range1_,arglii_,recursion1_]:=
SimpByRecursion1[AA,Recursion[arglist,arglii,recursion1],
          low1,range1,arglii,recursion1]/;
	    (arglist[[1]] -low1-1+range1 -1>0);

SimpByRecursion1[AA_,expr_,low1_,range1_,arglii_,recursion1_]:=Module[
{p,head,plist,i,length},
length = Length[expr];
plist = {};head = Head[expr];
For[i=1,i<=length,++i,
AppendTo[plist,SimpByRecursion1[AA,expr[[i]],low1,range1,arglii,recursion1]]
   ];
   p= plist[[1]];
If[length>1,
 For[i=2,i<=length,++i,
 p = head[p,plist[[i]]]
    ]
   ];
p
]/;Not[FreeQ[expr,AA]]&&Not[SameQ[Head[expr],AA]];

SimpByRecursion1[AA_,expr_,low1_,range1_,arglii_,recursion1_]:= Module[{},
expr
];

FindLowestFirstParameter[
AA_,AA_[arglist_],arglii_,lowlist2_]:=
Module[{i,low1},
low1 = lowlist2[[1]];
(* finds minimal n-value in calls of func and writes this value in 
global variable low *)
      If[SameQ[arglist[[1]],arglii[[1]]],
        If[(low1- arglii[[1]]>0),
           low1=arglii[[1]],
            Null(* else do nothing *),
          (* 1st appearance *) low1=arglii[[1]]
          ], 
        If[(low1-arglist[[1]]>0),
          low1=arglist[[1]],
          Null(* else do nothing *),
          (* 1st appearance *)
          low1=arglist[[1]]
          ]
        ];
(arglist/.arglist[[1]]->low1)
]/;!SameQ[Head[arglist[[1]]],Integer] (* Module Find... *);

FindLowestFirstParameter[
AA_,AA_[arglist_],arglii_,lowlist2_]:=
Module[{i,low1},
low1 = lowlist2[[1]];
(* finds minimal n-value in calls of func and writes this value in
global variable low *)
      If[SameQ[arglist[[1]],0],
        If[(low1>0),
           low1=0,Null(* else do nothing *),(* 1st appearance *) low1=0
          ],
        If[(low1-arglist[[1]]>0),
          low1=arglist[[1]],
          Null(* else do nothing *),
          (* 1st appearance *)
          low1=arglist[[1]]
          ]
        ];
(arglist/.arglist[[1]]->low1)
]/;SameQ[Head[arglist[[1]]],Integer];

FindLowestFirstParameter[AA_,expr_,arglii_,lowlist2_]:=
Module[{i,lowlist1,arglist},
lowlist1 = lowlist2;
Table[lowlist1 = 
FindLowestFirstParameter[AA,expr[[i]],arglii,lowlist1],{i,1,Length[expr]}];
lowlist1
]/;
(Length[expr]>0);

FindLowestFirstParameter[AA_,expr_,arglii_,lowlist2_]:=lowlist2;

FindHighestFirstParameter[
AA_,AA_[arglist_],arglii_,highlist2_]:=
Module[{i,high1},
high1 = highlist2[[1]];
(* finds maximal n-value in calls of func and writes this value in
global variable high *)
      If[SameQ[arglist[[1]],arglii[[1]]],
        If[(high1- arglii[[1]]<0),
           high1=arglii[[1]],
            Null(* else do nothing *),
          (* 1st appearance *) high1=arglii[[1]]
          ], 
        If[(high1-arglist[[1]]<0),
          high1=arglist[[1]],
          Null(* else do nothing *),
          (* 1st appearance *)
          high1=arglist[[1]]
          ]
        ];
(arglist/.arglist[[1]]->high1)
]/;!SameQ[Head[arglist[[1]]],Integer](* Module Find... *);

FindHighestFirstParameter[
AA_,AA_[arglist_],arglii_,highlist2_]:=
Module[{i,high1},
high1 = highlist2[[1]];
(* finds maximal n-value in calls of func and writes this value in
global variable high *)
      If[SameQ[arglist[[1]],0],
        If[(high1<0),
           high1=0,Null(* else do nothing *),(* 1st appearance *) high1=0
          ],
        If[(high1-arglist[[1]]<0),
          high1=arglist[[1]],
          Null(* else do nothing *),
          (* 1st appearance *)
          high1=arglist[[1]]
          ]
        ];
(arglist/.arglist[[1]]->high1)
]/;SameQ[Head[arglist[[1]]],Integer];

FindHighestFirstParameter[AA_,expr_,arglii_,highlist2_]:=
Module[{i,highlist1,arglist},
highlist1 = highlist2;
Table[highlist1 = 
FindHighestFirstParameter[AA,expr[[i]],arglii,highlist1],{i,1,Length[expr]}];
highlist1
]/;
(Length[expr]>0);

FindHighestFirstParameter[AA_,expr_,arglii_,highlist2_]:=highlist2;

func = Head[recursion[[1]]];
argli = recursion[[1]]/.func -> List;
tail = recursion[[2]]/.func-> A;
tail = tail/. A[argl___] -> A[{argl}];
n = argli[[1]];
expr2 = expr1/. func-> A;
expr2 = expr2/. A[argl___] -> A[{argl}];
initlist = {aetzi,fetzi};

(* compute the range of n in expr   *)
lowlist = FindLowestFirstParameter[A,expr2,argli,initlist];
low = lowlist[[1]];
highlist=  FindHighestFirstParameter[A,expr2,argli,initlist];
high= highlist[[1]];
 range = high - low;
(* compute the range of n in recursion   *)
Arecursion = recursion[[2]] /.func->A;
Arecursion = Arecursion/.A[argl___] -> A[{argl}];
reclowlist = 
   FindLowestFirstParameter[A,Arecursion,argli,initlist];
reclow   = reclowlist[[1]];
 recrange = recursion[[1,1]] - reclow; 
 If[recrange > range+1,Return[expr1]];
 expr3 = expr2;
 expr3 = SimpByRecursion1[A,expr3,low,recrange,argli,tail];
highlist3=  FindHighestFirstParameter[A,expr3,argli,initlist];
high3 = highlist3[[1]];
lowlist3 =  FindLowestFirstParameter[A,expr3,argli,initlist];
low3 = lowlist3[[1]];
range3 = high3 -low3;
 expr3 =Expand[expr3];
For[i= low3, i-low3 <=high3-low3,++i,
 lowpluslist = lowlist3/.low3->i;
 expr3 = Collect[expr3, A[lowpluslist]];
] (* for  *);
length = Length[expr3];
 expr3 = expr3/.A[{argl___}]-> A[argl];
 expr3 = expr3/.A-> func;
 For[i=1,i<=length,++i,
  If[Length[expr3[[i]]]>1,
   If[SameQ[Head[Last[expr3[[i]]]],func], 
    hold = Expand[expr3[[i]]/Last[expr3[[i]]]];
    hold = Together[hold];
    expr3 =
    expr3/.expr3[[i]]->hold * Last[expr3[[i]]]
  ] (*if SameQ *)
 ] (* If Length  *)
] (*for  *);
If[(range - range3== 0  )&& (Length[Expand[expr1]]<=Length[Expand[expr3]]),
expr1,expr3]
]  (* Module SimpByRecursion   *)

Clear[AbsRules,SimpSqrt]

SimpSqrt[Abs[x_]^p_]:=(Abs[x]^Mod[(p/2),2]*x^((p/2)-Mod[(p/2),2]))

SimpSqrt[x_^p_]:=(Abs[x]^Mod[(p/2),2]*x^((p/2)-Mod[(p/2),2]))/;IntegerQ[p/2]

SimpSqrt[x_]:= Sqrt[x]

ArcTanhRule={E^(ArcTanh[xx_]*(yy_.)) -> ((1 + xx)/(1 - xx))^(yy/2)}

AbsRules= {Abs[xxx_] Sign[xxx_]->xxx,
	   Abs[xxx_]^2->xxx^2,
	   Sign[xxx_]/Abs[xxx_]->1/xxx,
           Sqrt[xxx_^2]->Abs[xxx],
           (xxx_^4)^(1/4)->Abs[xxx],
           Sqrt[1/xxx_^2]->1/Abs[xxx],
           1/Sqrt[xxx_^2]->1/Abs[xxx],
           Sqrt[xxx_^4]->xxx^2,
           Sqrt[1/xxx_^4]->1/xxx^2,
           Sign[xxx_]^2 ->  1,
           1/Sqrt[xxx_^4]->1/xxx^2,
           Sin[yyy_. Abs[xxx_]]->Sign[xxx] Sin[yyy xxx],
           Cos[yyy_. Abs[xxx_]]->Cos[yyy xxx],
           Tan[yyy_. Abs[xxx_]]->Sin[yyy Abs[xxx]]/Cos[yyy Abs[xxx]],
           Cot[yyy_. Abs[xxx_]]->1/Tan[yyy Abs[xxx]],
           ArcSin[yyy_. Abs[xxx_]]->Sign[xxx] ArcSin[yyy xxx],
           ArcTan[yyy_. Abs[xxx_]]->Sign[xxx] ArcTan[yyy xxx],
           ArcCot[yyy_. Abs[xxx_]]->Sign[xxx] ArcCot[yyy xxx],
           ArcCos[yyy_. Abs[xxx_]]->Pi/2-ArcSin[yyy Abs[xxx]],
           Sinh[yyy_. Abs[xxx_]]->Sign[xxx] Sinh[yyy xxx],
           Cosh[yyy_. Abs[xxx_]]->Cosh[yyy xxx],
           Tanh[yyy_. Abs[xxx_]]->Sinh[yyy Abs[xxx]]/Cosh[yyy Abs[xxx]],
           Coth[yyy_. Abs[xxx_]]->1/Tanh[yyy Abs[xxx]],
           ArcSinh[yyy_. Abs[xxx_]]->Sign[xxx] ArcSinh[xxx yyy],
           ArcTanh[yyy_. Abs[xxx_]]->Sign[xxx] ArcTanh[xxx yyy],
           ArcCoth[yyy_. Abs[xxx_]]->Sign[xxx] ArcCoth[xxx yyy],
           E^(n_. Abs[xxx_])->
            ((E^(n xxx)+E^(-n xxx)+Sign[xxx] (E^(n xxx)-E^(-n xxx)))/2),
           Erf[yyy_. Abs[xxx_]]->Sign[xxx] Erf[yyy xxx]
          }

(* everything necessary for SimpI.  SimpI saves us from a lot of trouble
with complex numbers *) 
Clear[ExcludeTermsWithNonFactorialDenominators,MFD,MFD1,SimpI]

ExcludeTermsWithNonFactorialDenominators[expr___]:= Module[{list,newl,i,jj},
list = Level[expr,1];
newl = {};
For[i=1,i<=Length[list], ++i,
    If[!FreeQ[Denominator[list[[i]]],Factorial], AppendTo[newl,list[[i]]]]
   ];
If[(newl == {}),
   Null,
   Sum[newl[[jj]],{jj,1,Length[newl]}]
  ]
]/;!FreeQ[expr,Factorial]

ExcludeTermsWithNonFactorialDenominators[expr_]:=Null/;FreeQ[expr,Factorial]


(* MFD computes the maximal factorial denominator, i.e
 MFD[expr] * expr should not contain factorials  *)

MFD[expr___]:= MFD1[ExcludeTermsWithNonFactorialDenominators[expr]]

MFD1[v1_/(w1_)! + expr_] := Module[{expr1},
expr1 = expr*w1!;
expr1 = Expand[expr1];
expr1=  ExcludeTermsWithNonFactorialDenominators[expr1+v1];
w1!*MFD[expr1]
]

MFD1[v1_/(w1_)!]:=w1!;

MFD1[Null] := 1

SimpI[expr_]:=Simplify[Simplify[Map[SimpFactorial,Expand[MFD[expr]*expr]]]/MFD[expr]]

(* simplifying unpleasent pochhammers, products, and factorials  *)
Clear[ListOfIndependentTerms1,PPC,SimpProduct1,SimpProduct,QuadraticQ,
PochhammerProductCoefficient,SimpPochhammer,FindRecursion,SimpFactorial,
SimpPochhammer1]

ListOfIndependentTerms1[list1_,x_]:= Module[{lnew,
length,first,fraction,sum,i},
 lnew = {};
 length = Length[list1];
first = list1[[1]];
sum = first;
For[i=2, i<=length, i++,
 fraction = Factor[Cancel[first/list1[[i]]]];
 fraction = SimpSinCos[fraction];
 (* NEW Thu Mar 17 12:35:52 MET 1994 *)
 fraction = SimpFactorial[fraction];
 If [RationalQ[fraction,x],
 sum  += list1[[i]], (* rat. dependent  *)
 AppendTo[lnew,list1[[i]]] (* rat. indep  *)
    ]  (* if  *)
   ];  (* for   *)
sum = Simplify[sum];
{sum,ListOfIndependentTerms1[lnew,x]}
]/;(Length[list1]>1)

ListOfIndependentTerms1[list1_,x_]:= {list1}/;(Length[list1]<2)


QuadraticQ[f_,x_]:=Module[{},

Length[CoefficientList[f,x]]==3]/;PolynomialQ[f,x]

QuadraticQ[f_,x_]:=False;


PPC[term_,j_]:=PochhammerProductCoefficient[term,j]


PochhammerProductCoefficient[term_,j_]:=Module[{A,poly,c,yquadrat,x,B},
poly = Expand[term,j];
c= Coefficient[poly,j,2];
poly =poly/c;
A=Coefficient[poly,j,1];
B=Coefficient[poly,j,0];
x=Simplify[A/2 +1];
yquadrat=Simplify[B-(A^2)/4];
{c,x,yquadrat}
]/;QuadraticQ[Expand[term,j],j]

PochhammerProductCoefficient[term_,j_]:=Null;

SimpProduct[f_Plus] := Map[ SimpProduct[#]&,f ]
SimpProduct[ expr_/;Length[expr]>1 ] :=
   Module[ {p,sol},
     Off[Product::itform];
     sol=(expr/.{Product[_,_]:>1}) *
     SimpProduct1[ Times@@Cases[p PowerExpand[expr],
                     Product[_,_]^_.]];
     On[Product::itform];
     sol
   ] /;
 !FreeQ[expr,Product]


SimpProduct[v_] := v

SimpProduct1[ Times[v1___,Product[w1_,{jj_,jj1_,jj2_}]^n_.,v2___,
product[w2_,{jjj_,jjj1_,jjj2_}]^m_.]]:=
SimpProduct1[Times[v1,Product[(w1 /. jj-> jj + jj1 -
1),{jj,jj2-jj1+1}]^n,
             v2,     Product[(w2 /. jjj-> jjj +
jjj1-1),{jjj,jjj2-jjj1+1}]^m]]


SimpProduct1[ Times[v1___,Product[w1_,{jj_,jj1_,jj2_}]^n_.,v2___,
Product[w2_,{jjj_,jjj2_}]^m_.]]:=
SimpProduct1[Times[v1,Product[(w1 /. jj-> jj + jj1 -
1),{jj,jj2-jj1+1}]^n,
             v2,     Product[w2,{jjj,jjj2}]^m]]

SimpProduct1[ Times[v1___,Product[w1_,{jj_,jj2_}]^n_.,v2___,
Product[w2_,{jjj_,jjj1_,jjj2_}]^m_.]]:=
SimpProduct1[Times[v1,Product[w1,{jj,jj1,jj2}]^n,v2,
                      Product[(w2 /. jjj-> jjj + jjj1
-1),{jjj,jjj2-jjj1+1}]^m]]


SimpProduct1[ Times[v1___,Product[w1_,{j1_,k1_}]^n_.,v2___,
                              Product[w2_,{j2_,k2_}]^m_.] ] :=
    Module[ {p,c1,c2,x1,x2,y2quadrat,y1quadrat},
p = Min[ Abs[n], Abs[m] ];
      c1 = PPC[w1,j1][[1]];
      c2 = PPC[w2,j2][[1]];
      y1quadrat = PPC[w1,j1][[3]];
      y2quadrat = PPC[w2,j2][[3]];
      x1 = PPC[w1,j1][[2]];
      x2 = PPC[w2,j2][[2]];
If [(x1 === x2 )&& (y1quadrat === y2quadrat ),
      If[ (Simplify[k1-k2]===1),
           SimpProduct1[v1 v2 Product[w1,{j1,k}]^(n-p) *
               Product[w2,{j2,k2}]^(m+p)] *
              Simplify[((x1+k1-1)^2 + y1quadrat )  * c1^k1 * c2^-k2]^p,
        SimpProduct1[v1 v2 Product[w1,{j1,k}]^(n-p) *
               Product[w2,{j2,k2}]^(m+p)]*
              Simplify[ c1^k1 * c2^(-k2) / ((x1+k2-1)^2 + y1quadrat )
]^p
       ] (* if Simplify ...  *)
    ,(* else  x1 != x2 ... *)
   If [Simplify[x1 - x2] === Simplify[k2-k1],
     If[ Simplify[k1-k2] === 1,
           SimpProduct1[v1 v2 Product[w1,{j1,k}]^(n-p) *
               Product[w2,{j2,k2}]^(m+p)] *
              Simplify[(x1^2 + y1quadrat )  * c1^k1 * c2^-k2]^p,
        SimpProduct1[v1 v2 Product[w1,{j1,k}]^(n-p) *
               Product[w2,{j2,k2}]^(m+p)]*
              Simplify[ c1^k1 * c2^-k2 / (x1^2 + y1quadrat )  ]^p
      ](* if Simplify k1 - k2...  *)
    ]
]
]/;(( Abs[Simplify[k2-k1]]===1) && QuadraticQ[Expand[w1],j1] &&
         (IntegerQ[n]) && (n>0) &&  QuadraticQ[Expand[w2],j2] && (m<0))

SimpProduct1[v_]:= v

(* developed in Package Algebra`SymbolicSum` by Victor S. Adamchik *)

SimpPochhammer[f_Plus] := Map[ SimpPochhammer[#]&,f ]

 SimpPochhammer[ expr_/;Length[expr]>1 ] :=
   Module[ {p},
     (expr/.{Pochhammer[_,_]:>1}) *
     SimpPochhammer1[ Times@@Cases[p PowerExpand[expr],
                     Pochhammer[_,_]^_.]]
] /;
 !FreeQ[expr,Pochhammer]

 SimpPochhammer[v_] := v

SimpPochhammer1[ Times[v1___,Pochhammer[w1_,v_]^n_.,v2___,
                              Pochhammer[w2_,v_]^m_.] ] :=
    Module[ {p},
      p = Min[ Abs[n], Abs[m] ];
      If[ (w1-w2)===1,
           SimpPochhammer1[v1 v2 Pochhammer[w1,v]^(n-p) *
               Pochhammer[w2,v]^(m+p)] ((w2+v)/w2)^p,
           SimpPochhammer1[v1 v2 Pochhammer[w1,v]^(n-p) *
               Pochhammer[w2,v]^(m+p)] (w1/(w1+v))^p
        ]
    ]/; Abs[Simplify[w2-w1]]===1 && IntegerQ[n] && n>0 && m<0

SimpPochhammer1[ Times[v1___,Pochhammer[a_,k_]^n_.,v2___,
                              Pochhammer[a_,j_]^m_.] ] :=
    Module[ {p},
      p = Min[ Abs[n], Abs[m] ];
      If[ Simplify[k-j]>0,
         SimpPochhammer1[v1 v2 Pochhammer[a,k]^(n-p) *
             Pochhammer[a,j]^(m+p)] *Pochhammer[Simplify[a+j],Simplify[k-j]],
         SimpPochhammer1[v1 v2 Pochhammer[a,k]^(n-p) *
             Pochhammer[a,j]^(m+p)] /Pochhammer[Simplify[a+k],Simplify[j-k]]
        ]
]/; IntegerQ[Simplify[k-j]]&& IntegerQ[n] && n>0 && m<0

SimpPochhammer1[v_] := v(*//.PochToAlg*)

 SimpFactorial[ Times[v1___,(w1_)!^n_.,v2___,(w2_)!^m_.] ] :=
    Module[ {p},
      p = Min[ Abs[n], Abs[m] ];
      If[ Simplify[w2-w1]>0,
           SimpFactorial[v1 v2 (w1!)^(n-p) (w2!)^(m+p)]/
               Factor[Pochhammer[w1+1,Simplify[w2-w1]]^p],
           SimpFactorial[v1 v2 (w1!)^(n-p) (w2!)^(m+p)]*
               Factor[Pochhammer[w2+1,Simplify[w1-w2]]^p]
        ]
    ]/; IntegerQ[Simplify[w2-w1]] && IntegerQ[n] && n>0 && m<0

 SimpFactorial[ v_ ] := v

(* end Algebra`SymbolicSum` by Victor S. Adamchik *)

Clear[ContainsOtherVariableThanC,AllPartsMultipliedByC,
EliminateNegativeBases,SimpConst,SimpConst1,DEout]


ContainsOtherVariableThanC[C[k_]]:= False

ContainsOtherVariableThanC[expr_]:= Module[{i,contains},
contains = False;
For[i=1,(i<=Length[expr]) && !contains, ++i,
   If[ContainsOtherVariableThanC[expr[[i]]],contains =  True]
   ];
contains
]/; (Length[expr] >0 )

ContainsOtherVariableThanC[expr_]:= (SameQ[Symbol,Head[expr]] &&
                                    !SameQ[expr,Pi]&&
                                    !SameQ[expr,I]&&
                                    !SameQ[expr,E])/;Length[expr]==0

AllPartsMultipliedByC[expr_]:=Module[{jj,i,notmultbyC},
For[i=1,i<=Length[expr],++i,
    If[SameQ[Head[expr[[i]]],Times],
       notmultbyC=True;
       For[jj=1,jj<=Length[expr[[i]]],++jj,
           If [SameQ[Head[expr[[i,jj]]],C],
               notmultbyC=False]
          ];
       If[notmultbyC,Return[False]],
       If[!SameQ[Head[expr[[i]]],C],Return[False]]
    ]
   ] (*for*);
   True
   ]

EliminateNegativeBases[(num_+x_)^k_,x_]:=((Abs[num]+
                        x*Sign[num])^k)/; NumberQ[num]

EliminateNegativeBases[(num_-x_)^k_,x_]:=((Abs[num]-
                        x*Sign[num])^k)/; NumberQ[num]

EliminateNegativeBases[expr_,x_]:=Module[{i,length,newexpr},
length = Length[expr];
 newexpr = Table[EliminateNegativeBases[expr[[i]],x],{i,1,length}];
 newexpr/. List -> Head[expr]
	]/;((Length[expr]>=2)&&(SameQ[ Head[expr],Times]||SameQ[
Head[expr],Plus]))

EliminateNegativeBases[expr_,x_]:=expr


Clear[EliminateNegativeLogarithms,
ContainsNegativeSumment,
EliminateNegativeLogarithms1]

EliminateNegativeLogarithms[expr1_]:= Module[{order},

ContainsNegativeSumment[expr2_]:=Module[{(*i,length*)},
If[NumberQ[expr2]&&Negative[expr2], Return[True],
If[SameQ[Head[expr2],Plus],
length = Length[expr2];
For[i=1,i<=length,++i,
    If[NumberQ[expr2[[i]]]&&Negative[expr2[[i]]],Return[True]]
   ]
  ](*if *)
  ](*if *);
False](*/;(Length[expr2]>0)*);

EliminateNegativeLogarithms1[expr_]:=Module[{termlist,term,i,jj,newexpr},
newexpr = expr;
If[SameQ[Head[newexpr],Log]&&ContainsNegativeSumment[Expand[newexpr[[1]]]],
newexpr = Log[EliminateNegativeLogarithms1[Expand[(-1)*newexpr[[1]]]]]*
        C[++order],
length = Length[newexpr];termlist={};
Do[AppendTo[termlist,EliminateNegativeLogarithms1[newexpr[[i]]]],{i,1,length}];
   termlist/.(List->Head[newexpr])
   ](* If *)
   ]/;(Length[expr]>0) ;(* Module *)

EliminateNegativeLogarithms1[expr_]:=(expr/;(Length[expr] == 0));

order = COrder[expr1];
EliminateNegativeLogarithms1[expr1]
]



(* outer invocation needed to set the global variable kk *)

SimpConst[expr_] := SimpConst[expr,x]

SimpConst[expr2_,xx_]:=Module[{finalexpr,order1,kk},

SimpConst1[expr_,x_]:=Module[{expr1,expr3,length,head,addconst,varlist,i,j,k,
const},
expr1 = expr;
expr3=PowerExpand[Map[Together,expr1]];
If[FreeQ[expr3,ArcTanh],
expr1 = expr3];
expr1 = expr1 /. Power[E, Times[Complex[0,b_], xxx_]]->Cos[b xxx]+ I*Sin[b xxx];
expr1 = Simplify[expr1];
If[Not[Contains[expr1,C]],
   Return [expr1],
  (* else *)
  varlist ={};
  length = Length[expr1];
  j=0;const =False;addconst = True;
  For[i=1,i<=length,++i,
      subexpr= SimpConst1[expr1[[i]],x];
      If[Contains[subexpr,x],
         needed= True;
         If[varlist != {},
         For[k=1,k<=Length[varlist],++k,
         If[!ContainsOtherVariableThanC[Together[varlist[[k]]/subexpr]],
         needed = False];
           ]
	 ];(* If varlist  *)
	 If[SameQ[Head[subexpr],Plus]&&
            AllPartsMultipliedByC[subexpr],
         addconst= False];
	 If[needed,AppendTo[varlist,subexpr]],
       (* else Contains*)
         const = True
	 ](* IF Contains *)
        ];(* For  *)
  head = Head[expr1];
  If[SameQ[head,Plus]&&Not[const],addconst=False];
  If[addconst&&const,AppendTo[varlist,C[++kk]]];
  If[(Length[varlist] == 1)&&SameQ[head,Power],
    Return[C[kk]]];
  newlist = varlist/. List -> head;
  If[SameQ[head,Times],
          newlist=EliminateNegativeBases[newlist,x]];
  newlist
  ]
   ] /; (Length[expr]>1);

SimpConst1[expr_,x_]:=expr;

kk=order1;
finalexpr = SimpConst1[expr2,xx];
order1=0;
finalexpr
]

Clear[SimpSinCos,HolonomicDE,HolonomicRE]

SimpSinCos[Csc[xx_]]:= 1/SimpSinCos[Sin[xx]]
SimpSinCos[Sec[xx_]]:= 1/SimpSinCos[Cos[xx]]

SimpSinCos[Sin[xx_]]:=(Sin[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4)/(2*Pi)]])
SimpSinCos[Sin[xx_]]:=Sqrt[2]/2 * (Sin[Pi*k/4]+
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-Pi/4)/(2*Pi)]]

SimpSinCos[Sin[xx_]]:=Cos[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4-Pi/2)/(2*Pi)]]
SimpSinCos[Sin[xx_]]:=Sqrt[2]/2 * (-Sin[Pi*k/4]+
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-3*Pi/4)/(2*Pi)]]

SimpSinCos[Sin[xx_]]:=-Sin[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4-Pi)/(2*Pi)]]
SimpSinCos[Sin[xx_]]:=-Sqrt[2]/2 * (Sin[Pi*k/4]+
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-5*Pi/4)/(2*Pi)]]

SimpSinCos[Sin[xx_]]:=-Cos[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4-6*Pi/4)/(2*Pi)
]]
SimpSinCos[Sin[xx_]]:=Sqrt[2]/2 * (Sin[Pi*k/4]-
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-7*Pi/4)/(2*Pi)]]

SimpSinCos[Cos[xx_]]:=Cos[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4)/(2*Pi)]]
SimpSinCos[Cos[xx_]]:=Sqrt[2]/2 * (-Sin[Pi*k/4]+
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-Pi/4)/(2*Pi)]]

SimpSinCos[Cos[xx_]]:=-Sin[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4-Pi/2)/(2*Pi)]]
SimpSinCos[Cos[xx_]]:=-Sqrt[2]/2 * (Sin[Pi*k/4]+
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-3*Pi/4)/(2*Pi)]]

SimpSinCos[Cos[xx_]]:=-Cos[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4-Pi)/(2*Pi)]]
SimpSinCos[Cos[xx_]]:=Sqrt[2]/2 * (Sin[Pi*k/4]-
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-5*Pi/4)/(2*Pi)]]

SimpSinCos[Cos[xx_]]:=
Sin[Pi*k/4]/;IntegerQ[Simplify[(xx-Pi*k/4-6*Pi/4)/(2*Pi)]]
SimpSinCos[Cos[xx_]]:=Sqrt[2]/2 * (Sin[Pi*k/4]+
Cos[Pi*k/4])/;IntegerQ[Simplify[(xx-Pi*k/4-7*Pi/4)/(2*Pi)]]

SimpSinCos[expr_]:=
(Table[SimpSinCos[expr[[i]]],{i,1,Length[expr]}]/.
  List->Head[expr])/;(Length[expr]>1)

SimpSinCos[expr_]:= expr

HolonomicDE[ffff___]:=SimpleDE[ffff]

HolonomicDE[ffff___]:=Module[{},
Print["specfun-warning: Please unassign f with Clear[f] to use HolonomicDE."];
HoldForm[HolonomicDE[ffff]]]/;(!SameQ[Head[Global`f],Symbol]
   !SameQ[ToString[Head[Global`f[anything___]]],"f"])

HolonomicRE[ffff___]:=FindRecursion[ffff]

HolonomicDE[ffff___]:=Module[{},
Print["specfun-warning: Please unassign a with Clear[a] to use HolonomicRE."];
HoldForm[HolonomicRE[ffff]]]/;(!SameQ[Head[Global`a],Symbol]
   !SameQ[ToString[Head[Global`a[anything___]]],"a"])

FindRecursion[fkt_,a_[k_]]:=FindRecursion[fkt,k,a]

FindRecursion[fkt_,k_]:=FindRecursion[fkt,k,Global`a]

FindRecursion[fkt_,k_,a_]:=Module[{},
Print["specfun-info: ",InputForm[k]," is not a valid variable."];
HoldForm[FindRecursion[fkt,k,a]]]/;!SameQ[Head[k],Symbol]

FindRecursion[fkt_,k_,a_]:=Module[{},
Print["specfun-warning: Please unassign a with Clear[a],
or use another symbol as fourth argument of FindRecursion."];
HoldForm[FindRecursion[fkt,k,a]]]/;(!SameQ[Head[Global`a],Symbol]||
    !SameQ[ToString[Head[Global`a[anything___]]],"a"])

FindRecursion[fkt_,k_,a_]:=Module[{solutionfr},
If[SpecialFunctionsPrintMessages,
Print[specfuninfo]];
solutionfr=FR[fkt,k,a];
If[SpecialFunctionsPrintMessages,Print["specfun-info: RE:"]];
solutionfr
](* Module FindRecursion*)


(* module convert *)

theta[f_,x_]:=x D[f,x]

backsubst[eq1_+eq2_,n_,f_,x_]:=backsubst[eq1,n,f,x]+backsubst[eq2,n,f,x]
backsubst[c_*eq_,n_,f_,x_]:=c*backsubst[eq,n,f,x] /;
        (FreeQ[c,n] && FreeQ[c,f] && FreeQ[c,x])

backsubst[a_[n_+m_.],n_,f_,x_]:=f[x]/x^m
backsubst[n_^j_.*a_[n_+m_.],n_,f_,x_]:=theta[backsubst[n^(j-1)*a[n+m],n,f,x],x]
backsubst[p_*a_[n_+m_.],n_,f_,x_]:=
backsubst[Expand[p*a[n+m]],n,f,x] /;
        PolynomialQ[p,n]

REtoDE[re_,a_[k_]]:=REtoDE[re,a,k,Global`f,Global`x]

REtoDE[re_,a_[k_],f_[x_]]:=REtoDE[re,a,k,f,x]

REtoDE[re_,a_,k_]:=REtoDE[re,a,k,Global`f,Global`x]

(* Here is really something new *)
(* old
REtoDE[re_,a_,k_,F_,x_]:=Module[
  {recursion,containsk,recursionfactor,recursionpart,jj,de,anything,n},
  If[SameQ[Head[re],Equal],recursion=re[[1]]-re[[2]],recursion=re];
  recursion = Collect[recursion,a[k]];
  recursionfactor=1;
  Do[
  recursionpart[jj]=(recursion[[jj]]/(recursion[[jj]] /. a[anything_]->1))[[1]];
  containsk[jj]=recursionpart[jj]
  ,
  {jj,2,Length[recursion]}];
  recursionfactor=Product[containsk[jj],{jj,2,Length[recursion]}];
  recursion=Collect[recursion*recursionfactor,a[k]];
  de = backsubst[(recursion/.k->n),n,F,x];
  de = Numerator[Together[de]];
  While[NumberQ[Denominator[Together[de/x]]],de= Expand[de/x]];
  de == 0
]
*)

(* Diese Funktion macht ohne Angabe des Bereichs der Rekursion wenig Sinn ! *)
(* Annahme k>=0 *)
REtoDE[re_,a_,k_,F_,x_]:=Module[
  {recursion,containsk,recursionfactor,recursionpart,jj,de,anything,n},
  If[SameQ[Head[re],Equal],recursion=re[[1]]-re[[2]],recursion=re];
  recursion = Collect[recursion,a[k]];
  recursionfactor=1;
  Do[containsk[jj]=1;
  recursionpart[jj]=(recursion[[jj]]/(recursion[[jj]] /. a[anything_]->1))[[1]];
  If[
  Not[SameQ[Simplify[(recursion /. k->-Coefficient[recursionpart[jj],k,0]) /.
  a[anything_]-> If[anything<0,0,(ak/.k->anything)]],0]],
  containsk[jj]=recursionpart[jj]]
  ,
  {jj,2,Length[recursion]}];
  recursionfactor=Product[containsk[jj],{jj,2,Length[recursion]}];
  recursion=Collect[recursion*recursionfactor,a[k]];
  xshift=SmallestZeroOfPolyminal[Last[recursion]/a[k],k]; 
  de = backsubst[recursion,k,F,x];
  DE = de = Numerator[Together[de]];
  While[NumberQ[Denominator[Together[de/x]]],de= Expand[de/x]];
  de == 0
]

SumtoDE[Global`sum[expr_.*x_^k_,{k_,0,Infinity}],x_]:=
SumtoDE[Global`sum[expr*x^k,{k,0,Infinity}],x,Global`f]

SumtoDE[Global`sum[expr_.*x_^k_,{k_,0,Infinity}],f_[x_]]:=
SumtoDE[Global`sum[expr*x^k,{k,0,Infinity}],x,f]

SumtoDE[Global`sum[expr_.*x_^k_,{k_,0,Infinity}],x_,f_]:=
Module[{},
Print["specfun-warning: Please Clear[f], or use another symbol as
fifth argument of SumtoDE."];
HoldForm[SumtoDE[Sum[expr*x^k,{k,0,Infinity}],x,f]]]/;
(!SameQ[ToString[Head[Global`f[anything___]]],"f"]||
Not[SameQ["f",ToString[Global`f]]])&&SameQ[f,Global`f]

(* no other initial indices supported *)
SumtoDE[Global`sum[expr_.*x_^k_,{k_,0,Infinity}],x_,F_]:=Module[
  {anything,ak,recursion,de,recursionfactor,containsk,recursionpart,a},
  ak=expr;
  recursion=FindRecursion[expr,k,a][[1]];
  (*de = REtoDE[recursion,a,k,F,x]*)
  recursionfactor=1;
  Do[containsk[jj]=1;
  recursionpart[jj]=Together[(recursion[[jj]]/(recursion[[jj]] /.  
  a[anything_]->1))][[1]];
  If[
  Not[SameQ[Simplify[(recursion /.  k->-Coefficient[recursionpart[jj],k,0]) /.
  a[anything_]-> If[anything<0,0,(ak/.k->anything)]],0]],
  containsk[jj]=recursionpart[jj]]
  ,
  {jj,2,Length[recursion]}];
  recursionfactor=Product[containsk[jj],{jj,2,Length[recursion]}];
  recursion=Collect[recursion*recursionfactor,a[k]];
  de = backsubst[recursion,k,F,x];
  DE = de = Numerator[Together[de]];
  While[NumberQ[Denominator[Together[de/x]]],de= Expand[de/x]];
  de == 0
]
(* old
  recursion= recursion/.Global`a->SpecialFunctions`Private`a;
  If[SpecialFunctionsPrintMessages&&!SameQ[recursion,1],
     Print["         ",InputForm[recursion/.{a->Global`a,k->Global`k}]==0]];
  recursion = Collect[recursion,a[k]];
  recursionfactor=1;
  Do[containsk[jj]=1;
  recursionpart[jj]=(recursion[[jj]]/(recursion[[jj]] /.
a[anything_]->1))[[1]];
  If[Not[SameQ[Simplify[(recursion /.
k->-Coefficient[recursionpart[jj],k,0]) /.
  a[anything_]-> If[anything<0,0,(ak/.k->anything)]],0]],
  containsk[jj]=recursionpart[jj]]
  ,
  {jj,2,Length[recursion]}];
  recursionfactor=Product[containsk[jj],{jj,2,Length[recursion]}];
  recursion=Collect[recursion*recursionfactor,a[k]];
  de = backsubst[recursion,k,F,x];
  de = Numerator[Together[de]];
  While[NumberQ[Denominator[Together[de/x]]],de= Expand[de/x]];
  DE0ut[de,F,x]
*)

solve[eq_]:=DSolve[Simplify[backsubst[eq,n,f,x]]==0,f[x],x]

Clear[CRefresh,Contains,COrder,SumToDE,Convert,Convert1,ReverseEx,DEOrder]

Unprotect[DEOrder]

Contains[expr_,x_]:= Module[{contains,i},
contains = False;
If[SameQ[Head[expr],x], contains = True];
For[i=1,(i<=Length[expr]) && !contains, ++i,
   If[Contains[expr[[i]],x]||SameQ[x,expr],contains = True]
   ];
contains
]/; (Length[expr] != 0)

Contains[expr_,x_]:= SameQ[x,expr]

DEOrder[de_,y_[x_]]:=DEOrder[de,y,x]

DEOrder[de_,y_,x_]:=Module[{X,DE,delist,k,n},
        If[SameQ[Head[de],Equal],DE=Expand[de[[1]]-de[[2]]],DE=Expand[de]];
        DE=(DE /. y[x]->1);
        DE=(DE /. Derivative[n_][y][x]->X^n);
        delist=CoefficientList[DE,X];
        Length[delist]-1];


SmallestZeroOfPolyminal[expr_,k_]:=Module[{zero,max,length,expr1,var},
expr1 = Factor[expr];
length = Length[expr1];
max =0;
For[i=1,i<=length,++i,
   If [!NumberQ[expr1[[i]]],
     If [ SameQ[Head[expr1[[i]]],Power],var = expr1[[i,1]],
      var = expr1[[i]]
      ];
      If[ SameQ[Head[expr1[[i]]],Symbol],var = k];
      zero = Solve[var==0,k];
     If[Not[SameQ[Flatten[zero],{}]], 
       If [Abs[zero[[1,1,2]]]>max,
      max = Abs[Solve[var==0,k][[1,1,2]]]]
      ]
     ]
   ];
max]


COrder[expr1_]:=
Module[{max,i,expr,length},
expr =expr1;
max = 0;
For[i=1,(i<=Length[expr]) , ++i,
   number = COrder[expr[[i]]];
   If[number >max ,max = number]
   ];
max]/; (Length[expr1]>1)


COrder[C[x_]]:=x

COrder[t_]:=0 /; Not[SameQ[C,Head[t]]] && (Length[t]<2)

DashTimes[k_]:=Module[{join},
join = "";
For[i=1,i<=k,++i,
join = StringJoin[join,"'"]];
join
]

Clear[InBrackets,LLast,PlusCoeffTimesDeriv]

DEout[de_,y_,x_]:=Module[{X,DE(*delist*),k,n},

PlusCoeffTimesDeriv[0,yy_,xx_,kk_,isfirst_]:="";
PlusCoeffTimesDeriv[-1,yy_,xx_,kk_,isfirst_]:=StringJoin[" - ",ToString[yy],
DashTimes[kk-1],"[",ToString[xx],"]"];
PlusCoeffTimesDeriv[coeff_,yy_,xx_,kk_,isfirst_]:=
	  StringJoin[" + ",InBrackets[coeff],
	   ToString[yy],DashTimes[kk-1],"[",ToString[xx],"]"]/;
                           !(SameQ[coeff,0]||
			     SameQ[InBrackets[coeff],"-"]||
			     isfirst);
PlusCoeffTimesDeriv[coeff_,yy_,xx_,kk_,isfirst_]:=StringJoin[InBrackets[coeff],
ToString[yy],DashTimes[kk-1],"[",ToString[xx],"]"]/;
			   !(SameQ[coeff,0]||
			   SameQ[InBrackets[coeff],"-"])&&
			   isfirst;
				
InBrackets[1]:="";
InBrackets[-1]:="-";
InBrackets[expr_]:=Module[{},
    LLast[xxx_]:=Last[xxx]/; (Length[xxx]>0);
    LLast[xxx_]:=xxx/;(Length[xxx]===0);
    If[(NumberQ[expr]&&
    (((Re[expr]===0) && (Im[expr]>0))||
	Positive[expr]))||
	  SameQ[Head[expr],Symbol]||
             (SameQ[Head[expr],Times]&&
	     (!NumberQ[expr[[1]]]||
              !Negative[expr[[1]]]||
	      (!((Re[expr[[1]]]===0)&&(Im[expr[[1]]]<0))&&
	      SameQ[Head[expr[[1]]],Complex])
	     )),
	 Return[StringJoin[ToString[InputForm[expr]]," "]],
          Return[StringJoin["(",ToString[InputForm[expr]],") "]]
	 ]
];
FirstNonZero[liste_]:=Module[{},
 length = Length[liste];
 For[i=1,i<=length,++i,
  If[Not[SameQ[liste[[i]],0]],Return[i]]
];
Return[0]
];

        If[SameQ[Head[de],Equal],DE=Expand[de[[1]]-de[[2]]],DE=Expand[de]];
        DE=(DE /. y[x]->1);
        DE=(DE /. Derivative[n_][y][x]->X^n);
        delist=CoefficientList[DE,X];
	first = FirstNonZero[delist];
	join = "";
        Do[join =StringJoin[
	PlusCoeffTimesDeriv[Factor[delist[[k]]],y,x,k,(k == first)],join],
        {k,Length[delist],2,-1}];
	join = StringJoin[join," == 0"];
	If[first == 1 ,
	join = StringJoin[InBrackets[Factor[delist[[1]]]],ToString[y],"[",
	       ToString[x],"]",join]
	  ];

        join	
] 

ComputeQlist[ak_,sol_,order_,xshift_,x_,k_]:=Module[{qlist,
                                          eq,makessense,
                                          left,right,maxlimitcount,
					  limitcount,islimit,neworder
					  },
undefined[z_] := SameQ[Head[z],DirectedInfinity] ||
                 SameQ[z,Indeterminate] ||
                 MemberQ[Map[Head,Level[z,-1]],DirectedInfinity] ||
                 MemberQ[Level[z,-1],Indeterminate];

(* enhanced limit functions *)
limit[a_,b_] := Module[{l,r,r2,length},
                      Off[Limit::nlm,Power::infy,Infinity::indet];
                      r=a/.b;
                      If[undefined[r],
                          l=Limit[a,b];
                       If[Not[SameQ[Head[l],Limit]], r=l],
                      (* else  *)
                       r2= r/.transformspecial1;
                       If[!SameQ[r,r2],
                          l=Limit[a,b];
                         If[Not[SameQ[Head[l],Limit]], r=l]
                         ]
                        ](* if undefined *);
                      On[Limit::nlm,Power::infy,Infinity::indet];
                      Return[r]
                     ];


       neworder = order;
       limitcount=infcount = 0;maxinfcount=maxlimitcount=2;
       qlist={};
       makessense=True;
       If[SpecialFunctionsPrintMessages,
            Print["specfun-info: Calculation of initial values..."]];
       If[SameQ[Head[xshift],Integer],
          inte = True,
          inte = False];
       If[SameQ[Head[xshift],Rational],
          rat = True;
	    newxshift =xshift;
	    q =  Denominator[newxshift];
            p = Numerator[newxshift],
          rat = False
          ];
	  Csol={{}};
          If[inte,p=xshift];
       If[inte||rat,
            For[ii=0,
	      makessense&&Length[Csol[[1]]]<neworder,
            ++ii,
	    If[inte,
                powerfunction = Simplify[D[x^xshift*sol[[1,1,2]],{x,ii}]];
                powerfunction2= PowerExpand[Map[Together,powerfunction]];
		If[(*FreeQ[powerfunction2,ArcTanh]*)True,
                powerfunction = powerfunction2];
                (* This is somewhat tricky AND dubious *)
                powerfunction = (powerfunction /.
                (x^yy_/;Not[SameQ[Variables[yy],{}]]->1));
	       left= limit[Expand[powerfunction],x->0]/ii!;
             right = If[ii-xshift<0,0,limit[(ak/.k->k-xshift),k->ii]],
	      (* else xshift rational  *)
                powerfunction= Simplify[D[x^p*(sol[[1,1,2]] /. x->x^q),{x,ii}]];
                powerfunction2=
                PowerExpand[Map[Together,powerfunction]];
                If[(*FreeQ[powerfunction2,ArcTanh]*)True,
                powerfunction = powerfunction2];
                (* This is somewhat tricky AND dubious *)
                powerfunction = (powerfunction /.
                (x^yy_/;Not[SameQ[Variables[yy],{}]]->1));
		left= limit[Expand[powerfunction],x->0]/ii!;
	      If[SameQ[Mod[ii,q],Mod[p,q]] && ii>=p,right = 
	      limit[(ak/.k->(k-p)/q),k->ii],right = 0]
           ]; (* If inte *)
	    If[SameQ[left,Indeterminate],
	    Print["specfun-info: Indeterminate encountered"];
	    ConvertReturnValue=2;
	    Return[sol[[1,1,2]]]];
	    If[!FreeQ[left,Infinity]||
               !FreeQ[left,ComplexInfinity]||
               !FreeQ[left,DirectedInfinity]||
               !FreeQ[right,Infinity]||
               !FreeQ[right,ComplexInfinity]||
               !FreeQ[right,DirectedInfinity],
                  ++infcount,
	      islimit= !FreeQ[left,Limit]|| !FreeQ[right,Limit];
	      If[islimit,AppendTo[limitlist,left];++limitcount];
              If[Not[SameQ[Simplify[left-right],0]]&&
	         Not[islimit], 
                eq = (left == right);
		If[SameQ[eq,False],
		 makessense = False;qlist ={};
		 If[SpecialFunctionsPrintMessages,
				  Print["specfun-info: wrong limit evaluation"]],
                 If[SpecialFunctionsPrintMessages,
                 Print["specfun-info: ",InputForm[eq]]];
	         AppendTo[qlist,eq]
		 ](* SameQ[eq,False] *)
                ](* if !SameQ *)
            ];	(* if !FreeQ *)
(* 3 reasons to stop calculation   *)
            If[(limitcount==maxlimitcount),
            If[SpecialFunctionsPrintMessages,
     Print["specfun-info: Mathematica is unable to compute ",limitcount,"
limit(s)"];
     Print["         They can be found in the global variable limitlist"];
     Print["specfun-info: unable to compute the following limits:  ",
       InputForm[limitlist]] ];
            makessense=False
              ];
            If[(infcount== maxinfcount),makessense=False;qlist ={};
            If[SpecialFunctionsPrintMessages,
     Print["specfun-info: too many (",maxinfcount,") infinities encountered"]]
              ];(*If(infcount== maxinfcount)*)
            If[ii>50, makessense=False;qlist={}];
            If[Length[qlist]<neworder,Csol={{}},
	    {Csoltime,Csol} =
	    Timing[Solve[qlist,Table[C[jj],{jj,1,neworder}]]]]
          ](* for *),
          qlist ={}
       ];  (* If[inte||rat ] *)
   qlist 
]


CRefresh[expr_,oldorder_]:=Module[{olist,nexpr,norder,i},
  nexpr = expr;
  norder = 0;
  olist ={};
  For[i=1,i<=oldorder,++i,
     If[Contains[expr,C[i]],
        AppendTo[olist,i];++norder]
     ];
   For[i=1,i<=norder,++i,
      nexpr= nexpr /. C[olist[[i]]]-> C[i]
      ];
   {nexpr,norder}
   ](*module *)

Clear[LogToArcSin]

LogToArcSin[expr_]:=Module[{a,b,r,c,d,length,i,bi,blist},
inbrackets = expr[[1]];
inbrackets = inbrackets /.Power[x_, Rational[1, 2]]->Sqrt1[x];
inbrackets = inbrackets /.Power[x_, Rational[-1,2]]->1/Sqrt1[x];
length =  Length[expr[[1]]];a =0; bi =0;
If[length<1,Return[expr]];
For[i=1,i<=length,++i,
If[FreeQ[inbrackets[[i]],Sqrt1],
   a += inbrackets[[i]],
   bi += inbrackets[[i]]
   ];
   ];(*for*)
blist =  bi/.Head[bi]->List;
inb = -1;
For[i=1,i<=Length[blist],++i,
blist[[i]]= blist[[i]]/.List->Head[bi];
If[SameQ[Head[blist[[i]]],Sqrt1],inb*=blist[[i,1]],
   inb*=blist[[i]]^2](* if *)
   ];
b= Sqrt[inb];
r= Simplify[Sqrt[a^2 +b^2]];
c = Together[b/(a+r)];
d = Together[c^2/(1+c^2)];
fin1=+Log[r]-2*I*ArcSin[Simplify[Sqrt[d]]];
fin2=fin1 /. ArcSin[Sqrt[1-xx_^2]]->Pi/2-ArcSin[xx];
fin1
]/;SameQ[Head[expr],Log]

LogToArcSin[expr_]:=Module[{expr2,i,clist,length},
expr2 = expr;
clist = {};
length = Length[expr2];
If[length<1,Return[expr]];
For[i=1,i<=length,++i,
AppendTo[clist, LogToArcSin[expr2[[i]]]]
](* for *);
expr2 = (clist/.List ->Head[expr2]);
expr2]/;Not[FreeQ[expr,Log]]


LogToArcSin[expr_]:= expr

(*
Clear[Gegenbauer0Print,GegenbauerWarning]

Gegenbauer0Print[GegenbauerC[kkk_,0,xxx_]]:= Module[{},
Print["specfun-info: GegenbauerC[",kkk,",0,",xxx,"] is not supported"];
Return [Null]
]

Gegenbauer0Print[expr_]:= Map[Gegenbauer0Print,expr]/;
Not[FreeQ[expr,GegenbauerC[kk_,aa_,xx_]]]

Gegenbauer0Print[expr_]:= Null

GegenbauerWarning[GegenbauerC[n_,a_,x_],list1_]:=
Module[{list,length,i,already},
list:= list1;already =False;
length= Length[list];
For[i=1,i<=length,++i,
If[SameQ[list[[i]],a],already = True];
] (* For *);
If[Not[NumberQ[a]],
If[!already,Print["specfun-warning: ", a," is assumed to be non-zero."]];
AppendTo[list,a]
] (* if !already  *);
list
]

GegenbauerWarning[function_,list1_]:=Module[{list,length,i},
list:= list1;
length= Length[function];
For[i=1,i<=length,++i,
list= GegenbauerWarning[function[[i]],list]
]  (* for  *)
]/;
   (Length[function]>0)&&!FreeQ[function,GegenbauerC]

GegenbauerWarning[function_,list_]:= list
*)

Clear[Convert,Convert1]

Convert[expr11_,x111_]:=Module[{},
Print["specfun-info: ",InputForm[x111]," is not a valid variable."];
HoldForm[Convert[expr11,x111]]]/;!SameQ[Head[x111],Symbol]


Convert[expr11_,x111_]:=Module[{},
Print["specfun-warning: Please unassign a with Clear[a]."];
HoldForm[Convert[expr11,x111]]]/;(!SameQ[Head[Global`a],Symbol]||
   !SameQ[ToString[Head[Global`a[anything___]]],"a"])

Convert[expr11_,x111_]:=Module[{(*expr111*)},
(* 
ConvertReturnValue=4 -> FindRecursion versagt
ConvertReturnValue=3 _> DSolve versagt
ConvertReturnValue=2 -> Konstanten ungeloest
ConvertReturnValue=1 -> Pattern spricht nicht an
ConvertReturnValue=0 -> Prozedurverlauf korrekt
ConvertReturnValue=-1 -> Prozedur abgebrochen

Angabe klappt nur korrekt, falls lediglich eine einzelne Summe
konvertiert wird.
*)
ConvertReturnValue=-1;

Convert1[ff_+g_,x_]:=Convert1[ff,x]+Convert1[g,x];
Convert1[a_*ff_,x_]:=a*Convert1[ff,x] /; FreeQ[a,x];
Convert1[ff_,x_]:= ff/;FreeQ[ff,x];
Convert1[x_^m_.,x_]:=x^m;
Convert1[Global`sum[expr_.*x_^(m_.*k_+b_.),{k_,n_,Infinity}],x_]:=
   Convert1[Global`sum[(expr/.k->k+n)*x^(m*k+(n*m+b)),{k,0,Infinity}],x]/;n!=0;

Convert1[Global`sum[expr_.*x_^(m_.*k_+b_.),{k_,0,Infinity}],x_]:=
Module[{i,j,jj,(*n,*)left,right(*ak,bk,recursion,order,
Csol,sol,neworder,containsk,de,xshift*)},
Off[DSolve::dnim,Solve::trace];
limitlist ={};
ak = expr(*/.  Sin[Times[Rational[1,n_], k, Pi]]->
 (E^(I*k*Pi/n) - E^((-I)*k*Pi/n));
ak =  ak /. Cos[Times[Rational[1,n_], k, Pi]]->(E^(I*k*Pi/n) +
E^((-I)*k*Pi/n))*);
{rectime,recursion}  = Timing[FindRecursion[ak,k,Global`a][[1]]];
If[!FreeQ[recursion,FindRecursion], ConvertReturnValue=4;
  Return[Sum[expr*x^(m*k+b),{k,0,Infinity}]]
  ];
  RE = recursion =  SimpSinCos[recursion];
  If[SpecialFunctionsPrintMessages&&!SameQ[recursion,1],
     Print["         ",InputForm[recursion/.{a->Global`a,k->Global`k}]==0]];
  If[FreeQ[recursion,k],
  Return[Sum[expr*x^(m*k+b),{k,0,Infinity}]]
  ,
  recursion = recursion/.Global`a[anything_]->
       SpecialFunctions`Private`a[anything];
  (* NEW to do *)
  recursion = Collect[recursion,a[k]];
  recursionfactor=1;
  Do[containsk[jj]=1;
  recursionpart[jj]=Together[(recursion[[jj]]/(recursion[[jj]] /. 
  a[anything_]->1))][[1]];
  If[
  Not[SameQ[Simplify[(recursion /. k->-Coefficient[recursionpart[jj],k,0]) /.
  a[anything_]-> If[anything<0,0,(ak/.k->anything)]],0]],
  containsk[jj]=recursionpart[jj]]
  ,
  {jj,2,Length[recursion]}];
  recursionfactor=Product[containsk[jj],{jj,2,Length[recursion]}];
  (* naechste Zeile war draussen (warum ?), FINAL, wieder drin *)
  recursion=Collect[recursion*recursionfactor,a[k]];
  (* check whether ak/.k->-1 == 0 *)
  Off[Infinity::indet];
  If[Not[PolynomialQ[Together[recursionfactor/(1+k)],k]],
  If[Not[Simplify[(ak/.k->-1)]===0],
        recursion=Map[Times[(1+k),#]&,recursion];
	recursion=Collect[recursion,a[k]];
  ]];
  On[Infinity::indet];
  (* recursion=Map[Times[recursionfactor,#]&,recursion]; *)
  xshift=SmallestZeroOfPolyminal[Last[recursion]/a[k],k]; 
  (* FINAL Versuch: statt de = backsubst[recursion,k,f,x]; *)
  de = RETODE[recursion,a,k,f,x][[1]];
  DE = de = Numerator[Together[de]];
  While[NumberQ[Denominator[Together[de/x]]],de= Expand[de/x]];
  (* FINAL grade mal raus Wed Sep 18 14:36:43 MET DST 1996 
  numberlist=Union[Map[Plus[#,-k]&,Cases[Cases[recursion,a[k+_.],2],k+_.,2]]];
  reorder=Max[numberlist]-Min[numberlist];
  deorder=DEOrder[DE,f,x];
  While[deorder<reorder,DE = de = D[DE,x];deorder=deorder+1];
  ersetzt durch obigen check whether Teil *)
  If[SpecialFunctionsPrintMessages,
   Print["specfun-info: DE: "];Print["         ",
   DEOut[de/.f->Global`f,Global`f,x]];
   Print["specfun-info: Trying to solve DE ..."]];
  sol = DSolve[de == 0, f[x],x];
  neworder = COrder[sol[[1,1,2]]];
  If[Not[FreeQ[sol[[1,1,2]],DSolve`t]],	
  If[SpecialFunctionsPrintMessages,
     Print["specfun-info: DSolve`t encountered"]];
     sol[[1,1,2]] = (C[++neworder]+(sol[[1,1,2]] /.
     Integrate[expr3_,{DSolve`t,C[iii_],x}]->
     HoldForm[Integrate[HoldForm[expr3/.DSolve`t->x],x]]));
     sol[[1,1,2]] = sol[[1,1,2]]/. HoldForm->Together;
 ];
    If[Not[FreeQ[sol,DSolve]],
     If[SpecialFunctionsPrintMessages,
	Print["specfun-info: DSolve fails"]];
     ConvertReturnValue=3;
     Return[Sum[expr*x^(m*k+b),{k,0,Infinity}]]  ,
 If[SpecialFunctionsPrintMessages,
  Print["specfun-info: DSolve computes "];
 Print["         ",InputForm[sol[[1,1,2]]]]];
   (* If  *);
sol = sol/.sol[[1,1,2]]-> Together[sol[[1,1,2]]];
sol = sol/.sol[[1,1,2]]-> Map[Together,sol[[1,1,2]]]; (* twice necessarily*)
sol = sol/.sol[[1,1,2]]->EliminateNegativeLogarithms[sol[[1,1,2]]];
(* versagt bei Funktionen mehrerer Variablen, war zwischendurch ausgebaut,
ist aber doch noetig, z.B. Convert[Sum[(k!)^2/(2k)!x^k,{k,0,Infinity}],x] *)
sol = sol/.sol[[1,1,2]]->SimpConst[sol[[1,1,2]],x];
sol = Simplify[sol/. ArcTanhRule];
  neworder = COrder[sol[[1,1,2]]];	
  {sol[[1,1,2]],neworder} = CRefresh[sol[[1,1,2]],neworder];
  If[SpecialFunctionsPrintMessages,
  Print["specfun-info: expression rearranged:"];
   Print["         ",InputForm[sol[[1,1,2]]]]];
     If[(* momentan ausgebaut 
	FreeQ[sol,HypergeometricU] &&
        FreeQ[sol,Hypergeometric1F1]*)True, 
	{qtime,qlist}= Timing[ComputeQlist[ak,sol,neworder,xshift,x,k]];
       {Csoltime,Csol} =
       Timing[Solve[qlist,Table[C[jj],{jj,1,neworder}]]],
       Csol={};
       If[SpecialFunctionsPrintMessages,
       Print["specfun-info: Solve not applied (hypergeometric)"]];
       ConvertReturnValue=2
       ](* FreeQ[sol,HypergeometricU]*);
     If[SameQ[Flatten[Csol],{}] || 
        Not[FreeQ[Csol,Solve]]||Not[FreeQ[Csol,DirectedInfinity]],
       presol=sol,
       presol=Flatten[sol /.Csol];
];
     On[DSolve::dnim,Solve];
          endsol = Map[Together,Simplify[x^b*
	    (Flatten[presol][[1,2]]/.x->x^m)]];
     endsol
    ]  (* if Not[FreeQ[sol,DSolve]]*)  
  ] (*  If FreeQ[recursion,k] *)	
]; (* module Convert1 *)

Convert1[expr_,x_]:= expr;

(* main  *)
(*
If[Not[FreeQ[expr11,GegenbauerC[kkk_,0,xxx_]]],
Gegenbauer0Print[expr11];
Return[HoldForm[Convert[expr11,x111]]]
];
If[Not[FreeQ[expr11,GegenbauerC[kkk_,aaa_,xxx_]]],
GegenbauerWarning[expr11,{}]];
*)

If[Not[FreeQ[expr11,C]], 
       expr111= expr11/.C->CC;
       x11 =x111/.C->CC;
       If[SpecialFunctionsPrintMessages,
	      Print["specfun-info: C renamed to CC"]],
       expr111 = expr11;
       x11 =x111];
If[Not[FreeQ[expr11,N]],
       expr111= expr11/.N->NN;
        x11 =x111/.N->NN;
       If[SpecialFunctionsPrintMessages,
              Print["specfun-info: N renamed to NN"]],
       expr111 = expr11;
       x11 =x111];
expr111 = Convert1[expr111,x11];
If[Not[FreeQ[expr111,Convert1]]||Not[FreeQ[expr111,C]],Return[expr111]];
expr1111 =(expr111 //. AbsRules);
If[Not[(*FreeQ[expr111,Complex]||*)FreeQ[expr111,Log]],
expr111 =Simplify[LogToArcSin[expr111]]];
expr111 = expr111//.Power[Power[xx_,pp_ ], Rational[1,
2]]->Holder[xx^pp];
expr111 = expr111//. Power[Power[xx_,pp_ ], Rational[-1,
2]]->1/Holder[xx^pp];
expr111 = (expr111//.Holder -> SimpSqrt);
expr111 = (Expand[expr111]//. AbsRules);
expr111 = Together[expr111];
expr111 = (expr111//.AbsRules);
expr111 = Together[expr111/. {Cosh[x_]->(E^x+E^(-x))/2,Sinh[x_]->(E^x-E^(-x))/2}];
expr111 = Simplify[expr111]//.AbsRules;
expr111 = Expand[expr111];
If[Not[FreeQ[expr111,Complex]],expr111 = 
(expr111/.ArcSin[Sqrt[x_]]->I ArcSinh[Sqrt[-x]])];
If[Not[FreeQ[expr111,Complex]],expr111 =
(expr111/.Times[Complex[0, x_],Power[y_,1/2]]->Power[-y,1/2])];
If[Not[FreeQ[expr111,Complex]],expr111 =
(expr111/.Times[Complex[0, x_],Power[y_,-1/2]]->Power[-y,-1/2])];
expr111 = (expr111//.AbsRules);
If[Not[FreeQ[expr11,C]],
       expr111= expr111/.CC>C;
       If[SpecialFunctionsPrintMessages,
              Print["specfun-info: CC renamed back to C"]],
         Null];
If[Not[FreeQ[expr11,N]],
       expr111= expr111/.NN->N;
       If[SpecialFunctionsPrintMessages,
              Print["specfun-info: NN renamed back to N"]],
         Null];
If[SameQ[ConvertReturnValue,4]||SameQ[ConvertReturnValue,3],
Return[HoldForm[Convert[expr11,x111]]]];
ConvertReturnValue=0;
If[Length[expr1111]<Length[expr111],expr1111,expr111,expr111]
]

GeneratingFunction[a_,k_,x_]:=Convert[Global`sum[a x^k,{k,0,Infinity}],x]

ExponentialGeneratingFunction[a_,k_,x_]:=
Convert[Global`sum[a x^k/k!,{k,0,Infinity}],x]

PowerSeries[function_,x_,Infinity,order_]:=Module[{temp},
asympt = False;
temp = PowerSeries[function/.x->1/x,x,0,order];
temp/.x->1/x
]

Clear[SumToHypergeometric,FunctionToHypergeometric]

Clear[ArgumentPosition,HyperTerm,
SimplifyGamma,SimpComb,Ratio,SimplifyCombinatorial,ToGamma,GammaArgs,
Superficious,RemoveIntegerDifferenceElements]

HyperTerm[upper_,lower_,x_,k_]:=Module[{j},
        Product[Pochhammer[upper[[j]],k],{j,1,Length[upper]}]/
        (k!*Product[Pochhammer[lower[[j]],k],{j,1,Length[lower]}])*x^k
]

Ratio[term1_,k_]:=SimplifyCombinatorial[(term1/.k->k+1)/term1]

SimpComb[term1___]:=SimplifyCombinatorial[term1]

SimplifyCombinatorial[term1_]:= SimplifyGamma[ToGamma[term1]]

(* converts Binomials, products, pochhammers, and
factorials in term1 into gammas, and
applies SimplifyGamma to the modified term1*)

ToGamma[term2_]:=Module[{term1,n,k,m1,m2,term},
(* converts Binomials, products, pochhammers, and
factorials in term1 into gammas*)
term1=term2;
term1= (term1 /. Pochhammer[n_,0]->1);
term1= (term1 /. Pochhammer[0,k_]->0);
term1= (term1 /. Pochhammer[n_,k_]-> Gamma[n+k]/Gamma[n]);
term1= (term1 /. Binomial[n_,k_] ->
        Factorial[n]/(Factorial[n - k]*Factorial[k]));
term1= (term1 /. Factorial[k_]-> Gamma[k+1]);
Return[term1]
]

SimplifyGamma[term1_]:=Module[{term2,highl,lhighl,i,k,j,n},
term2=term1/. Gamma[k_]:>Gamma[Expand[k]];
highl=GammaArgs[term2];
highl=RemoveIntegerDifferenceElements[highl];
highl=Map[Expand,highl];
lhighl=Length[highl];
For[i=1,i<=lhighl,i++,
 n= highl[[i]];
 term2= (term2/. Gamma[k_]->Hold[k,n]);
 term2= (term2/.Hold->ShiftGamma);
 term2= Evaluate[term2];
]; 
Return[Factor[term2]]
]

ShiftGamma[xx_,nn_]:= Module[{j,x,n},
n=Expand[nn];
x=Expand[xx];
If[!IntegerQ[x-n]|| (x-n == 0),Return[Gamma[x]]];
If[x-n>0, 
Gamma[n] * Product[n+j,{j,0,x-n-1}],
Gamma[n] / Product[n+j,{j,-1,x -n}]
]
]

GammaArgs[term1_]:=Module[{term2,highl,lhighl,i},
If[FreeQ[term1,Gamma],RETURN[{}]];
pos= Position[term1,Gamma];
argl:=Map[term1[[ArgumentPosition[#]]]&,pos];
Return[argl]
]

ArgumentPosition[list1_]:= Sequence[
 Delete[list1,Length[list1]]/.List->Sequence,1] 

RemoveIntegerDifferenceElements[{}]:={}

RemoveIntegerDifferenceElements[list_]:=
Module[{length,last,nolast},
length= Length[list];
last= list[[length]];
nolast= Delete[list,length];
If[Superficious[nolast,last], RemoveIntegerDifferenceElements[nolast],
Append[RemoveIntegerDifferenceElements[nolast],last]]
]

Superficious[list_,element_]:=
 Or[Evaluate[Map[IntegerQ[#-element]&,list]/.List->Sequence]]

SumToHypergeometric[Global`sum[aa_,{k_,0,Infinity}]]:=
	Module[{a,rat,num,den,numlist,denlist,lcoeff,numfactorlist,
	denfactorlist,jj,kk,variables,tmp},
	a=SimplifyCombinatorial[aa];
	rat=(a/.k->k+1)/a*(k+1);
	rat=SimplifyCombinatorial[rat];
	num=Numerator[rat];
	den=Denominator[rat];
        numlist=CoefficientList[num,k];
        denlist=CoefficientList[den,k];
        lcoeff=Simplify[numlist[[Length[numlist]]]/denlist[[Length[denlist]]]];
	numlist={};
        denlist={};
        numfactorlist=FactorList[num];
	denfactorlist=FactorList[den];
        If[Not[SameQ[numfactorlist,{}]],
	Do[If[Not[FreeQ[numfactorlist[[jj,1]],k]],
                Do[
                AppendTo[numlist,-Solve[numfactorlist[[jj,1]]==0,k][[1,1,2]]],
                {kk,1,numfactorlist[[jj,2]]}]],
        {jj,1,Length[numfactorlist]}]];
	tmp=numberofzeros[numlist];
	If[tmp>0,Return[SumToHypergeometric[Global`sum[a/.k->k-tmp,{k,0,Infinity}]]]];
	If[Not[SameQ[denfactorlist,{}]],
	Do[If[Not[FreeQ[denfactorlist[[jj,1]],k]],
		Do[
		AppendTo[denlist,-Solve[denfactorlist[[jj,1]]==0,k][[1,1,2]]],
		{kk,1,denfactorlist[[jj,2]]}]],
	{jj,1,Length[denfactorlist]}]];
	tmp=numberofzeros[denlist];
	If[tmp>0,Return[SumToHypergeometric[Global`sum[a/.k->k+tmp,{k,0,Infinity}]]]];
	SimplifyCombinatorial[
	Limit[a,k->0]*Global`hypergeometricPFQ[numlist,denlist,lcoeff]]
] 

SumToHypergeometric[Global`sum[a_,{k_,k0_,Infinity}]]:=
SumToHypergeometric[Global`sum[(a/.k->k+k0),{k,0,Infinity}]]

SumToHypergeometric[c_.*Global`sum[a_,{k_,k0_,Infinity}]+
d_.*Global`sum[b_,{k_,k0_,Infinity}]]:=
SumToHypergeometric[Global`sum[c*a+d*b,{k,k0,Infinity}]]

SumToHypergeometric[expr_]:=SumToHypergeometric[Expand[expr]] /; 
Not[SameQ[expr,Expand[expr]]]

numberofzeros[list_]:=Module[{j,tmp},
	tmp=0;
	Do[If[list[[j]]==0,tmp=tmp+1],{j,1,Length[list]}];
	tmp
]

FunctionToHypergeometric[fun_,x_]:=SumToHypergeometric[PS[fun,x]]

ZTransform[a_,k_,z_]:=Module[{convert,x},
	If[SameQ[Head[Global`x],Symbol],x=Global`x];
	If[SpecialFunctionsPrintMessages,
	Print["specfun-info: ",x," = ",1/z]];
	convert=Convert[Global`sum[a x^k,{k,0,Infinity}],x];
	convert/.x->1/z
]

InverseZTransform[f_,z_]:=Module[{ps,x},
	ps=PS[f/.z->1/x,x];
	If[SameQ[Head[ps],Global`sum]&&FreeQ[ps[[1]]/x^k,x],ps=ps[[1]]/x^k];
	ps/.{x->1/z}
]

SeriesSolution[DE_,y_[x_],incslist_,maxorder_]:=
SeriesSolution[DE,y,x,incslist,maxorder]

SeriesSolution[DE_,y_,x_,incslist_,maxorder_]:=Module[
        {RE,a,n,min,reorder,deorder,DE1,j,RE1,coeff,numberlist},
        (* make homogeneous *)
        DE1=DE;
        While[Not[SameQ[DE1[[2]],0]],DE1=D[DE1,x]];
        RE=DEtoRE[DE1,y,x,a,n];
        numberlist=Union[Map[Plus[#,-n]&,Cases[Cases[RE[[1]],
        a[n+_.],2],n+_.,2]]];
        reorder=Max[numberlist];
        DE1=DE;
        deorder=DEOrder[DE1,y,x];
        Do[coeff[j]=incslist[[j+1]]/j!,{j,0,Length[incslist]-1}];
        Do[
                sol=Solve[DE1,Derivative[j][y][x]][[1,1]];
                sol=sol[[2]]/.{Derivative[k_][y][x]->a[k]*k!,y[x]->a[0],x->0};
                coeff[j]=sol/j!/.{a[k_]->coeff[k]};
                DE1=D[DE1,x],
        {j,deorder,reorder-1}];
        RE1=(Solve[RE,a[n+reorder]][[1,1]]/.n->n-reorder);
        RE1=(RE1/.a->coeff);
        Do[
                coeff[j]=(RE1[[2]]/.n->j),
        {j,reorder,maxorder}];
        Sum[coeff[k] x^k,{k,0,maxorder}]
]

Taylor[f_,x_,n_]:=Module[
{DE,deorder,incslist,y,j},
        DE=HolonomicDE[f,x,y];
        deorder=DEOrder[DE,y,x];
        incslist=Table[D[f,{x,j}],{j,0,deorder-1}];
        incslist=incslist/.x->0;
        SeriesSolution[DE,y,x,incslist,n]
]

Taylor[func_,{y_,y0_,n_}]:=Module[{temp(*x*)},
      If[SpecialFunctionsPrintMessages, funcp = func /.y->x+y0;
      Print["specfun-info: working with ",funcp /. x->Global`x]];
temp = Taylor[(func /. y->x+y0),x,n];
temp/. (x->y-y0)
]/;!SameQ[ToString[y0],"x"]

Taylor[func_,{y_,y0_,n_}]:=Module[{},
Print["specfun-warning: Please use another symbol than x as third argument"];
HoldForm[Taylor[func,{y,y0,n}]]
]


(* PACKAGE *)
Protect[
ComplexFactor,ComplexApart,SimpleDE,DEtoRE,SimpleRE,DEOrder,
PowerSeries,PS,Convert,SimpByRecursion,FindRecursion,
AsymptPowerSeries,Bateman,Hankel1, Hankel2, KummerM, KummerU,
WhittakerM,WhittakerW, StruveH, StruveL, Erfc, Abramowitz, NormalIntegral,
KnuthA, KnuthB, ParabolicU, ParabolicD, ParabolicV,
Hypergeometric0F1, Hypergeometric1F0, HypergeometricU, Hypergeometric1F1,
Hypergeometric2F0, Hypergeometric2F1, Hypergeometric2F3, Hypergeometric3F2,
specfunprint,specfunprintoff,nospecfunprint,RETODE,REtoDE,SumtoDE,
SumDE,DESum,ProductDE,DEProduct,SumRE,RESum,ProductRE,REProduct,ConvolutionRE,
SumToHypergeometric,FuncionToHypergeometric,
ZTransform,InverseZTransform,
SimplifyGamma,ToGamma,SimpComb,SimplifyCombinatorial,Ratio,HyperTerm,
SeriesSolution,Taylor
]

On[SetDelayed::write]
On[TagSetDelayed::write]

End[]  (*Private  *)
EndPackage[]

(*
% Unprotect[HypergeometricPFQ]
% Clear[HypergeometricPFQ]
% Protect[HypergeometricPFQ]
*)