home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e031 / 3.ddi / MATHZIP2 / STARTUP / HYPERGEO.M < prev    next >
Encoding:
Text File  |  1991-09-23  |  46.4 KB  |  1,325 lines
  1. (* :Name: StartUp`HypergeometricPFQ` *)
  2.  
  3. (* :Title: Generalized Hypergeometric Functions *)
  4.  
  5. (* :Authors: Jerry B. Keiper  and Victor S. Adamchik *)
  6.  
  7. (* :Summary:
  8.     Provides rules for evaluating generalized hypergeometric and
  9.     regularized hypergeometric functions.
  10. *)
  11.  
  12. (* :Context: System` *)
  13.  
  14. (* :Package Version: 2.0 *)
  15.  
  16. (* :Copyright: Copyright 1991  Wolfram Research, Inc.
  17.  
  18.     Permission is hereby granted to modify and/or make copies of
  19.     this file for any purpose other than direct profit, or as part
  20.     of a commercial product, provided this copyright notice is left
  21.     intact.  Sale, other than for the cost of media, is prohibited.
  22.  
  23.     Permission is hereby granted to reproduce part or all of
  24.     this file, provided that the source is acknowledged.
  25. *)
  26.  
  27. (* :History:
  28.     Version 2.0 by Jerry B. Keiper, November 1990.
  29.  
  30.         Extensively modified and extanded by 
  31.                        Victor S. Adamchik, February 1991.
  32. *)
  33.  
  34. (* :Keywords: hypergeometric, regularized *)
  35.  
  36. (* :Source:
  37.     A.P.Prudnikov, Yu.A.Brychkov, O.I.Marichev, Integrals and Series, 
  38.         Vol. 3: More Special Functions, Gordon and Breach, New York, 
  39.         London, 1989.
  40. *)
  41.  
  42. (* :Mathematica Version: 2.0 *)
  43.  
  44. (* :Limitation:
  45.     This package provides only the obvious simplifications.  There
  46.     are many specialized identities that could be added.  For example,
  47.     the generalized Euler transformation could be used to numerically
  48.     evaluate pFq where p-q == 1 and Abs[z-1] > 1.
  49. *)
  50.  
  51. Needs["System`", "StartUp`Attributes.m"]
  52.  
  53. Begin["System`"]
  54.  
  55. Unprotect[ HypergeometricPFQ, HypergeometricPFQRegularized, 
  56.            Hypergeometric1F1, Hypergeometric2F1]
  57.  
  58. Map[ Clear, {HypergeometricPFQ, HypergeometricPFQRegularized,
  59.              Hypergeometric1F1, Hypergeometric2F1}]
  60.  
  61. HypergeometricPFQ::hdiv = 
  62. " Warning: Divergent generalized hypergeometric series `1`."
  63.  
  64. HypergeometricPFQ::usage =
  65. "HypergeometricPFQ[numlist, denlist, z] gives the generalized hypergeometric
  66. function pFq where numlist is a list of the p parameters in the numerator 
  67. and denlist is a list of the q parameters in the denominator."
  68.  
  69. HypergeometricPFQRegularized::usage =
  70. "HypergeometricPFQRegularized[numlist, denlist, z] gives the regularized
  71. generalized hypergeometric function pFq where numlist is a list of the p
  72. parameters in the numerator and q is a list of the q parameters in the
  73. denominator.  HypergeometricPFQRegularized[numlist, denlist, z] ==
  74. HypergeometricPFQ[numlist, denlist, z]/(Times @@ (Gamma /@ denlist))
  75. except when denlist contains a non-positive integer when it is defined by
  76. analytic continuation to remove the indeterminacy."
  77.  
  78. Begin["HypergeometricPFQ`Private`"]
  79.  
  80. (***************************************************************************
  81. *                           General Cases
  82. *
  83. ****************************************************************************)
  84.  
  85.  Unprotect[ Hypergeometric2F1, Hypergeometric1F1 ]
  86.  
  87.  HypergeometricPFQ[ uppar_,lowpar_,0 ] :=  1            
  88.  
  89.  HypergeometricPFQ[ uppar_,lowpar_,z_Real/;z==0. ] := 1 + z           
  90.  
  91.  HypergeometricPFQ[ uppar_, {v1___,u_Integer/;u<=0,v2___},arg_ ] :=
  92.    Module[ { negnum, negden },
  93.       negnum = Select[uppar,IntegerQ[#] && #<=0&];
  94.       If[ Length[negnum]==0, 
  95.       If[ And@@(NumberQ[#]&/@Re[N[uppar]]), 
  96.           ComplexInfinity, 
  97.           Indeterminate 
  98.       ],
  99.           negden = Select[{v1,u,v2},IntegerQ[#] && #<=0&];
  100.       If[ And@@(NumberQ[#]&/@Re[N[Join[uppar,{v1,v2}]]]),
  101.               If[ Max[negden] > Max[negnum], 
  102.           ComplexInfinity,
  103.                   Indeterminate
  104.               ],
  105.          Indeterminate
  106.       ]
  107.      ]
  108.   ]         
  109.  
  110.  HypergeometricPFQ[ {v1___,a_,v2___},{v3___,b_,v4___},arg_] :=
  111.    HypergeometricPFQ[ {v1,v2},{v3,v4}, arg ] /; N[Expand[a-b]] == 0.
  112.  
  113.  HypergeometricPFQ[ {___,0,___},lowpar_,arg_ ] :=  1  
  114.           
  115.  HypergeometricPFQ[ {___,z_Real/;z==0.,___},lowpar_,arg_ ] := 1 + z            
  116.  
  117.  HypergeometricPFQ[ {v1___,u_Integer?Negative,v2___},lowpar_,arg_ ] :=
  118.    Sum[ arg^i MultPochham[{u,v1,v2},i]/( i! MultPochham[lowpar,i]),
  119.        {i,0,-Max[Select[ {u,v1,v2},IntegerQ[#] && Negative[#]& ]]} ]
  120.    
  121.  HypergeometricPFQ[ uppar_List,lowpar_List,arg_ ] := 
  122.    (
  123.    Message[HypergeometricPFQ::hdiv,
  124.            HoldForm[HypergeometricPFQ[ uppar,lowpar,arg]]];
  125.    HypergeometricPFQ[ uppar,lowpar,arg] /; Fail
  126.    ) /;
  127.  Length[uppar]>Length[lowpar]+1
  128.    
  129.  HypergeometricPFQ[ uppar_List,lowpar_List,arg_ ] := 
  130.     Block[ {inter, HypergeometricCond},
  131.         Off[HypergeometricPFQ::hdiv];
  132.         inter = Expand[
  133.         GeneralHypergeometricPFQ[ Sort[Expand[uppar]],
  134.                                   Sort[Expand[lowpar]],arg ]//.
  135.         PolyGammaRule];
  136.         On[HypergeometricPFQ::hdiv];
  137.         inter = 
  138.         If[ !FreeQ[inter,Gamma] , 
  139.                SimpGammaH[inter],
  140.                inter ];
  141.         inter = 
  142.         If[ !FreeQ[inter,PolyGamma] , 
  143.             SimpPolyGammaH[inter],
  144.             inter ];
  145.         If[ Or@@(Not[FreeQ[inter,#]]&/@{Tan,Cot,Tanh,Coth}),
  146.             inter//.SimpTrigSum ,
  147.             inter]
  148.       ] /;  Accuracy[{uppar,lowpar,arg}] === Infinity && HypergeometricCond 
  149.  
  150.  HypergeometricCond = True
  151.       
  152. (* Approximate Numerical Evaluation *)
  153. HypergeometricPFQ[a_List, b_List, z_] :=
  154.     Module[{an = a, bn = Append[b, 1], oldsum = 0, sum = 1, term = 1},
  155.         While[oldsum != sum,
  156.             term *= Apply[Times, an++] z/Apply[Times, bn++];
  157.             oldsum = sum;
  158.             sum += term];
  159.         sum
  160.     ] /; (Apply[And, Map[NumberQ, a]] && Apply[And, Map[NumberQ, b]] &&
  161.         NumberQ[z] && Precision[{a, b, z}] < Infinity &&
  162.         (Length[a] - Length[b] < 1 ||
  163.             (Length[a] - Length[b] == 1 && Abs[z] < 1)))
  164.  
  165. (* Derivatives wrt z *)
  166. Derivative[0, 0, n_Integer][HypergeometricPFQ] ^:=
  167.     (Apply[Times, Map[Pochhammer[#, n]&, #1]] *
  168.         HypergeometricPFQ[#1 + n, #2 + n, #3] /
  169.         Apply[Times, Map[Pochhammer[#, n]&, #2]])& /; n > 0
  170.  
  171.  GeneralHypergeometricPFQ[ {___,0,___},lowpar_,arg_ ] :=  1            
  172.  
  173.  GeneralHypergeometricPFQ[ {v1___,u_Integer?Negative,v2___},
  174.                            lowpar_,arg_ ] :=
  175.  Sum[ arg^i MultPochham[{u,v1,v2},i]/( i! MultPochham[lowpar,i]),
  176.       {i,0,-Max[Select[ {u,v1,v2},IntegerQ[#] && Negative[#]& ]]} ]
  177.  
  178.  GeneralHypergeometricPFQ[ {v1___,a_,v2___},{v3___,b_,v4___},arg_] :=
  179.    GeneralHypergeometricPFQ[ {v1,v2},{v3,v4}, arg ] /; Expand[a-b] === 0
  180.    
  181.  GeneralHypergeometricPFQ[ {},{a_/;!NumberQ[a]||Denominator[a]!=2},
  182.                          arg_/;Znak[arg] ] :=
  183.    Gamma[a] (-arg)^(-a/2+1/2) BesselJ[Expand[a-1],2 Sqrt[-arg]]
  184.  
  185.  GeneralHypergeometricPFQ[ {},{a_/;!NumberQ[a]||Denominator[a]!=2},
  186.                          arg_ ] :=
  187.    Gamma[a] arg^(-a/2+1/2) BesselI[Expand[a-1],2 Sqrt[arg]]
  188.    
  189.  GeneralHypergeometricPFQ[ {},{a_},arg_ ] :=
  190.    Hypergeometric0F1[ a,arg ] 
  191.  
  192.  GeneralHypergeometricPFQ[ {},{},arg_ ] := Exp[arg] 
  193.  
  194.  GeneralHypergeometricPFQ[ {par_},{},arg_/;arg=!=1 ] := 
  195.    Together[1 - arg]^(-par) 
  196.  
  197.  GeneralHypergeometricPFQ[ {par_},{},1 ] := 0 /;
  198.  NumberQ[par] && Im[par]==0 && par<0
  199.  
  200.  GeneralHypergeometricPFQ[ {par_},{},1 ] := 
  201.    DirectedInfinity[] /; NumberQ[par] && Im[par]==0 && par>0
  202.  
  203.  GeneralHypergeometricPFQ[ {c1___,a_,c2___}, {d1___,a1_,d2___},arg_ ] :=
  204.    GeneralHypergeometricPFQ[ {a-1,c1,c2},{a1,d1,d2},arg] +                             
  205.    arg Apply[Times,{c1,c2}]/( a1 Apply[Times,{d1,d2}])*
  206.    GeneralHypergeometricPFQ[ 1+{a-1,c1,c2},1+{a1,d1,d2},arg ] /;                             
  207.  IntegerQ[Expand[a-a1]] && Expand[a-a1]>0
  208.  
  209.  GeneralHypergeometricPFQ[ {c1___,a_Integer,c2___},
  210.                            {d1___,a1_Integer,d2___},arg_ ] :=
  211.    (a1-1) Apply[Times,{d1,d2}-1] / (arg Apply[Times,{c1,c2}-1] ) *
  212.    (GeneralHypergeometricPFQ[
  213.            Expand[{a+1,c1,c2}-1],Expand[{a1,d1,d2}-1],arg] - 
  214.     GeneralHypergeometricPFQ[
  215.            Expand[{a,c1,c2}-1],Expand[{a1,d1,d2}-1],arg] ) /;a<a1 && 
  216.  Length[Intersection[{c1,c2},{1}]] == 0
  217.  
  218.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] :=
  219.    Module[ {a,a1,up,low},
  220.      {a,up,low}  = SearchPar[0,uppar,lowpar];
  221.      If[Not[FreeQ[a,HyperFail]], a1 = HyperFail,
  222.         {a1,up,low} = SearchPar[a[[1]],up,low] ];
  223.      EvalHyper[a,a1,up,low,arg] /;
  224.    a1=!=HyperFail && ConditionHyp[a,a1,up,low,arg]
  225.    ]/;Length[lowpar]>1
  226.  
  227.  EvalHyper[{a_,a1_},{b_,b1_},uppar_,lowpar_,arg_] :=
  228.     b GeneralHypergeometricPFQ[Join[{a,b+1},uppar],
  229.                         Join[{a1,b1},lowpar],arg ]/(b-a) -
  230.     a GeneralHypergeometricPFQ[Join[{a+1,b},uppar],
  231.                         Join[{a1,b1},lowpar],arg ]/(b-a)
  232.   
  233.  SearchPar[t_,{c1___,a_,c2___},{d1___,a1_,d2___}] := 
  234.     {{a,a1},{c1,c2},{d1,d2}}/;a=!=t && IntegerQ[a1-a] && a1-a>0
  235.  
  236.  SearchPar[___] := {HyperFail,HyperFail,HyperFail}
  237.  
  238.  ConditionHyp[{a_,a1_},{b_,b1_},c_,d_,arg_] :=
  239.    If[ Length[c] == 1 && Length[d] == 0 && N[arg]=!=1.||
  240.        Length[c] == 2 && Length[d] == 1 ||
  241.        Length[c] <= Length[d] ||
  242.        N[Abs[arg]] < 1. || Not[NumberQ[N[arg]]] ||
  243.        (Re[Expand[Apply[Plus,Join[c,-d,{a,b+1,-a1,-b1}] ]]] < 0 &&
  244.         Re[Expand[Apply[Plus,Join[c,-d,{a+1,b,-a1,-b1}] ]]] < 0 &&
  245.         Abs[arg] == 1) ||
  246.        (Re[Expand[Apply[Plus,Join[c,-d,{a,b+1,-a1,-b1}] ]]] < 1 &&
  247.         Re[Expand[Apply[Plus,Join[c,-d,{a+1,b,-a1,-b1}] ]]] < 1 &&
  248.         Abs[arg] == 1 && arg=!=1),
  249.      True,
  250.      False]
  251.  
  252. (***************************************************************************
  253. *                         Particular Cases
  254. *
  255. ***************************************************************************)
  256.  
  257.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  258.    Module[ {answer = HypergeometricMid[ uppar,lowpar,arg ]},
  259.      answer/;FreeQ[answer,HyperFail]
  260.   ]/;
  261.  Length[uppar] == Length[lowpar] + 1 
  262.  
  263.  HypergeometricMid[ {v1___,b_,v2___},u_,arg_ ] :=
  264.    Module[ {answer = FormulaS[ Length[u],b,u[[1]]-1,arg]},
  265.      answer/;FreeQ[answer,HyperFail]
  266.    ]/;
  267.    {v1,v2} === u-1 && Length[Union[u]] == 1
  268.  
  269.  FormulaS[ p_/;p=!=1,1,a_,1 ] := (-a)^p PolyGamma[p-1,a]/(p-1)!
  270.  
  271.  FormulaS[ p_,1,a_,-1 ] :=
  272.       (-a/2)^p (PolyGamma[p-1,Expand[a/2]] - 
  273.                 PolyGamma[p-1,Expand[a/2+1/2]])/(p-1)! 
  274.                                                                      
  275.  FormulaS[ p_/;p=!=1,1,a_,z_ ] := a^p LerchPhi[z,p,a]
  276.  
  277.  FormulaS[ p_,b_,a_,1 ] :=
  278.   Module[{r},
  279.      -Gamma[1-b] (-a)^p/(p-1)! *
  280.        (D[Gamma[r]/Gamma[1+r-b],{r,p-1}]//.{r->a}) ]/;
  281.  Not[IntegerQ[b]]  
  282.  
  283.  FormulaS[ p_,b_Integer,a_,-1 ] :=
  284.   Module[{r,k},
  285.      -(-a)^p/(Gamma[p] Gamma[b])*
  286.      (D[ Sum[Gamma[k] Pochhammer[1+k-r,b-1-k]/2^k,{k,1,b-1} ] +
  287.          Gamma[b-r] (PolyGamma[0,Expand[r/2+1/2]]-
  288.          PolyGamma[0,Expand[r/2]])/(2 Gamma[1-r]),{r,p-1} ]//.{r->a})]
  289.  
  290.  FormulaS[__] := HyperFail
  291.  
  292. (********************* Formula 9, p. 572, PBM *****************************)
  293.  
  294.  HypergeometricMid[ v_,{u1___,u2__},arg_ ] := 
  295.    FormulaForPolylog[Length[v]-1,Length[{u2}],arg]/;
  296.  Union[v]==={1} &&(Union[{u1}]==={2} && Union[{u2}]==={3}||
  297.                    Length[{u1}]==0 && Union[{u2}]==={3} )
  298.  
  299.  FormulaForPolylog[ q_,n_,arg_ ] :=
  300.     (-1)^q 2^n/arg Expand[
  301.      Sum[Pochhammer[q,k]/k! PolyLog1[n-k,arg],{k,0,n-1}]/arg +
  302.      Sum[Pochhammer[n,k] (-1)^(q-k)/k! PolyLog1[q-k,arg],{k,0,q-1}] -
  303.      Binomial[n+q-1,q] ]/.PolyLog1->PolyLog
  304.  
  305.  
  306.  HypergeometricMid[ __ ] := HyperFail
  307.  
  308. (**************************************************************************
  309. *                      HyperBessel Functions
  310. *
  311. ***************************************************************************)
  312.  
  313.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  314.    Module[ {answer =
  315.               If[Not[Znak[arg]],
  316.                  F03plus[lowpar,4 arg^(1/4)],
  317.                  F03minus[lowpar,2 (-4 arg)^(1/4)]] },
  318.      answer/;FreeQ[answer,HyperFail]
  319.   ]/;
  320.   Length[uppar]==0 && Length[lowpar]==3 
  321.  
  322.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  323.    Module[ {
  324.      answer =
  325.          F02p611[lowpar,
  326.          PowerExpand[3 If[Znak[arg],-(-arg)^(1/3),arg^(1/3)]]] },
  327.      answer/;FreeQ[answer,HyperFail]
  328.    ]/;
  329.   Length[uppar]==0 && Length[lowpar]==2 
  330.  
  331. (************************* Formula 7 & 8, p. 612, PBM *********************)
  332.  
  333.  F03plus[{v___,1/2,u___},z_] := HFormula7[{v,u},z]
  334.  
  335.  F03plus[{v___,3/2,u___},z_] := HFormula8[{v,u},z]
  336.  
  337.  F03plus[ __ ] := HyperFail
  338.  
  339.  HFormula7[ {a_,b_},z_ ] := 
  340.     Gamma[Expand[2 a]] (z/4)^Expand[1-a 2] (BesselI[Expand[2 a-1],z] +
  341.                    BesselJ[Expand[2 a-1],z])/(4^a)/;
  342.  Expand[b-a]===1/2
  343.  
  344.  HFormula7[ {b_,a_},z_ ] := 
  345.     Gamma[Expand[2 a]] (z/4)^Expand[1-a 2] (BesselI[Expand[2 a-1],z] +
  346.                    BesselJ[Expand[2 a-1],z])/(4^a)/;
  347.  Expand[b-a]===1/2
  348.  
  349.  HFormula8[ {a_,b_},z_ ] := 
  350.     Gamma[Expand[2 a]] (BesselI[Expand[2 a-2],z] -
  351.             BesselJ[Expand[2 a-2],z])/(2^(2 a+1) (z/4)^Expand[a 2])/;
  352.  Expand[b-a]===1/2
  353.  
  354.  HFormula8[ {b_,a_},z_ ] := 
  355.     Gamma[Expand[2 a]] (BesselI[Expand[2 a-2],z] -
  356.             BesselJ[Expand[2 a-2],z])/(2^(2 a+1) (z/4)^Expand[a 2])/;
  357.  Expand[b-a]===1/2
  358.  
  359.  HFormula7[ __ ] := HyperFail
  360.  
  361.  HFormula8[ __ ] := HyperFail
  362.  
  363. (************************* Formula 12, p. 612, PBM **************************)
  364.  
  365.  F03minus[ {v___,1/2,u___},z_ ] := HFormula1214[ {v,u},z ]
  366.  
  367.  F03minus[ {v___,3/2,u___},z_ ] := HFormula1619[ {v,u},z ]
  368.  
  369.  F03minus[ __ ] := HyperFail
  370.  
  371.  HFormula1214[ {1/4,3/4},z_ ] := Cosh[z] Cos[z]
  372.  
  373.  HFormula1214[ {3/4,1/4},z_ ] := Cosh[z] Cos[z]
  374.  
  375.  HFormula1214[ {5/4,3/4},z_ ] := (Sinh[z] Cos[z] + 
  376.        Cosh[z] Sin[z])/(2 z)
  377.  
  378.  HFormula1214[ {3/4,5/4},z_ ] := (Sinh[z] Cos[z] + 
  379.        Cosh[z] Sin[z])/(2 z)
  380.  
  381.  HFormula1214[ __ ] := HyperFail
  382.  
  383.  HFormula1619[ {5/4,3/4},z_ ] := Sinh[z] Sin[z] z^(-2)
  384.  
  385.  HFormula1619[ {3/4,5/4},z_ ] := Sinh[z] Sin[z] z^(-2)
  386.  
  387.  HFormula1619[ {5/4,7/4},z_ ] := (Cosh[z] Sin[z] - 
  388.        Sinh[z] Cos[z]) z^(-3) 3/2
  389.  
  390.  HFormula1619[ {7/4,5/4},z_ ] := (Cosh[z] Sin[z] - 
  391.        Sinh[z] Cos[z]) z^(-3) 3/2
  392.  
  393.  HFormula1619[ __ ] := HyperFail
  394.  
  395. (************************* Formula 1-3, p. 611, PBM *************************)
  396.  
  397.  F02p611[ {1/3,2/3},z_ ] := (E^z+2 E^(-z/2) Cos[z/2 Sqrt[3]])/3
  398.  
  399.  F02p611[ {2/3,4/3},z_ ] := (E^z-2 E^(-z/2) Cos[z/2 Sqrt[3]+Pi/3])/(3 z)
  400.  
  401.  F02p611[ {4/3,5/3},z_ ] := 2 (E^z-2 E^(-z/2) Cos[z/2 Sqrt[3]-Pi/3])/(3 z^2)
  402.  
  403.  F02p611[ __ ] := HyperFail
  404.  
  405. (**************************************************************************** 
  406. *                         Hypergeometric3F2 
  407. *
  408. *****************************************************************************)
  409.  
  410.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  411.    Module[ { answer = F32[uppar,lowpar,arg] },
  412.      answer/;FreeQ[answer,HyperFail]
  413.    ]/;
  414.   Length[uppar] == 3 && Length[lowpar] == 2
  415.  
  416.  F32[ {a___,1,b___},{v1_,v2_},1] := 
  417.   (v1-1)(v2-1)(PolyGamma[0,v1-1] - PolyGamma[0,v2-1])/(v1-v2)/;
  418.     v1=!=v2 && ({a,b}==={v1-1,v2-1} || {b,a}==={v1-1,v2-1})
  419.  
  420.  F32[ {1/2,1,1},{3/2,3/2},1 ] := 2 Catalan
  421.  
  422.  F32[ {1/2,1/2,1},{5/2,5/2},-1 ] := 9/8(4-Pi)
  423.  
  424. (************************* Formula 13, p. 498, PBM **************************)
  425.  
  426.  F32[ {v1___,a_,v2___,a1_,v3___},{u1___,a2_,u2___},z_ ] := 
  427.          F32N1[{a,v1,v2,v3},{u1,u2},z]/;   
  428.   Expand[a1-a-1/2]===0 && Expand[a2- 2 a]===0
  429.  
  430.  F32N1[ {a_,b_},{c_},z_ ] := ( (1+Sqrt[1-z])/2 )^(-b)*
  431.          F21[b,2 a-b,b+1,1/2-Sqrt[1-z]/2]/;
  432.   c-b===1
  433.  
  434.  F32N1[ __ ] := HyperFail
  435.  
  436. (************************* Formula 30, p. 499, PBM **************************)
  437.  
  438.  F32[ v_,{1/3,2/3},z_ ] := F32Formula30[ v,((Plus@@v)-1)/3, 
  439.     If[ Znak[z],(-z)^(1/3) E^(Pi I/3),z^(1/3)] ]
  440.       
  441.  F32Formula30[ v_,midl_,arg_ ] := ( (1-arg)^(-3 midl) +
  442.     (1-arg E^(2Pi I/3))^(-3 midl) + (1-arg E^(4Pi I/3))^(-3 midl) )/3
  443.  Union[Expand[v - Sort[{midl,midl+1/3,midl+2/3}]]]==={0}
  444.       
  445.  F32Formula30[ __ ] := HyperFail
  446.  
  447. (************************* Formula 31, p. 499, PBM **************************)
  448.  
  449.  F32[ v_,{2/3,4/3},z_ ] := F32Formula31[ v,((Plus@@v)-1)/3, 
  450.     If[ Znak[z],(-z)^(1/3) E^(Pi I/3),z^(1/3)] ]
  451.       
  452.  F32Formula31[ v_,midl_,arg_ ] := ( (1-arg)^(1-3 midl) +
  453.     E^(-2Pi I/3)(1-arg E^(2Pi I/3))^(1-3 midl) + 
  454.     E^(-4Pi I/3)(1-arg E^(4Pi I/3))^(1-3 midl) )/
  455.     (3 arg (3 midl-1))
  456.  Union[Expand[v - Sort[{midl,midl+1/3,midl+2/3}]]]==={0}
  457.       
  458.  F32Formula31[ __ ] := HyperFail
  459.  
  460. (************************* Formula 24, p. 535, PBM **************************)
  461.  
  462.  F32[ {v1___,a_,v2___,a1_,v3___},{u1_,u2_},1 ] := 
  463.          F32N2[{a,v1,v2,v3},{u1,u2}]/;   
  464.   Expand[a+a1-1]===0 
  465.  
  466.  F32N2[ {a_,b_},{c_,d_} ] := 2^(1-2 b) Pi Gamma[c] Gamma[d]/
  467.       (Gamma[Expand[a/2+c/2]] Gamma[Expand[b+(1+a-c)/2]]*
  468.        Gamma[Expand[(1+c-a)/2]] Gamma[Expand[1+b-(a+c)/2]])/;
  469.    Expand[d-1 +c-2 b]===0
  470.  
  471.  F32N2[ {a_,b_},{d_,c_} ] := 2^(1-2 b) Pi Gamma[c] Gamma[d]/
  472.       (Gamma[Expand[a/2+c/2]] Gamma[Expand[b+(1+a-c)/2]]*
  473.        Gamma[Expand[(1+c-a)/2]] Gamma[Expand[1+b-(a+c)/2]])/;
  474.    Expand[d-1 +c-2 b]===0
  475.  
  476.  F32N2[ __ ] := HyperFail
  477.  
  478. (************************* Formula 40-41, p. 537, PBM ***********************)
  479.   
  480.  F32[ {v1___,a_/;a=!=1,v2___},{u1___,b_,u2___},1 ] :=
  481.    (b-1) (PolyGamma[0,b-1]-PolyGamma[0,b-a])/(a-1)/;
  482.  {v1,v2}==={1,1} && {u1,u2}==={2}
  483.   
  484.  F32[ {1,1,1},{u1___,b_,u2___},1 ] :=
  485.    (b-1) PolyGamma[1,b-1]/;
  486.  {u1,u2}==={2}
  487.  
  488. (************************* Formula 42-44, p. 537, PBM ***********************)
  489.   
  490.  F32[ {v1___,a_/;a=!=1&&a=!=2,v2___},{u1___,b_,u2___},1 ] :=
  491.    2 (b-1) (b-a) (PolyGamma[0,b-a+1]-PolyGamma[0,b-1])/((a-2)(a-1)) +
  492.    2 (b-1)/(a-1)/;
  493.  {v1,v2}==={1,1} && {u1,u2}==={3}
  494.   
  495.  F32[ {1,1,1},{u1___,b_,u2___},1 ] :=
  496.    2 (2-b) + 2 (b-1)^2 PolyGamma[1,b]/;
  497.  {u1,u2}==={3}
  498.   
  499.  F32[ {v1___,2,v2___},{u1___,b_,u2___},1 ] :=
  500.    2 (b-1) (1 - (b-2) PolyGamma[1,b-1])/;
  501.  {v1,v2}==={1,1} && {u1,u2}==={3}
  502.  
  503. (************************* Formula 50, 67, 70, p. 537, PBM ******************)
  504.  
  505.  F32[ {v1___,b_/;FreeQ[{1,2,3},b],v2___},u_,1 ] := 
  506.     F32Formula50[Union[{v1,v2}][[1]],b]/;u===2+{v1,v2}
  507.  
  508.  F32Formula50[ a_,b_ ] := 
  509.     Gamma[2+a] Gamma[1-b]/Gamma[2+a-b] ( a(a+1)(b-2a-1) (
  510.     PolyGamma[0,2+a]-PolyGamma[0,2+a-b] ) +2a^2+(1-b)(1-2a^2) )
  511.  
  512.  F32[ {v1___,3,v2___},u_,1 ] := 
  513.     F32Formula70[Union[{v1,v2}][[1]]]/;u===2+{v1,v2}
  514.  
  515.  F32Formula70[ a_ ] := a^2(a+1)^2/2 (3-2a+2(a-1)^2 PolyGamma[1,a])
  516.  
  517.  F32[ {v1___,2,v2___},u_,1 ] := 
  518.     F32Formula67[Union[{v1,v2}][[1]]]/;u===2+{v1,v2}
  519.  
  520.  F32Formula67[ a_ ] := -a^2(a+1)^2 (-2+(2a-1) PolyGamma[1,a])
  521.  
  522. (************************* Formula 88, p. 539, PBM **************************)
  523.  
  524.  F32[ {v1___,n_/;Znak[n],v2___},{c_,d_},1 ] := F32Formula88[-n,{v1,v2},c]/;
  525.  Expand[d-1+c-n-Plus@@{v1,v2}]===0
  526.  
  527.  F32[ {v1___,n_/;Znak[n],v2___},{d_,c_},1 ] := F32Formula88[-n,{v1,v2},c]/;
  528.  Expand[d-1+c-n-Plus@@{v1,v2}]===0
  529.  
  530.  F32Formula88[ n_,{a_,b_},c_ ] := Pochhammer[c-a,n] Pochhammer[c-b,n]/(
  531.     Pochhammer[c,n] Pochhammer[c-a-b,n])
  532.  
  533. (************************* Formula 97 & 99, p. 539, PBM ********************)
  534.  
  535.  F32[ {v1___,k_Integer?Negative a_Symbol,v2___},u_,1 ] := 
  536.     F32Form99[ -k a,{v1,v2},u ]
  537.  
  538.  F32Form99[ n_,{a_,b_},{v1_,v2_} ] := 
  539.    Pochhammer[1+a,n] Pochhammer[1+a/2-b,n]/(
  540.    Pochhammer[1+a/2,n] Pochhammer[1+a-b,n] ) /; a+n=!=0 &&(
  541.    v1===1+a+n && v2===1+a-b || v1===1+a-b && v2===1+a+n)
  542.  
  543.  F32Form99[ n_,{b_,a_},{v1_,v2_} ] := 
  544.    Pochhammer[1+a,n] Pochhammer[1+a/2-b,n]/(
  545.    Pochhammer[1+a/2,n] Pochhammer[1+a-b,n] ) /; a+n=!=0 &&(
  546.    v1===1+a+n && v2===1+a-b || v1===1+a-b && v2===1+a+n)
  547.  
  548.  F32Form99[ n_,{a_,b_},{v1_,v2_} ] := (1+(-1)^n) *
  549.    (-4)^(n/2) Pochhammer[1-a-b-n,n/2] Pochhammer[1/2,n/2]/(
  550.    2 Pochhammer[1-a-n,n/2] Pochhammer[1-b-n,n/2]) /;
  551.    v1===1-a-n && v2===1-b-n || v1===1-b-n && v2===1-a-n 
  552.  
  553.  F32Form99[ n_,{b_,a_},{v1_,v2_} ] := (1+(-1)^n) *
  554.    (-4)^(n/2) Pochhammer[1-a-b-n,n/2] Pochhammer[1/2,n/2]/(
  555.    2 Pochhammer[1-a-n,n/2] Pochhammer[1-b-n,n/2]) /;
  556.    v1===1-a-n && v2===1-b-n || v1===1-b-n && v2===1-a-n 
  557.  
  558.  F32Form99[ __ ] := HyperFail
  559.  
  560.  F32[ __ ] := HyperFail
  561.  
  562. (****************************************************************************
  563. *                         Hypergeometric2F1
  564. *
  565. *****************************************************************************)
  566.  
  567.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  568.    Hypergeometric2F1[ uppar[[1]],uppar[[2]],lowpar[[1]],arg] /;
  569.  Length[uppar] == 2 && Length[lowpar] == 1 &&
  570.  Accuracy[{uppar,lowpar,arg}] < Infinity
  571.  
  572.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  573.   Module[ {answer},
  574.    answer = F21[uppar[[1]],uppar[[2]],lowpar[[1]],arg];
  575.    answer = If[ FreeQ[answer,HyperFail],
  576.                 (answer/.LogTrig)/.Gamma[w_] :> Gamma[Expand[w]] ,
  577.             If[ arg=!=1,
  578.                 (1-arg)^(lowpar[[1]]-uppar[[1]]-uppar[[2]]) *
  579.                 F21[ lowpar[[1]]-uppar[[1]],lowpar[[1]]-uppar[[2]],
  580.                      lowpar[[1]],arg ],
  581.                 HyperFail]];
  582.    If[ FreeQ[answer,HyperFail],
  583.        (answer/.LogTrig)/.Gamma[w_] :> Gamma[Expand[w]] , 
  584.        GaussFlag = False;   
  585.        answer = Hypergeometric2F1[ uppar[[1]],uppar[[2]],
  586.                                    lowpar[[1]],arg ]];
  587.        GaussFlag = True;
  588.        answer 
  589.    ]/;
  590.   Length[uppar] == 2 && Length[lowpar] == 1
  591.  
  592.  GaussFlag = True
  593. (***************************** In Unit **************************************)
  594.  
  595.  F21[ a_,b_,c_,1 ] := Gamma[c] Gamma[c-a-b]/(Gamma[c-a] Gamma[c-b])/;
  596.  Not[NumberQ[c-a-b]] || Re[c-a-b]>0
  597.  
  598.  F21[ 1,a_,b_,-1 ] := a PolyGamma[0,a/2+1/2]/2-a PolyGamma[0,a/2]/2/;
  599.  b===a+1
  600.  
  601.  F21[ a_,1,b_,-1 ] := a PolyGamma[0,a/2+1/2]/2-a PolyGamma[0,a/2]/2/;
  602.  b===a+1
  603.  
  604.  F21[ 1,a_,b_,-1 ] := a (a+1) (PolyGamma[0,(a+1)/2]-PolyGamma[0,a/2])-a-1/;
  605.  b===a+2
  606.  
  607.  F21[ a_,1,b_,-1 ] := a (a+1) (PolyGamma[0,(a+1)/2]-PolyGamma[0,a/2])-a-1/;
  608.  b===a+2
  609.  
  610.  F21[ 1,a_,b_,-1 ] := a (a+1) (a+2) (PolyGamma[0,(a+1)/2]-PolyGamma[0,a/2])-
  611.                       a^2-7 a/2-3/;
  612.  b===a+3
  613.  
  614.  F21[ a_,1,b_,-1 ] := a (a+1) (a+2) (PolyGamma[0,(a+1)/2]-PolyGamma[0,a/2])-
  615.                       a^2-7 a/2-3/;
  616.  b===a+3
  617.  
  618.  F21[ 2,a_,b_,-1 ] := (b-2) (b-1) ( 1-(b-1) (a+b-3) F21[1,a-1,b-1,-1] )/
  619.                      (2 (1-a))/;
  620.  a=!=1 
  621.  
  622.  F21[ a_,2,b_,-1 ] := (b-2) (b-1) ( 1-(b-1) (a+b-3) F21[1,a-1,b-1,-1] )/
  623.                      (2 (1-a))/;
  624.  a=!=1 
  625.  
  626.  F21[ 2,a_,b_,-1 ] := a (a-1) (PolyGamma[0,a/2]-PolyGamma[0,(a-1)/2])/2 -a/2 /;
  627.  b===a+1
  628.  
  629.  F21[ a_,2,b_,-1 ] := a (a-1) (PolyGamma[0,a/2]-PolyGamma[0,(a-1)/2])/2 -a/2 /;
  630.  b===a+1
  631.  
  632.  F21[ a_,b_,c_,-1 ] := 2^(-a) Sqrt[Pi] Gamma[1+a-b]/(Gamma[1/2+a/2]*
  633.                   Gamma[1-b+a/2])/;
  634.  Expand[c-1-a+b]===0
  635.  
  636.  F21[ b_,a_,c_,-1 ] := 2^(-a) Sqrt[Pi] Gamma[1+a-b]/(Gamma[1/2+a/2]*
  637.                   Gamma[1-b+a/2])/;
  638.  Expand[c-1-a+b]===0
  639.  
  640.  F21[ a_,b_,c_,-1 ] := 2^(-a) Sqrt[Pi] Gamma[c]*
  641.    (1/(Gamma[a/2-b] Gamma[a/2+1/2])+a/(2 Gamma[a/2-b+1/2] Gamma[a/2+1]))/; 
  642.  Expand[c-a+b]===0
  643.  
  644.  F21[ b_,a_,c_,-1 ] := 2^(-a) Sqrt[Pi] Gamma[c]*
  645.    (1/(Gamma[a/2-b] Gamma[a/2+1/2])+a/(2 Gamma[a/2-b+1/2] Gamma[a/2+1]))/; 
  646.  Expand[c-a+b]===0
  647.  
  648.  F21[ b_,a_,c_,2 ] := 2^(-2 a) (-a)!/(-2 a)! Pochhammer[1/2+b/2,-a] /; 
  649.  Expand[c-2 a]===0 && ZnakSum[a] && ZnakSum[c]
  650.  
  651.  F21[ a_,b_,c_,2 ] := 2^(-2 a) (-a)!/(-2 a)! Pochhammer[1/2+b/2,-a] /; 
  652.  Expand[c-2 a]===0 && ZnakSum[a] && ZnakSum[c]
  653.  
  654. (************************* Formula 106, p. 461, PBM **************************)
  655.  
  656.  F21[ a_,b_,1/2,z_/;Not[Znak[z]] ] := 
  657.    ((1+Sqrt[z])^(-2 a)+(1-Sqrt[z])^(-2 a))/2/;Expand[b-a-1/2]===0
  658.  
  659.  F21[ b_,a_,1/2,z_/;Not[Znak[z]] ] := 
  660.    ((1+Sqrt[z])^(-2 a)+(1-Sqrt[z])^(-2 a))/2/;Expand[b-a-1/2]===0
  661.  
  662. (************************* Formula 107, p. 461, PBM **************************)
  663.  
  664.  F21[ a_,b_,3/2,z_/;Not[Znak[z]] ] := 
  665.    (-(1+Sqrt[z])^(1-2 a)+(1-Sqrt[z])^(1-2 a))/(2 (2 a-1) Sqrt[z])/;
  666.  Expand[b-a-1/2]===0 && a=!=1/2
  667.  
  668.  F21[ b_,a_,3/2,z_/;Not[Znak[z]] ] := 
  669.    (-(1+Sqrt[z])^(1-2 a)+(1-Sqrt[z])^(1-2 a))/(2 (2 a-1) Sqrt[z])/;
  670.  Expand[b-a-1/2]===0 && a=!=1/2
  671.  
  672. (************************* Formula 132, p. 463, PBM **************************)
  673.  
  674.  F21[ 1,n_Integer,b_Rational?Positive,z_/;Abs[z]=!=1 ] := 
  675.     Module[ {m},
  676.      m = n-b+1/2;
  677.       Pochhammer[1/2,m] F21[1,b-1/2,b,z]/((1-z)^m Pochhammer[b-1/2,m]) +
  678.       (b-1) Sum[ Pochhammer[1/2-m,k]/(Pochhammer[2-n,k] (1-z)^(1+k)),
  679.       {k,0,m-1}]/(n-1) ]/;
  680.  b!=1/2 && Denominator[b]===2 && n-b-1/2 >= 0
  681.  
  682.  F21[ n_Integer,1,b_Rational?Positive,z_/;Abs[z]=!=1 ] := 
  683.     Module[ {m},
  684.      m = n-b+1/2;
  685.       Pochhammer[1/2,m] F21[1,b-1/2,b,z]/((1-z)^m Pochhammer[b-1/2,m]) +
  686.       (b-1) Sum[ Pochhammer[1/2-m,k]/(Pochhammer[2-n,k] (1-z)^(1+k)),
  687.       {k,0,m-1}]/(n-1) ]/;
  688.  b!=1/2 && Denominator[b]===2 && n-b-1/2 >= 0
  689.  
  690. (************************* Formula 133, p. 463, PBM **************************)
  691.  
  692.  F21[ 1,n_Integer,b_Rational?Positive,z_/;Abs[z]=!=1 ] := 
  693.     Pochhammer[1/2,n] (2 Sqrt[z]*
  694.     ArcSin[Sqrt[z]]/Sqrt[1-z] - Sum[(k-1)! z^k/Pochhammer[1/2,k],
  695.         {k,1,n-1}])/(z^n (n-1)!)/;
  696.  b-n===1/2 && Not[Znak[z]]
  697.  
  698.  F21[ n_Integer,1,b_Rational?Positive,z_/;Abs[z]=!=1 ] := 
  699.     Pochhammer[1/2,n] (2 Sqrt[z]*
  700.     ArcSin[Sqrt[z]]/Sqrt[1-z] - Sum[(k-1)! z^k/Pochhammer[1/2,k],
  701.          {k,1,n-1}])/(z^n (n-1)!)/;
  702.  b-n===1/2 && Not[Znak[z]]
  703.  
  704. (************************* Formula 134, p. 463, PBM **************************)
  705.  
  706.  F21[ 1,a_Rational?Positive,b_,z_/;Abs[z]=!=1 ] := 
  707.    2 a z^(-a) ArcTanh[ Sqrt[z] ] -
  708.    2 a z^(-a-1/2) Sum[z^k/(2 k-1),{k,1,a-1/2}]/;
  709.  Denominator[a]==2 && b===a+1 && Not[Znak[z]]
  710.  
  711.  F21[ a_Rational?Positive,1,b_,z_/;Abs[z]=!=1 ] := 
  712.    2 a z^(-a) ArcTanh[ Sqrt[z] ] -
  713.    2 a z^(-a-1/2) Sum[z^k/(2 k-1),{k,1,a-1/2}]/;
  714.  Denominator[a]==2 && b===a+1 && Not[Znak[z]]
  715.  
  716. (************************* Formula 135, p. 463, PBM **************************)
  717.  
  718.  F21[ 1,n_Integer,m_,z_/;Abs[z]=!=1 ] := 
  719.     -n Log[1-z]/z^n - n z^(-n) Sum[z^k/k,{k,1,n-1}]/; m===n+1
  720.  
  721.  F21[ n_Integer,1,m_,z_/;Abs[z]=!=1 ] := 
  722.     -n Log[1-z]/z^n - n z^(-n) Sum[z^k/k,{k,1,n-1}]/;m===n+1 
  723.  
  724. (************************* Formula 136, p. 463, PBM **************************)
  725.  
  726.  F21[ 1,1,m_Integer?Positive,z_/;z=!=1 ] := 
  727.     (m-1) z/(z-1)^2( Sum[(z-1)^k z^(-k)/(m-k),{k,2,m-1}] -
  728.                      ((z-1)/z)^m Log[1-z] ) 
  729.  
  730. (************************* Formula 137, p. 463, PBM **************************)
  731.  
  732.  F21[ v1_,v2_,a_,z_/;Abs[z]=!=1 && Not[Znak[z]] ] := 
  733.     Pochhammer[1/2,a-1/2] (z-1)^(a-3/2) ( 2 Sqrt[z] *
  734.     ArcTanh[ Sqrt[z] ] + Sum[(k-1)! z^k/(Pochhammer[1/2,k] *
  735.     (z-1)^k),{k,1,a-3/2}])/((a-3/2)! z^(a-1/2))/;
  736.  IntegerQ[a-1/2] && a-1/2 > 0 && (v1===1 && v2===1/2 || v2===1 && v1===1/2)
  737.  
  738.  F21[ v1_,v2_,a_,z_/;Abs[z]=!=1 && Znak[z] ] := 
  739.     Pochhammer[1/2,a-1/2] (z-1)^(a-3/2) ( Sqrt[-z] *
  740.     (-2) ArcTan[Sqrt[-z]] + Sum[(k-1)! z^k/(Pochhammer[1/2,k] *
  741.     (z-1)^k),{k,1,a-3/2}])/((a-3/2)! z^(a-1/2))/;
  742.  IntegerQ[a-1/2] && a-1/2 > 0 && (v1===1 && v2===1/2 || v2===1 && v1===1/2)
  743.  
  744. (************************* Formula 138, p. 464, PBM **************************)
  745.  
  746.  F21[ 1,1,b_,z_/;Abs[z]=!=1 && Not[Znak[z]] ] := 
  747.     (2 b - 2) (z-1)^(b-3/2) z^(1/2-b) ( 
  748.        z^(1/2) (1-z)^(-1/2) ArcSin[z^(1/2)] + 
  749.        Sum[ z^k (z-1)^(-k) (2 k-1)^(-1),{k,1,b-3/2}])/;
  750.  IntegerQ[b-1/2] && b>1  
  751.  
  752.  F21[ 1,1,b_,z_/;Abs[z]=!=1 && Znak[z] ] := 
  753.     (2 b - 2) (z-1)^(b-3/2) z^(1/2-b) (
  754.        -(-z)^(1/2) (1-z)^(-1/2) Log[Sqrt[-z]+Sqrt[1-z]] +
  755.        Sum[ z^k (z-1)^(-k) (2 k-1)^(-1),{k,1,b-3/2}])/;
  756.  IntegerQ[b-1/2] && b>1 
  757.  
  758.  F21[ 1,1,1/2,z_/;Abs[z]=!=1 && Not[Znak[z]] ] := 
  759.     (1-z)^(-1) (1 + Sqrt[z] ArcSin[Sqrt[z]]/Sqrt[1-z])
  760.  
  761. (************************* Formula 1, p. 486, PBM **************************)
  762.  
  763.  F21[ a_,b_,1/2,z_/;Znak[z] ] := (1-z)^(-a) Cos[2 a ArcTan[Sqrt[-z]]]/;
  764.  Expand[b-a-1/2]===0
  765.  
  766.  F21[ b_,a_,1/2,z_/;Znak[z] ] := (1-z)^(-a) Cos[2 a ArcTan[Sqrt[-z]]]/;
  767.  Expand[b-a-1/2]===0
  768.  
  769. (************************* Formula 2, p. 486, PBM **************************)
  770.  
  771.  F21[ a_,b_,3/2,z_/;Znak[z] ] := 
  772.    (1-z)^(1/2-a) Sin[Expand[(2 a-1) ArcTan[Sqrt[-z]]]]/((2 a-1) Sqrt[-z])/;
  773.  Expand[b-a-1/2]===0 && a=!=1/2
  774.  
  775.  F21[ b_,a_,3/2,z_/;Znak[z] ] := 
  776.    (1-z)^(1/2-a) Sin[Expand[(2 a-1) ArcTan[Sqrt[-z]]]]/((2 a-1) Sqrt[-z])/;
  777.  Expand[b-a-1/2]===0 && a=!=1/2
  778.  
  779. (************************* Formula 9, p. 487, PBM **************************)
  780.  
  781.  F21[ 1,a_Rational?Positive,b_,z_/;Abs[z]=!=1 ] := 
  782.     a Sum[ (-1)^(k-1) (-z)^(-k)/(a-k),{k,1,a-1/2}] +
  783.     a (-z)^(-a) (2 Sin[a Pi] ArcTan[(-z)^(1/2)]-Cos[a Pi] Log[1+z])/;
  784.  Denominator[a]==2 && b===a+1 && Znak[z]
  785.  
  786.  F21[ a_Rational?Positive,1,b_,z_/;Abs[z]=!=1 ] := 
  787.     a Sum[ (-1)^(k-1) (-z)^(-k)/(a-k),{k,1,a-1/2}] +
  788.     a (-z)^(-a) (2 Sin[a Pi] ArcTan[(-z)^(1/2)]-Cos[a Pi] Log[1+z])/;
  789.  Denominator[a]==2 && b===a+1 && Znak[z]
  790.  
  791. (************************* Formula 131, p. 463, PBM ************************)
  792. (*                              &&                                         *)
  793. (************************* Formula 8, p. 486, PBM **************************)
  794.  
  795.  F21[ 1,a_Rational/;0<a<1,b_Rational,z_/;Abs[z]=!=1&&Not[Znak[z]] ] := 
  796.     F21Formula131P463[Numerator[a],Denominator[a],z]/;b-a-1==0
  797.  
  798.  F21[ 1,a_Rational/;0<a<1,b_Rational,z_/;Abs[z]=!=1&&Znak[z] ] := 
  799.     F21Formula8P486[Numerator[a],Denominator[a],-z]/;b-a-1==0
  800.  
  801.  F21[ 1,a_Rational/;a>1,b_Rational,z_/;Abs[z]=!=1 ] := 
  802.     a/(z (a-1))(-1 + F21[1,a-1,a,z])/;b-a-1==0
  803.  
  804.  F21Formula131P463[ m_,n_,z_ ] := 
  805.     Module[ {arg = z^(1/n), par1 = 2 Pi/n, par2 = 2 Pi m/n},
  806.       -m z^(-m/n)/n ( Log[1-arg] + (-1)^m/2 (1+(-1)^n) Log[1+arg] +
  807.       Sum[ Cos[par2 k] Log[1-2arg Cos[par1 k] + arg^2] -
  808.            2Sin[par2 k] ArcTan[arg Sin[par1 k]/(1-arg Cos[par1 k])],
  809.       {k,1,Floor[(n-1)/2]}])
  810.     ]
  811.  
  812.  F21Formula8P486[ m_,n_,z_ ] := 
  813.     Module[ {arg = z^(1/n), par1 = Pi/n, par2 = Pi m/n},
  814.       -m z^(-m/n)/n ( (-1)^m (1-(-1)^n) Log[1+arg]/2 +
  815.       Sum[ Cos[par2 (2k+1)] Log[1-2arg Cos[par1 (2k+1)] + arg^2] -
  816.            2Sin[par2 (2k+1)] ArcTan[arg Sin[par1 (2k+1)]/
  817.            (1-arg Cos[par1 (2k+1)])],
  818.       {k,0,Floor[n/2]-1}]) 
  819.     ]
  820.  
  821. (************************* Formula 5, p. 491, PBM ****************************)
  822.  
  823.  F21[ a_,b_,c_,1/2 ] := Sqrt[Pi] Gamma[c]/(Gamma[a/2+1/2] Gamma[b/2+1/2])/;
  824.  Expand[2 c-a-b-1]===0
  825.  
  826. (************************* Polynomials ***************************************)
  827.  
  828. (************************* Formula 203, p. 467, PBM **************************)
  829.  
  830.  F21[ n_,m_,1/2,z_/;z=!=1 ] := ChebyshevT[-2n,Sqrt[1-z]]/;
  831.  ZnakSum[n] && Expand[m+n]===0
  832.  
  833. (************************* Formula 207, p. 468, PBM **************************)
  834.  
  835.  F21[ a_,b_/;ZnakSum[b],c_,z_/;Not[Znak[z]] ] := 
  836.     2^c/z^b Cos[2 b ArcCos[1/Sqrt[z]]]/;
  837.  NotFreeSymbolicSum[] &&
  838.  Expand[a-b-1/2]===0 && Expand[c-2 a]===0
  839.  
  840.  F21[ b_/;ZnakSum[b],a_,,c_,z_/;Not[Znak[z]] ] := 
  841.     2^c/z^b Cos[2 b ArcCos[1/Sqrt[z]]]/;
  842.  NotFreeSymbolicSum[] &&
  843.  Expand[a-b-1/2]===0 && Expand[c-2 a]===0
  844.  
  845. (************************* Formula 203, p. 467, PBM **************************)
  846.  
  847.  F21[ n_,m_,c_,z_/;Not[Znak[z]] ] := (-1)^(-4n) (-2n)! *
  848.     If[ Expand[c-2 n]===0, 1/(-2 n)!, Gamma[c]/Gamma[c-2n] ] *
  849.     (z/4)^(-n) GegenbauerC[-2n,1-c+2n,1/Sqrt[z]]/;
  850.  NotFreeSymbolicSum[] &&
  851.  ZnakSum[n] && Expand[m-n-1/2]===0 && (!NumberQ[n] || !NumberQ[m])
  852.  
  853.  F21[ m_,n_,c_,z_/;Not[Znak[z]] ] := (-1)^(-4n) (-2n)! *
  854.     If[ Expand[c-2 n]===0, 1/(-2 n)!, Gamma[c]/Gamma[c-2n] ] *
  855.     (z/4)^(-n) GegenbauerC[-2n,1-c+2n,1/Sqrt[z]]/;
  856.  NotFreeSymbolicSum[] &&
  857.  ZnakSum[n] && Expand[m-n-1/2]===0 && (!NumberQ[n] || !NumberQ[m])
  858.  
  859.  NotFreeSymbolicSum[___] := If[ Names["SymbolicSum"] =!= {}, True, False ]
  860.  
  861. (************************** Elliptic *****************************************)
  862.  
  863.  F21[ 1/4,3/4,1,z_/;Not[Znak[z]] ] := 
  864.         2 PowerExpand[EllipticK[2 Sqrt[z]/(1+Sqrt[z])]/
  865.            (Pi Sqrt[1+Sqrt[z]])]
  866.  
  867.  F21[ 3/4,1/4,1,z_/;Not[Znak[z]] ] := 
  868.         2 PowerExpand[EllipticK[2 Sqrt[z]/(1+Sqrt[z])]/
  869.            (Pi Sqrt[1+Sqrt[z]])]
  870.  
  871.  F21[ 1/2,1/2,1,z_ ]  := 2 EllipticK[z]/Pi
  872.  
  873.  F21[ -1/2,1/2,1,z_ ] := 2 EllipticE[z]/Pi
  874.  
  875.  F21[ 1/2,-1/2,1,z_ ] := 2 EllipticE[z]/Pi
  876.  
  877.  F21[ 1/2,3/2,1,z_ ] := 2 EllipticE[z]/(Pi (1-z))
  878.  
  879.  F21[ 3/2,1/2,1,z_ ] := 2 EllipticE[z]/(Pi (1-z))
  880.  
  881.  F21[ __ ] := HyperFail
  882.  
  883.  
  884. (**************************************************************************** 
  885. *                         Hypergeometric1F1 
  886. *
  887. *****************************************************************************)
  888.  
  889.  GeneralHypergeometricPFQ[ {uppar_},{lowpar_},arg_ ] := 
  890.    Hypergeometric1F1[ uppar,lowpar,arg] /;
  891.  Accuracy[{uppar,lowpar,arg}] < Infinity
  892.  
  893.  GeneralHypergeometricPFQ[ {uppar_},{lowpar_},arg_ ] := 
  894.   Module[ {r},
  895.     r = F11[ uppar,lowpar,arg ];
  896.     r = If[ FreeQ[r,HyperFail],r,
  897.             E^arg F11[lowpar-uppar,lowpar,-arg] ];
  898.     If[ FreeQ[r,HyperFail],r,KummerFlag[]:=False;
  899.         r = Hypergeometric1F1[uppar,lowpar,arg]];
  900.         KummerFlag[] := True;
  901.         r
  902.   ]
  903.  
  904.  KummerFlag[] := True
  905.  
  906.  F11[ 1,3/2,z_ ] := Sqrt[Pi] Erf[Sqrt[z]] E^z /(2 Sqrt[z])
  907.  
  908.  F11[ 1/2,3/2,z_ ] := Sqrt[Pi] Erf[Sqrt[-z]] /(2 Sqrt[-z])
  909.  
  910. (************************* Formula 11 , p. 579, PBM *************************)
  911.  
  912.  F11[ n_Integer?Positive,b_,z_/;Not[Znak[z]] ] := (b-1)/(n-1)!*
  913.    Module[{var},D[var^(n-b) E^var Gamma[b-1,0,var],{var,n-1}]/.var->z]/;
  914.  Not[NumberQ[b]] || Re[b]>1
  915.  
  916. (************************* Formula 5 , p. 579, PBM **************************)
  917.  
  918.  F11[ a_,b_,z_ ] := Gamma[a+1/2] z^(1/2-a) 2^(b-1) E^(z/2)*
  919.     BesselI[a-1/2,z/2]/;
  920.  Expand[b-2 a]===0
  921.  
  922. (************************* Formula 1 , p. 583, PBM **************************)
  923.  
  924.  F11[ a_,b_,z_/;Znak[z] ] := a (-z)^(-a) Gamma[a,0,-z]/;b-a-1===0
  925.  
  926. (************************* Formula 17 , p. 579, PBM *************************)
  927.  
  928.  F11[ a_/;Znak[a],b_,z_ ] := (-a)! LaguerreL[-a,b-1,z] Gamma[b]/Gamma[b-a]
  929.  
  930.  F11[ __ ] := HyperFail
  931.  
  932.  
  933. (**************************************************************************** 
  934. *                         Hypergeometric1F2 
  935. *
  936. *****************************************************************************)
  937.  
  938.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  939.    Module[ { answer = F12[ uppar[[1]],lowpar,arg ] },
  940.      answer/;FreeQ[answer,HyperFail]
  941.    ]/;
  942.   Length[uppar] == 1 && Length[lowpar] == 2
  943.  
  944.  F12[ 1/2,{3/2,3/2},arg_/;Znak[arg] ] := 
  945.    SinIntegral[Sqrt[-arg] 2]/(Sqrt[-arg] 2) 
  946.  
  947.  F12[ __ ] := HyperFail
  948.  
  949. (**************************************************************************** 
  950. *                         Hypergeometric2F2 
  951. *
  952. *****************************************************************************)
  953.  
  954.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  955.    Module[ { answer = F22[ uppar,lowpar,arg ] },
  956.      answer/;FreeQ[answer,HyperFail]
  957.    ]/;
  958.   Length[uppar] == 2 && Length[lowpar] == 2
  959.  
  960.  F22[ {1,1},{2,2},z_/;Not[Znak[z]]] := (ExpIntegralEi[z] - Log[z] -
  961.     EulerGamma)/z
  962.  
  963.  F22[ {1,1},{2,2},z_/;Znak[z]] := (ExpIntegralEi[z] - Log[-z] -
  964.     EulerGamma)/z
  965.  
  966.  F22[ __ ] := HyperFail
  967.  
  968. (**************************************************************************** 
  969. *                         Hypergeometric2F0 
  970. *
  971. *****************************************************************************)
  972.  
  973.  GeneralHypergeometricPFQ[ uppar_,{},arg_ ] := 
  974.    Module[ { answer = F20[ uppar,arg ] },
  975.      answer/;FreeQ[answer,HyperFail]
  976.    ]/;
  977.   Length[uppar] == 2 
  978.  
  979.  F20[ {n_,m_},z_/;Znak[z] ] := 2^(2 n) (-z)^(-n) HermiteH[-2 n,1/Sqrt[-z]]/;
  980.  ZnakSum[n] && Expand[m-n-1/2]===0
  981.  
  982.  F20[ {m_,n_},z_/;Znak[z] ] := 2^(2 n) (-z)^(-n) HermiteH[-2 n,1/Sqrt[-z]]/;
  983.  ZnakSum[n] && Expand[m-n-1/2]===0
  984.  
  985.  F20[ __ ] := HyperFail
  986.  
  987. (**************************************************************************** 
  988. *                         Hypergeometric2F3 
  989. *
  990. *****************************************************************************)
  991.  
  992.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  993.    Module[ {
  994.      answer = F23[ uppar,lowpar,arg ] },
  995.      answer/;FreeQ[answer,HyperFail]
  996.    ]/;
  997.   Length[uppar] == 2 && Length[lowpar] == 3
  998.  
  999.  F23[ uppar_,{v1___,1/2,v2___},arg_ ] := 
  1000.    F23ToBessel1[uppar,Sort[{v1,v2}],arg]
  1001.  
  1002.  F23[ uppar_,{v1___,3/2,v2___},arg_ ] := 
  1003.    F23ToBessel2[uppar,Sort[{v1,v2}],arg]
  1004.  
  1005.  F23[ __ ] := HyperFail
  1006.  
  1007. (************************* Formula 6 - 7 , p. 609, PBM **********************)
  1008.  
  1009.  F23ToBessel1[ {a_,a1_},{b_,b1_},arg_/;Not[Znak[arg]] ] :=
  1010.    Cosh[Sqrt[arg]] BesselI[b1-1,Sqrt[arg]] Gamma[b1] arg^(1/2-b1/2)/;
  1011.  Expand[a1-a-1/2]===0 && Expand[b1-b-1/2]===0 && Expand[2 a-b]===0
  1012.  
  1013.  F23ToBessel1[ {a_,a1_},{b_,b1_},arg_/;Znak[arg] ] :=
  1014.    Cos[Sqrt[-arg]] BesselJ[b1-1,Sqrt[-arg]] Gamma[b1] (-arg)^(1/2-b1/2)/;
  1015.  Expand[a1-a-1/2]===0 && Expand[b1-b-1/2]===0 && Expand[2 a-b]===0
  1016.  
  1017.  F23ToBessel1[ __ ] := HyperFail
  1018.  
  1019. (************************* Formula 8 - 9 , p. 609, PBM **********************)
  1020.  
  1021.  F23ToBessel2[ {1,1},{2,2},arg_/;Znak[arg] ] :=
  1022.    -EulerGamma/arg - Log[2 Sqrt[-arg]]/arg + CosIntegral[2 Sqrt[-arg]]/arg
  1023.  
  1024.  F23ToBessel2[ {a_,a1_},{b_,b1_},arg_/;Not[Znak[arg]] ] :=
  1025.    Sinh[Sqrt[arg]] BesselI[b-1,Sqrt[arg]] Gamma[b]/arg^(b/2)/;
  1026.  Expand[a1-a-1/2]===0 && Expand[b1-b-1/2]===0 && Expand[2 a-b1]===0
  1027.  
  1028.  F23ToBessel2[ {a_,a1_},{b_,b1_},arg_/;Znak[arg] ] :=
  1029.    Sin[Sqrt[-arg]] BesselJ[b-1,Sqrt[-arg]] Gamma[b]/(-arg)^(b/2)/;
  1030.  Expand[a1-a-1/2]===0 && Expand[b1-b-1/2]===0 && Expand[2 a-b1]===0
  1031.  
  1032.  F23ToBessel2[ __ ] := HyperFail
  1033.  
  1034. (*========================================================================*)
  1035.  
  1036.  GeneralHypergeometricPFQ[ uppar_,lowpar_,arg_ ] := 
  1037.      HypergeometricPFQ[ Sort[uppar],Sort[lowpar],arg ]
  1038.  
  1039.  KeiperFlag = True
  1040.  
  1041.  Hypergeometric2F1[ a_,b_,c_,arg_ ] :=
  1042.    Module[{r},
  1043.      KeiperFlag = False;
  1044.      r = Hypergeometric2F1[a,b,c,arg];
  1045.      KeiperFlag = True;
  1046.      r /; Head[r]=!=Hypergeometric2F1 
  1047.    ] /; KeiperFlag
  1048.  
  1049.  Hypergeometric2F1[ a_,b_,c_,arg_ ] :=
  1050.    Block[ { r, answer, Hypergeometric2F1 },
  1051.         answer = HypergeometricPFQ[{a,b},{c},arg];
  1052.         If[ Length[r=Expand[answer]]<10,
  1053.             Simplify[r],
  1054.             answer ] /; Head[answer]=!=Hypergeometric2F1
  1055.    ] /; Accuracy[{a,b,c,arg}] === Infinity && GaussFlag &&
  1056.  KeiperFlag
  1057.  
  1058.  Hypergeometric1F1[ a_,b_,arg_ ] :=
  1059.    Block[ { answer,Hypergeometric1F1 },
  1060.             answer = HypergeometricPFQ[{a},{b},arg];
  1061.      answer/;Head[answer]=!=Hypergeometric1F1
  1062.    ] /; Accuracy[{a,b,arg}] === Infinity && KummerFlag[]
  1063.  
  1064. (***************************************************************************
  1065. *                     HypergeometricPFQRegularized
  1066. *
  1067. ****************************************************************************)
  1068. HypergeometricPFQRegularized[{ }, { }, z_] := Exp[z];
  1069. HypergeometricPFQRegularized[{a_}, { }, z_] := (1 - z)^(-a);
  1070. HypergeometricPFQRegularized[{ }, {c_}, z_] :=
  1071.         Hypergeometric0F1Regularized[c, z];
  1072. HypergeometricPFQRegularized[{a_}, {c_}, z_] :=
  1073.         Hypergeometric1F1Regularized[a, c, z];
  1074. HypergeometricPFQRegularized[{a_, b_}, {c_}, z_] :=
  1075.         Hypergeometric2F1Regularized[a, b, c, z];
  1076.  
  1077. (* Sorting *)
  1078. HypergeometricPFQRegularized[a_List, b_List, z_] :=
  1079.         HypergeometricPFQRegularized[Sort[a], Sort[b], z] /;
  1080.                 (!OrderedQ[a] || !OrderedQ[b])
  1081.  
  1082. (* Cancelation *)
  1083. HypergeometricPFQRegularized[{a0___, a1_, a2___}, 
  1084.                              {b0___, b1_, b2___}, z_] :=
  1085.     HypergeometricPFQRegularized[{a0, a2}, {b0, b2}, z]/Gamma[b1] /; 
  1086. a1 == b1
  1087.  
  1088. (* Negative Integers in the Denominator *)
  1089. HypergeometricPFQRegularized[a_List, {b0___, c_, b2___}, z_] :=
  1090.     Module[{b = {b0, b2}, c1 = 1-c},
  1091.         Apply[Times, Map[Pochhammer[#, c1]&, a]] z^c1 *
  1092.         HypergeometricPFQRegularized[a+c1, Append[b, 1]+c1, z] /
  1093.         Apply[Times, Map[Pochhammer[#, c1]&, b]]
  1094.     ] /; (c == Round[c] && Round[c] <= 0)
  1095.  
  1096. (* Approximate Numerical Evaluation *)
  1097. HypergeometricPFQRegularized[a_List, b_List, z_] :=
  1098.     Module[{pfq = HypergeometricPFQ[a, b, z]},
  1099.         pfq/N[Apply[Times, Map[Gamma, b]], Precision[pfq]] /; NumberQ[pfq]]
  1100.  
  1101. (* Derivatives wrt z *)
  1102. Derivative[0, 0, n_Integer][HypergeometricPFQRegularized] ^:=
  1103.     (Apply[Times, Map[Pochhammer[#, n]&, #1]] *
  1104.         HypergeometricPFQRegularized[#1 + n, #2 + n, #3] /
  1105.         Apply[Times, Map[Pochhammer[#, n]&, #2]])& /; n > 0
  1106.  
  1107. (*========================================================================*)
  1108.  
  1109.  Znak[n_ a_] := True/;NumberQ[n] && Im[n]===0 && n<0
  1110.  
  1111.  Znak[Complex[0,n_] a_.] := True/;n<0
  1112.  
  1113.  Znak[n_] := True/;NumberQ[n] && Im[n]===0 &&n<0
  1114.  
  1115.  Znak[a_] := False
  1116.  
  1117.  ZnakSum[n_ a_] := True/;NumberQ[n] && Im[n]===0 && n<0
  1118.  
  1119.  ZnakSum[Complex[0,n_] a_.] := True/;n<0
  1120.  
  1121.  ZnakSum[n_] := True/;NumberQ[n] && Im[n]===0 &&n<0
  1122.  
  1123.  ZnakSum[n_ + c_] := True/;ZnakSum[n] && ZnakSum[c]
  1124.  
  1125.  ZnakSum[n_ + c_] := True/;NumberQ[n] && Znak[c]
  1126.  
  1127.  ZnakSum[a_] := False
  1128.  
  1129.  LogTrig = {
  1130.   Cos[ArcSin[w_]]^m_. :> (1-w^2)^(m/2),
  1131.   Cos[ArcTan[w_]]^m_. :> 1/(1+w^2)^(m/2),
  1132.   Sec[ArcCos[w_]]^m_. :> w^(-m),
  1133.   Sec[ArcSin[w_]]^m_. :> (1-w^2)^(-m/2),
  1134.   Sec[ArcTan[w_]]^m_. :> (1+w^2)^(m/2),
  1135.   Sin[ArcCos[w_]]^m_. :> (1-w^2)^(m/2),
  1136.   Sin[ArcTan[w_]]^m_. :> w^m/(1+w^2)^(m/2),
  1137.   Csc[ArcSin[w_]]^m_. :> w^(-m),
  1138.   Csc[ArcCos[w_]]^m_. :> (1-w^2)^(-m/2),
  1139.   Csc[ArcTan[w_]]^m_. :> (1+w^2)^(m/2)/w^m,
  1140.   Tan[ArcSin[w_]]^m_. :> w^m/(1-w^2)^(m/2),
  1141.   Tan[ArcCos[w_]]^m_. :> (1-w^2)^(m/2)/w^m,
  1142.   Cot[ArcCos[w_]]^m_. :> w^m/(1-w^2)^(m/2),
  1143.   Cot[ArcSin[w_]]^m_. :> (1-w^2)^(m/2)/w^m,
  1144.   ArcTan[Tan[w_]]^m_. :> w^m
  1145.         }
  1146.  
  1147.  MultPochham[a_,k_] := Times@@(Pochhammer[ #,k]&/@a)
  1148.  
  1149.  SimpPolyGammaH[ expr_Plus ] := 
  1150.     Module[ {inter},
  1151.       inter = Plus@@Cases[expr,a_/;FreeQ[a,PolyGamma]];
  1152.       If[ Length[inter] < 7,
  1153.           Factor[inter],
  1154.           inter ]
  1155.       + SimpPolyGammaH1[ expr - inter ]
  1156.     ]
  1157.  
  1158.  SimpPolyGammaH1[ expr_Plus ] :=
  1159.     Module[ {listP,argP,exprN},
  1160.       listP = Union[ List@@(#&/@expr) /.
  1161.               { a_. PolyGamma[n_,w_] :> {n,w} }];
  1162.       argP  = FindArgPolyGamma[ listP ]; 
  1163.       If[ Length[argP] != 0,
  1164.           SimpPolyGammaH[ Expand[expr//.
  1165.              BuildRule[(PolyGamma@@#)&/@argP,
  1166.                        ((PolyGamma@@{#[[1]],#[[2]]-1})&/@argP) + 
  1167.                        ((Together[#[[2]]-1]^(-1-#[[1]]) (#[[1]])!*
  1168.                         (-1)^(#[[1]]) )&/@argP)]]],
  1169.           exprN = 
  1170.              CollectPolyGamma[ expr,listP ]/.
  1171.              {a_ PolyGamma[w__] :> Factor[a] PolyGamma[w]};
  1172.           If[ Length[exprN] < 6 && 
  1173.               Length[FindArg2PolyGamma[ listP ]] != 0,
  1174.               exprN//.SimpPolyGammaSum,
  1175.               exprN ]
  1176.         ]
  1177.     ]
  1178.  
  1179.  SimpPolyGammaH1[ expr_ ] := expr 
  1180.  
  1181.  SimpPolyGammaH[ expr_ ] := expr 
  1182.  
  1183.  BuildRule[{l_,lR___},{r_,rR___}] :=
  1184.    Join[{l :> r},BuildRule[{lR},{rR}]]
  1185.  
  1186.  BuildRule[{},{}] := {}
  1187.         
  1188.  FindArgPolyGamma[ {v1___,{nw_,w_},v2___,{nv_,v_},v3___} ] :=
  1189.    Join[{{nv,v}},FindArgPolyGamma[ {v1,v2,v3} ]] /; 
  1190.  IntegerQ[v-w] && Positive[v-w] && nw==nv
  1191.  
  1192.  FindArgPolyGamma[ {___} ] := {}
  1193.  
  1194.  FindArg2PolyGamma[ {v1___,{nw_,w_},v2___,{nv_,v_},v3___} ] :=
  1195.    Join[{{nv,v}},FindArg2PolyGamma[ {v1,v2,v3} ]] /; 
  1196.  nw==nv && (v+w===0 || v+w===1)  
  1197.  
  1198.  FindArg2PolyGamma[ {___} ] := {}
  1199.  
  1200.  CollectPolyGamma[ expr_,{ {n_,arg_},w___ } ] :=
  1201.    CollectPolyGamma[ Collect[expr,PolyGamma@@{n,arg} ], {w} ]
  1202.  
  1203.  CollectPolyGamma[ expr_,{} ] := expr
  1204.  
  1205.  SimpGammaH[f_Plus] := Map[ SimpGammaH[#]&,f ]
  1206.  
  1207.  SimpGammaH[ expr_/;Length[expr]>1 ] :=
  1208.      (expr/.{Gamma[_]:>1}) *
  1209.      SimpGamma1[ Times@@Cases[expr,Gamma[a_]^n_.]] 
  1210.  
  1211.  SimpGamma1[ Times[v1___,Gamma[w1_]^n_.,v2___,Gamma[w2_]^m_.] ] := 
  1212.      If[ (w2-w1)>0,
  1213.            SimpGamma1[v1 v2 ]/Factor[Pochhammer[w1,w2-w1]^n],
  1214.            SimpGamma1[v1 v2 ] Factor[Pochhammer[w2,w1-w2]^n] 
  1215.        ] /; IntegerQ[w2-w1] && IntegerQ[n] && n>0 && n+m == 0
  1216.  
  1217.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,Gamma[v_]^m_.]] := 
  1218.      If[ SameQ[Expand[v-u],1/2],(2^Expand[1-2 u] Pi^(1/2))^Sign[m] *
  1219.          SimpGamma1[ Gamma[u]^(n-Sign[m])*
  1220.                      Gamma[v]^(m-Sign[m]) v1 v2 *
  1221.                      Gamma[Expand[2 u]]^Sign[m] ],
  1222.          (2^Expand[1-2 v] Pi^(1/2))^Sign[n] *
  1223.          SimpGamma1[ Gamma[u]^(n-Sign[n])*
  1224.                      Gamma[v]^(m-Sign[n]) v1 v2 *
  1225.                      Gamma[Expand[2 v]]^Sign[n] ]
  1226.       ]/;
  1227.   Abs[Expand[u-v]]===1/2 
  1228.  
  1229.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,Gamma[v_]^m_.]] := 
  1230.      SimpGamma1[ v1 v2 Gamma[u]^(n-Sign[n]) Gamma[v]^(m-Sign[m]) ] *
  1231.      (Pi/Sin[Expand[Pi u]])^Sign[n] /;
  1232.    Expand[u+v]===1 && m n > 0
  1233.  
  1234.  SimpGamma1[Times[v1___,Gamma[1+u_]^n_.,v2___,Gamma[1+v_]^m_.]] := 
  1235.     u^Sign[n] (Pi/Sin[Expand[Pi u]])^Sign[n]*
  1236.     SimpGamma1[ v1 v2 Gamma[1+u]^(n-Sign[n]) Gamma[1+v]^(m-Sign[m]) ] /;
  1237.    Expand[u+v]===0 && m n > 0
  1238.  
  1239.  SimpGamma1[v__] := v
  1240.  
  1241.  SimpGammaH[v__] := v
  1242.  
  1243.  SimpPolyGammaSum = {
  1244.   a_. PolyGamma[k_,z_] + b_ PolyGamma[k_,x_] +c_.:>
  1245.     c + a Pi Module[{var},D[Cot[Pi var],{var,k}]/.var->x]/;EvenQ[k] && 
  1246.     Znak[b] && Expand[a+b]===0 && Expand[z+x-1]===0,
  1247.   a_. PolyGamma[k_,z_] + b_ PolyGamma[k_,x_] +c_.:>
  1248.     c - a Pi Module[{var},D[Cot[Pi var],{var,k}]/.var->x]/;
  1249.     OddQ[k] && Expand[a-b]===0 && Expand[z+x-1]===0,
  1250.   a_. PolyGamma[k_,z_] + b_ PolyGamma[k_,x_] +c_.:>
  1251.     c + a k! x^(-k-1) + a Pi Module[{var},
  1252.     D[Cot[Pi var],{var,k}]/.var->x]/;
  1253.     EvenQ[k] && Znak[b] && Expand[a+b]===0 && Expand[z+x]===0,
  1254.   a_. PolyGamma[k_,z_] + b_ PolyGamma[k_,x_] +c_.:>
  1255.     c + a k! x^(-k-1) - a Pi Module[{var},
  1256.     D[Cot[Pi var],{var,k}]/.var->x]/;
  1257.     OddQ[k] && Expand[a-b]===0 && Expand[z+x]===0,
  1258.   Cot[a_] :> Cot[Expand[a]],
  1259.   Csc[a_] :> Csc[Expand[a]]
  1260.       }
  1261.  
  1262.  SimpTrigSum = {
  1263.   a_. Tan[x_] + b_. Cot[x_] +c_.:> c + 2 a Csc[2 x]/;a===b,
  1264.   a_. Tanh[x_] + n_?Negative b_. Coth[x_] +c_.:> c-2 a Csch[2 x]/;
  1265.       a+b n===0&&Not[Znak[a]],
  1266.   n_?Negative a_. Tanh[x_] + b_. Coth[x_] +c_.:> c+2 b Csch[2 x]/;
  1267.       a n+b===0&&Not[Znak[b]]
  1268.   }
  1269.  
  1270.  PolyGammaRule = {
  1271.   PolyGamma[v_]     :> PolyGamma[0,v],
  1272.   PolyGamma[k_Integer,n_Integer + v_] :> 
  1273.     PolyGamma[k,n+v-1] + (-1)^k k!/(n+v-1)^(k+1)/;n>0,
  1274.   PolyGamma[k_Integer,n_] :> PolyGamma[k,n-1] +(-1)^k k! (n-1)^(-k-1)/;
  1275.     NumberQ[n] && Re[n]>1,
  1276.   PolyGamma[n_,v_]  :> PolyGamma[n,Expand[v]]
  1277.                  }
  1278. (*========================================================================*)
  1279.  
  1280.  Unprotect[ PolyLog ]
  1281.  
  1282.  PolyLog[2,1/2] := Pi^2/12 - Log[2]^2/2
  1283.  
  1284.  PolyLog[2,I] := -Pi^2/48 + I Catalan
  1285.  
  1286.  PolyLog[2,-I] := -Pi^2/48 - I Catalan
  1287.  
  1288. (*========================================================================*)
  1289.  
  1290.  Unprotect[ Zeta ]
  1291.  
  1292.  Zeta[z_,1/2] := (2^z-1) Zeta[z]
  1293.  
  1294.  Zeta[2,1/4] := Pi^2 + 8 Catalan
  1295.  
  1296.  Zeta[2,3/4] := Pi^2 - 8 Catalan
  1297.  
  1298.  Zeta[n_Integer,v_Rational] := Zeta[n,v-1] - (v-1)^(-n)/;v>1
  1299.  
  1300. (*========================================================================*)
  1301.  
  1302.  Unprotect[ PolyGamma ]
  1303.  
  1304.  PolyGamma[1,1/4] := Pi^2 + 8 Catalan
  1305.  
  1306.  PolyGamma[1,3/4] := Pi^2 - 8 Catalan
  1307.  
  1308.  PolyGamma[0,n_Rational] := -EulerGamma - Log[2 Denominator[n]] -
  1309.     Pi Cos[Pi n]/(2 Sin[Pi n]) + 2 Sum[Cos[2 n i Pi] *
  1310.             Log[Sin[Pi i/Denominator[n]]],
  1311.             {i,1,Floor[(Denominator[n]-1)/2]}] /; 
  1312.  n>0 && n<1
  1313.  
  1314. (*========================================================================*)
  1315.  
  1316. (* Protect[ Hypergeometric2F1, Hypergeometric1F1, Zeta, PolyLog, PolyGamma ] *)
  1317.  
  1318.  End[ ] (* "HypergeometricPFQ`Private` *)
  1319.  
  1320.  SetAttributes[HypergeometricPFQ, { ReadProtected, Protected } ];
  1321.  SetAttributes[HypergeometricPFQRegularized, ReadProtected];
  1322.  
  1323.  End[ ] (* "System`" *)
  1324.  
  1325.