/** Generalized hypergeometric functions: reduction of high order functions **/

/*K: hypergeometric; generalized hypergeometric; Ghg; sums; summation; series */
/*A: John Gottschalk */
/*S: University of Western Australia */
/*D: September 1985 */
/*P: XDelete, XPocV, XWarning, XPsiV and XList0 are loaded as needed. */
/*W: XGhg0 must not be loaded for the rules in this file to work. 
	The reason is that the cancellation theorem in XGhg0 is
	automatically applied, but some transformations in this file
	rely on building up the hypergeometric functions by adding
	identical numerator and denominator parameters.
     The value for _Sum[Smp] is changed to Inf. */

/* This file currently contains rules for the reduction of hypergeometric
   functions that have some numerator parameters differing from denominator
   parameters by integers. If possible the complete reduction of these
   series into polygamma and gamma functions is achieved, otherwise the
   original series is written as a sum of series of lower order. */

/* To speed the calculations many intermediate results are stored. Some
   of these are later deleted before the calculation is complete, but not
   all. If possible, transformations are applied which usually result in
   more rapid calculation and more compact output. The transformations
   are in the form of substitutions called SFastGhg. The main projector
   in this file is Intdiff for the reduction of hypergeometric functions
   with integral parameter differences. */

/*F: Procedures for the reduction of other classes of hypergeometric 
     functions will be written later using substitutions in this file. */

#_:Comm
_Subiso[Smp] : {0,Inf}
_Sum[Smp] : Inf
Subiso_:Tier
Cancel_:Tier
Ghg_:  Tier

TestA_:TestB_:TestC_:TestD_:Tier
FastGhgp_:Tier

If[~P[_XLoadonce[Loaded]],<XLoadonce]
Loadonce[XDelete]
Loadonce[XPocV]
_SymbWT[Init] :: Loadonce[XWarning]
_Psi[Init]    :: Loadonce[XPsiV]
_Rm[Init]     :: Loadonce[XList0]

Psi[0,$x] : Psi[$x]

/*: Intdiff [$exp] rewrites hypergeometric functions in $exp in terms
    of gamma or polygamma functions if possible. Only functions of the
    form Ghg[p+1,p,#[a1,...,ap,c],#[a1+m1,...,ap+mp],z] where mi are
    integers are reduced. */
Intdiff[$exp] :: (Si[$exp,Cancel[]]; S[%%,SIntdiff[0]])

/* SIntdiff are substitutions used to reduce hypergeometric series whose
   top parameters differ by integers from the bottom parameters. */
