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