home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e031 / 3.ddi / MATHZIP2 / STARTUP / INTEGRAT / LOGCASES.M < prev    next >
Encoding:
Text File  |  1991-09-19  |  4.3 KB  |  128 lines
  1.  
  2. (****************************************************************************
  3. *               Evaluation Multiple Poles Meijer's G-function
  4. *
  5. *****************************************************************************)
  6.  
  7.  MeijerLogCase[parn_,parp_,parm_,parq_,arg_ ] :=
  8.   Module[ {answer={},grpoles,grzero}, 
  9.      grpoles = FindGroupsPoles[ parm ];
  10.      For[ i=1,i<=Length[grpoles],i++,
  11.           grzero = OneGroupZero[ grpoles[[i,1]],parp,{} ][[3]];
  12.           If[ Length[grzero] != 0,
  13.               answer = Append[answer,OrderPoles[
  14.                               Join[ Map[ {#,1}&, grpoles[[i]] ],
  15.                                     Map[ {#,-1}&,grzero       ]]]],
  16.               answer = Append[answer,OrderPoles[
  17.                                     Map[ {#,1}&, grpoles[[i]] ]]]
  18.             ]
  19.         ];
  20.   answer = 
  21.   Apply[ Plus,Map[ 
  22.       EvalResidues[#,parn,parp,parm,parq,arg]&,CountMultiple[answer] ] ];
  23.   answer//.PolyGammaRule
  24.     ]       
  25.  
  26.  
  27.  FindGroupsPoles[v_] := OneGroup[ v[[1]], Rest[v], {v[[1]]} ]
  28.  
  29.  FindGroupsPoles[v_] := {} /; Length[v] == 0
  30.  
  31.  OneGroup[ a_,{v1___,b_,v2___},c_ ] :=
  32.      OneGroup[ a, {v1,v2}, Append[c,b] ] /; IntegerQ[Expand[a-b]]
  33.  
  34.  OneGroup[ a_,b_,c_ ] := Append[ FindGroupsPoles[b],c ] 
  35.  
  36.  OneGroupZero[ a_,{v1___,b_,v2___},c_ ] :=
  37.      OneGroupZero[ a, {v1,v2}, Append[c,b] ] /; IntegerQ[Expand[a-b]]
  38.    
  39.    
  40.  OrderPoles[{c1___,a_,c2___,b_,c3___}] :=
  41.                OrderPoles[{c1,b,c2,a,c3}] /; Expand[a[[1]]-b[[1]]] > 0
  42.  
  43.  OrderPoles[{c___}] := {c}
  44.  
  45.  CountMultiple[ v_ ] := Flatten[ Map[CountInGroup[#]&,v],1 ]
  46.  
  47.  
  48.  CountInGroup[v_] :=
  49.   Module[ {u=v,kr=0,answer={}},
  50.        While[ Length[u] !=0,
  51.           If[ u[[1,2]] == 1, kr += 1, kr -= 1 ];
  52.           If[ kr > 0,
  53.            If[Length[Rest[u]] != 0,
  54.             If[Not[SameQ[ u[[1,1]],u[[2,1]] ]],
  55.                PrependTo[answer,
  56.                          {kr,Expand[u[[2,1]]-u[[1,1]]],-u[[1,1]]}
  57.                         ] ],
  58.             If[kr > 1, Return[FailInt],PrependTo[ answer,
  59.                                      {kr,"Infinity",u[[1,1]]} ]]
  60.            ]];
  61.        u = Rest[u] ];
  62.        answer
  63.           ]
  64.  
  65.  
  66.  EvalResidues[{order_,quantity_,at_},parn_,parp_,parm_,parq_,arg_] := 
  67.    If[MemberQ[parm,at],
  68.       FinalGfunToHyper[
  69.            at,parn,parp,First[ReducePar[parm,{at}]],parq,arg],
  70.       SpecialTransf[at,
  71.            parn,Append[parp,at],Append[parm,at],parq,arg]
  72.      ]   /;
  73.  order == 1 && quantity==="Infinity"
  74.  
  75.  SpecialTransf[at_,parn_,{v1___,b_,v2___},{v3___,a_,v4___},parq_,arg_] :=
  76.    (-1)^(b-a) SpecialTransf[at, Append[parn,a+1],{v1,v2},{v3,v4},
  77.                              Append[parq,2 a -b + 1],arg ] /;
  78.   IntegerQ[Expand[b-a]] && Expand[b-a] > 0
  79.  
  80.      
  81.  SpecialTransf[at_,parn_,parp_,parm_,parq_,arg_] :=
  82.    Module[ {r},
  83.      r = ReducePar[parn,parq];
  84.      FinalGfunToHyper[
  85.        at,r[[1]],parp,First[ReducePar[parm,{at}]],r[[2]],arg]
  86.        ]
  87.  
  88.  EvalResidues[{order_,quantity_,at_},parn_,parp_,parm_,parq_,arg_] := 
  89.   Module[ {rr,eps},
  90.    rr =
  91.     Normal[ Series[
  92.      Normal[ Apply[Series,{ Apply[ Times,
  93.            Map[GammaRes[#,-eps,order]&,1-parn-at] ],
  94.            {eps,0,order-1} }] ] *
  95.      Normal[ Apply[Series,{ Apply[ Times,
  96.            Map[GammaRes[#, eps,order]&, parm+at ] ],
  97.            {eps,0,order-1} }] ] *
  98.      Normal[ Apply[Series,{ Apply[ Times,
  99.            Map[GammaResInv[#, eps,order]&, parp+at ] ],
  100.            {eps,0,order-1} }] ] *
  101.      Normal[ Apply[Series,{ Apply[ Times,
  102.            Map[GammaResInv[#,-eps,order]&,1-parq-at] ],
  103.            {eps,0,order-1} }] ] *
  104.      Normal[ Series[Exp[-eps Log[arg]],{eps,0,order-1}]] arg^(-at),
  105.    {eps,0,order-1}]];
  106.   Expand[ Coefficient[ rr,eps,Exponent[rr,eps] ]]
  107.   ]/;quantity =!= "Infinity"
  108.  
  109.  
  110.  GammaRes[u_,e_,1] := 
  111.     (-1)^(-u) /Gamma[1-u]  /;IntegerQ[u] && u <= 0
  112.  
  113.  GammaRes[u_,e_,2] := 
  114.     (-1)^(-u) (1 + PolyGamma[1-u] e)/Gamma[1-u]  /;IntegerQ[u] && u <= 0
  115.  
  116.  GammaRes[0,e_,n_] := GammaRes[1,e,n]
  117.  
  118.  GammaRes[u_,e_,n_] := 
  119.     (-1)^(-u) GammaRes[1,e,n] GammaRes[1,-e,n] GammaResInv[1-u,-e,n] /;
  120.   IntegerQ[u] && u < 0
  121.  
  122.  GammaRes[u_,e_,n_] := Normal[ Series[Gamma[u+e],
  123.                              {If[Head[e] === Symbol,e,-e],0,n-1}]  ]
  124.  
  125.  GammaResInv[u_,e_,n_] := Normal[ Series[1/Gamma[u+e],
  126.                              {If[Head[e] === Symbol,e,-e],0,n-1}]  ]
  127.  
  128.