SIntdiff[0] :: Ghg[$p,$p-1,#[$x,$$a]_=Isop[Intp[$1-$2],{$$a},{$$b}],#[$$b],\
  $z_=Abs[$z] = 1] --> (Ghg[$p,$p-1,#[$x,$$a],#[$$b],$z];\
  Sel[$x = 1    ,S[Si[%%,SGhg[1,2][1]],SIntdiff[1]],\
      Natp[$x-1],S[Si[S[%%,SGhg[1,1]],SGhg[1,2][1]],SIntdiff[1]],\
      $z = 1    ,S[Si[%%,SGhg[1,2][$x]],SIntdiff[2][$x]],\
      1         ,%%])

SIntdiff[1] : Ghg[$p,$p-1,#[1,$$a],#[$$b],$z] --> \
 (Lcl[%Ghg]; %Ghg : Ghg[$p,$p-1,#[1,$$a],#[$$b],$z];\
  If[P[FastGhgp[{$$a},{$$b},$p]], \
    Sel[$z = -1,S[%Ghg,SFastGhg[1]],$z = 1,S[%Ghg,SFastGhg[2]]],\
    Si[S[%Ghg,SGhg[1,4][1]],{SGhg[1,5][1],Cancel[1],SInt}];Ghg:;%%])

SIntdiff[2][$x] : Ghg[$p,$p-1,#[$x,$$a],#[$$b],1] --> \
 (Lcl[%Ghg]; %Ghg : Ghg[$p,$p-1,#[$x,$$a],#[$$b],1]; \
  If[FastGhgp[{$$a},{$$b},$p],S[%Ghg,SFastGhg[3]],%Ghg])

/*: FastGhgp[$list1,$list2,$order]  is used to determine if
    the substitutions yielding fast reductions of hypergeometric
    series may be applied. */
FastGhgp[$a,$b,$p] :: (Lcl[%a,%b,%go,i]; %go : 1;{%a,%b} : TestD[$a,$b];\
  Len[%a] = $p-1 & For[i:1,i<=Len[%a] & %go,Inc[i],\
  %go : ~Ap[Or,Map[P[Natp[1-$x]],%a[i]+1-Rm[%b,i]]]])

/* SGhg[1,1] is a substitution to write functions of the type
   Ghg[p,q,#[a1,...,ap],#[b1,...,bq],z] in terms of functions
   of the form Ghg[p,q,#[1,a2,...,ap],#[b1,...,bq],z]. */
/* Note the level in In may be wrong */
SGhg[1,1] : Ghg[$p,$q,#[$n_=Intp[$n],$$t],#[$$b],$z] --> \
  If[P[In[1,{$n,$$t},2]],Ghg[$p,$q,#[$n,$$t],#[$$b],$z],\
  S[$n Ghg[$p+1,$q+1,#[1,$n+1,$$t],#[2,$$b],$z] + \
   (1-$n) Ghg[$p+1,$q+1,#[1,$n,$$t],#[2,$$b],$z],Cancel[1],2]]

/* SGhg[1,2] and SGhg[1,3] are substitutions used to eliminate pairs
   of parameters such that the top parameter is an integer greater than
   the bottom parameter. */
SGhg[1,2][$x] :: Ghg[$p_=$p>2,$q,#[$x,$$a]_=Len[TestA[{$$a},{$$b}][1]] > 0,\
  #[$$b],$z] --> (Lcl[%a,%b,%exp]; {%a,%b} : TestA[{$$a},{$$b}];\
  %exp : Ghg[$p,$q,#[$x,$$a],#[$$b],$z];\
  Do[i,1,Len[%a],,%exp : S[%exp,SGhg[1,3][$x,%a[i],%b[i]]]])

SGhg[1,3][$x,$a,$b][1] :: Ghg[$p_=$p>3,$q,#[$x,$a,$1,$$a],\
  #[$b,$2_=Natp[$2-$1],$$b],$z] --> \
    S[Ap[1/Poc[$b,$k] Sum[Comb[$k,%#n] Poc[$1,$k-%#n] Poc[$b-$1,%#n] \
      Ghg[$p,$q,#[$x,$a,$1+$k-%#n,$$a],#[$b+$k,$2,$$b],$z],{%#n,0,$k}],\
      {Min[$2-$1,$a-$b]}],Cancel[$x],2]

SGhg[1,3][$x,$a,$b][2] :: Ghg[3,2,#[$x,$a,$1],#[$b,$2_=Natp[$2-$1]],$z] --> \
    S[Ap[Gamma[$b]/(Gamma[$b+$k] Gamma[$1]) \
      Sum[Comb[$k,%#n] Gamma[$1+$k-%#n] Poc[$b-$1,%#n] \
      Ghg[3,2,#[$x,$a,$1+$k-%#n],#[$b+$k,$2],$z],{%#n,0,$k}],\
      {Min[$2-$1,$a-$b]}],Cancel[$x],2]

/* SGhg[1,4][$x] reduces series of the type 
   Ghg[p,p-1,[$x,a1,...,ai,...,ap],#[a1+m1,...,ai+mi,...aq],z] to series like
   Ghg[p,p-1,[$x,a1,...,ap],#[a1+1,...aq],z] where mi > 1. */
SGhg[1,4][$x] :: Ghg[$p_=If[P[$z=1],$p>2,$p>1],$p-1,#[$x,$$a],#[$$b_=\
  Len[TestB[{$$a},{$$b}][1]] >= 1],$z] -->(Lcl[%b1,%b2,%#i,%#j,%J,%m,%t1,%t2]; \
   {%t1,%b1} : TestB[{$$a},{$$b}];\
   %#j[$y] :: (%#j[$y] : Make[,$y]);\
   %m : %b1-%t1-1; %J : Ar[Len[%m],%#j];\
   %t2 : RemL[%t1,{$x,$$a}]; %b2 : RemL[%b1,{$$b}];\
   Sum[Prod[Poc[-%m[%#i],%#j[%#i]]/(Fctl[%#j[%#i]](%t1[%#i]+%#j[%#i])),{%#i,1,Len[%m]}] \
      Ghg[$p,$p-1,Ap[#,Cat[%t1+%J,%t2]],Ap[#,Cat[%t1+%J+1,%b2]],$z],\
      Ar[Len[%m],{%#j[$1],0,%m[$1]}]]/Prod[%m[%#i]!/\
      Poc[%t1[%#i],%m[%#i]+1],{%#i,1,Len[%m]}])

/* SGhg[1,5][$x] reduces series of the type 
   Ghg[p,q,[$x,a1,...,ai,...,ap],#[a1+1,...,ai+1,...aq],z] to series like
   Ghg[p-i+1,q-i+1,[$x,ai,...,ap],#[ai+1,...aq],z]. */
SGhg[1,5][$x] :: Ghg[$p,$q,#[$x,$$a],#[$$b_=\
   Len[TestC[{$$a},{$$b}][1]] > 1],$z_=If[P[$z = 1],$p > 3,$p > 2]] --> \
 (Lcl[%b1,%b2,%#i,%#j,%n,%prod,%t1,%t2];\
   {%t1,%b1} : TestC[{$$a},{$$b}]; %n : Len[%t1];\
   If[%n+1 = $p & $z=1, %n : %n-1; %t1 : Rm[%t1,1];%b1 : Rm[%b1,1]];\
   %t2 : RemL[%t1,{$x,$$a}]; %b2 : RemL[%b1,{$$b}];\
   %prod[$i_=Numbp[$i]]::Prod[%t1[%#j]/(%t1[%#j]-%t1[$i]),{%#j,1,%n,,%#j~=$i}];\
   Sum[Ghg[$p-%n+1,$q-%n+1,Ap[#,Cat[{%t1[%#i]},%t2]],\
	Ap[#,Cat[{%t1[%#i]+1},%b2]],$z] %prod[%#i],{%#i,1,%n}])

/* SFastGhg[1] is a fast reduction for series of the type 
   Ghg[p+1,p,#[1,a1,....,ap],#[b1,...,bp],-1] as long as they satisfy
   test FastGhgp. */
SFastGhg[1] : Ghg[$p+1,$p,#[1,$$a],#[$$b],-1] --> \
 (Lcl[%b,%#i,%#j,%m,%mu,%prod,%t];\
  {%t,%b} : TestD[{$$a},{$$b}]; %m : %b-%t-1;\
  %prod[$i_=Numbp[$i]] :: Prod[Poc[%t[%mu],%m[%mu]+1]/\
     (Poc[%t[%mu]-%t[$i]-%#j,%m[%mu]+1]),{%mu,1,$p,,%mu~=$i}];\
  Sum[Poc[%t[%#i],%m[%#i]+1] (-1)^%#j \
	(Psi[%t[%#i]/2+%#j/2+1/2]-Psi[%t[%#i]/2+%#j/2]) \
      %prod[%#i]/(Fctl[%#j] Gamma[%m[%#i]+1-%#j]),\
      {{%#j,0,%m[%#i]},{%#i,1,$p}}]/2)

/* SFastGhg[2] is a fast reduction for series of the type 
   Ghg[p+1,p,#[1,a1,....,ap],#[b1,...,bp],1] as long as they satisfy
   test FastGhgp. */
SFastGhg[2] : Ghg[$p+1,$p_=$p>1,#[1,$$a],#[$$b],1] --> \
 (Lcl[%b,%#i,%#j,%#k,%m,%#mu,%prod,%t];\
  {%t,%b} : TestD[{$$a},{$$b}]; %m : %b-%t-1;\
  %prod[$i_=Numbp[$i]] :: Prod[Poc[%t[%#mu],%m[%#mu]+1]/\
     (Poc[%t[%#mu]-%t[$i]-%#j,%m[%#mu]+1]),{%#mu,1,$p-1,,%#mu~=$i}];\
  Sum[Poc[%t[%#i],%m[%#i]+1] (-1)^%#j (-1)^%#k \
	(Psi[%t[%#i]+%#j]-Psi[%t[$p]+%#k]) \
      %prod[%#i]/(Fctl[%#j] Fctl[%#k] Gamma[%m[%#i]+1-%#j] Gamma[%m[$p]+1-%#k] \
     (%t[%#i]+%#j-%t[$p]-%#k)),{{%#k,0,%m[$p]},{%#j,0,%m[%#i]},{%#i,1,$p-1}}] \
  Poc[%t[$p],%m[$p]+1])

SFastGhg[3][$x] : Ghg[$p+1,$p,#[$x,$$a],#[$$b],1] --> \
 (Lcl[%b,%#i,%#j,%m,%#mu,%prod,%t];\
  {%t,%b} : TestD[{$$a},{$$b}]; %m : %b-%t-1;\
  %prod[$i_=Numbp[$i]] :: Prod[Poc[%t[%#mu],%m[%#mu]+1]/\
     (Poc[%t[%#mu]-%t[$i]-%#j,%m[%#mu]+1]),{%#mu,1,$p,,%#mu~=$i}];\
  Sum[Poc[%t[%#i],%m[%#i]+1] (-1)^%#j Gamma[%t[%#i]+%#j] %prod[%#i]/\
     (Fctl[%#j] Gamma[%m[%#i]+1-%#j] Gamma[%t[%#i]+%#j+1-$x])\
     ,{{%#j,0,%m[%#i]},{%#i,1,$p}}] Gamma[1-$x])

TestA[$a,$b] :: TestA[$a,$b] : Subiso[Natp[$1-$2],Ap[{RemL[$3,$a],\
  RemL[$4,$b]},Subiso[Natp[$2-$1+1],{$a,$b}]]]
TestB[$a,$b] :: TestB[$a,$b] : \
  Subiso[Natp[$2-$1-1],Ap[{RemL[$3,$a],RemL[$4,$b]},\
  Subiso[Ex[$2-$1]=1,{$a,$b}]]]
TestC[$a,$b] :: TestC[$a,$b] : Subiso[Ex[$2-$1]=1,{Union[$a],$b}]
TestD[$a,$b] :: TestD[$a,$b] : Subiso[Natp[$2-$1],{Union[$a],$b}]

/*: Isop[$temp,$list1,$list2] yields 1 if there is a one to one and 
    onto correspondence between elements of $list1 and $list2 such
    that $temp is satisfied. */
_Isop[Smp] : 0
Isop_:Tier
Isop[$temp,$l1,$l2] : 0
Isop[$temp,$l1_=Contp[$l1],$l2_=Contp[$l2] & Len[$l1] = Len[$l2]] :: \
  Len[Proj[Subiso[$temp,{$l1,$l2}],{1}]] = Len[$l1]

/*: Subiso[$temp,{$list1,$list2}] determines which element of $list2 
    can be paired with an element of $list1 such that 1 is returned on
    application of $temp to the pair. Subiso returns a list of the form
    {a,b} where a[i] and b[i] were the matching elements of $list1 and 
    $list2 respectively. As an example Subiso[$2-$1=1,{{a,3/2,b},{5/2,6,b+1}}]
    yields {{3/2,b},{5/2,b+1}}. */
Subiso[$temp,{$a_=Contp[$a],$b_=Contp[$b]}] :: \
 (Lcl[%a,%b,%#j,%list1,%list2,%listfix,%match,%x,%y];\
  %x : Sort[$a]; %y : Sort[$b];\
  %list1 : %list2 : {};\
  %listfix[$i,$j] :: (%list1 : Cat[%list1,{%x[$i]}]; \
                      %list2 : Cat[%list2,{%y[$j]}]; \
		      %y : Rm[%y,$j]);\
  Do[%#i,1,Len[%x],,(%a : %x[%#i]; %#j : 0;\
     Loop[Inc[%#j];%#j <= Len[%y], %b : %y[%#j],\
          If[%match : P[Ap[$temp,{%a,%b}]],%listfix[%#i,%#j]]; ~%match])];\
  {%list1,%list2})

/*: SInt[$i] are substitutions reducing special hypergeometric series to
   gamma or polygamma functions. Once the reduction of a particular series
   is calculated the result is stored. */
SInt[1] :: Ghg[$p_=$p>2,$p-1,#[1,$$a],#[$$b]_=\
  Union[{$$b}]-Union[{$$a}]={1},1] --> (Ghg[$p,$p-1,#[1,$$a],#[$$b],1] : \
  -Psi[$p-2,{$$a}[1]] (-1)^$p ({$$a}[1])^($p-1)/Fctl[$p-2])

SInt[2] :: Ghg[$p,$p-1,#[1,$$a],#[$$b]_=\
  Union[{$$b}]-Union[{$$a}]={1},-1] --> (Ghg[$p,$p-1,#[1,$$a],#[$$b],-1] : \
  (Psi[$p-2,({$$a}[1])/2+1/2]-Psi[$p-2,({$$a}[1])/2]) (-1)^$p \
  ({$$a}[1])^($p-1) 2^(1-$p)/Fctl[$p-2])

SInt[3] :: Ghg[3,2,#[1,$a,$b],#[$a+1,$b+1],1_=SymbWT[$b~=$a]] --> \
  (Ghg[3,2,#[1,$a,$b],#[$a+1,$b+1],1] : $a $b/($a-$b) (Psi[$a]-Psi[$b]))

SInt[4] :: Ghg[2,1,#[$a,$b],#[$c],1] --> (Ghg[2,1,#[$a,$b],#[$c],1] : \
   Gamma[$c] Gamma[$c-$a-$b]/(Gamma[$c-$a] Gamma[$c-$b]))

/*: Cancel[$e] is a substitution to apply the cancellation property of
    hypergeometric series. Any parameter matching $e and negative integers 
    are not cancelled. */

Cancel[] : \
{Ghg[1,1,#[$x],#[$y_=$y=$x&~Natp[1-$y]],$z]      ->  Ghg[0,0,#[],#[],$z],\
 Ghg[1,$q,#[$x],#[$y_=$y=$x&~Natp[1-$y],$$b],$z] ->  Ghg[0,$q-1,#[],#[$$b],$z],\
 Ghg[$p,1,#[$x,$$a],#[$y_=$y=$x&~Natp[1-$y]],$z] ->  Ghg[$p-1,0,#[$$a],#[],$z],\
 Ghg[$p,$q,#[$x,$$a],#[$y_=$y=$x&~Natp[1-$y],$$b],$z] -> \
				 	Ghg[$p-1,$q-1,#[$$a],#[$$b],$z]}

Cancel[$e] : \

{Ghg[1,1,#[$x_=~P[$x=$e]],#[$y_=$y=$x&~Natp[1-$y]],$z]      -> \
						Ghg[0,0,#[],#[],$z],\
 Ghg[1,$q,#[$x_=~P[$x=$e]],#[$y_=$y=$x&~Natp[1-$y],$$b],$z] -> \
						Ghg[0,$q-1,#[],#[$$b],$z],\
 Ghg[$p,1,#[$x_=~P[$x=$e],$$a],#[$y_=$y=$x&~Natp[1-$y]],$z] -> \
						Ghg[$p-1,0,#[$$a],#[],$z],\
 Ghg[$p,$q,#[$x_=~P[$x=$e],$$a],#[$y_=$y=$x&~Natp[1-$y],$$b],$z] -> \
						Ghg[$p-1,$q-1,#[$$a],#[$$b],$z]}


/*B: These routines have not been adequately tested for hypergeometrics with 
     parameters that are symbols. */

_XGhg1[Loaded] : 1

/*E:
SMP 1.5.0

#I[1]::  <XGhg1;

#I[2]::  Post :: Ex[Intdiff[$1]]

#O[2]:   ' Ex[Intdiff[$1]]

#I[3]::  Ghg[2,1,#[3,1],#[4],-1]

#O[3]:   -3/2 + 3Log[2]

#I[4]::  Ghg[3,2,#[1,5/2,1],#[4,9/2],-1]

#O[4]:   -4669/30 + 56Pi - 28Log[2]

#I[5]::  Ghg[3,2,#[2,5/2,1],#[7/2,4],-1]

#O[5]:   95 - 30Pi

#I[6]::  Ghg[4,3,#[2,2,7/2,1],#[1,5,11/2],-1]

				6048Log[2]
#O[6]:   -50274/25 + 4536Pi/5 - ----------
				    5

#I[7]::  Ghg[3,2,#[5/2,3,1],#[7/2,4],1]

#O[7]:   -35/2 + 30Log[2]

#I[8]::  Ghg[4,3,#[1,5/2,3,1],#[2,4,9/2],1]

#I[9]:: <end>
*/

