home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e031 / 3.ddi / MATHZIP2 / STARTUP / INTEGRAT / MAINALGO.M < prev    next >
Encoding:
Text File  |  1991-09-19  |  56.4 KB  |  1,535 lines
  1.  
  2. (****************************************************************************
  3. *
  4. *                       Adamchik's Package
  5. *                    for Evaluation Integrals
  6. *
  7. *               ( November 1990 -  March 1991 )
  8. *****************************************************************************) 
  9.  
  10. (* ======================================================================== *)
  11.  
  12.  Unprotect[ Integrate ] 
  13.  
  14.  Integrate[ f_,{x_,xmin_,xmax_}] :=  
  15.   Module[ {answer},
  16.     answer = IntegrateG[
  17.         If[ !FreeQ[f,Hypergeometric0F1],
  18.             f/.Hypergeometric0F1[v_,z_] :> HypergeometricPFQ[{},{v},z],
  19.             f ],{x,xmin,xmax}];
  20.     answer /; FreeQ[answer,IntegrateG]
  21.   ] /; FreeQ[{f,x},Blank] && FreeQ[f,Integrate] && 
  22.        FreeQLaplace[f] && 
  23.        CondForIntegrate[f,{x,xmin,xmax}]
  24.  
  25.  CondForIntegrate[ f_,{x_,xmin_,xmax_}] :=  True /;
  26.  !FreeQ[{xmin,xmax},DirectedInfinity]
  27.  
  28.  CondForIntegrate[ f_,{x_,xmin_,xmax_}] :=  
  29.   Module[ 
  30.    {answer =
  31.      Module[ {test},
  32.        Off[Power::infy,Power::indet,Infinity::indet,General::indet,
  33.            General::dbyz];
  34.        test = {f/.x->xmin, f/.x->xmax};    
  35.        On[Power::infy,Power::indet,Infinity::indet,General::indet,
  36.            General::dbyz]; 
  37.        test
  38.      ]},
  39.    True /; Or@@(
  40.     Not[FreeQ[answer,#]]&/@{DirectedInfinity,ComplexInfinity,Indeterminate})
  41.   ]
  42.  
  43.  CondForIntegrate[ __ ] := False
  44.  
  45.  Protect[ Integrate ]
  46.  
  47.  SetAttributes[ Integrate,ReadProtected ]
  48.  
  49. (* ======================================================================== *)
  50.  
  51.  
  52.  IntegrateG[f_,{x_,xmin_,xmax_}] :=  
  53.   Module[ {r,inter,z},
  54.     Clear[positive];
  55.     r = If[ Convergent[f,{x,xmin,xmax}],
  56.             inter = Dispatcher[1,f//.{
  57.                    Power[a_ b_,n_] :> a^n b^n,
  58.                    (x^a_)^b_ :> x^(a b),
  59.                    E^(Complex[c_,a_] b_.) :> 
  60.                     E^(c b) Cos[a b] + I E^(c b) Sin[a b]
  61.                    },x,xmin,xmax];
  62.             If[ !FreeQ[inter,FailInt],
  63.               If[ PolynomialQ[Numerator[f],x] &&
  64.                   PolynomialQ[Denominator[f],x],
  65.                 inter = Dispatcher[1,Apart[f//.
  66.                    {
  67.                    Power[a_ b_,n_] :> a^n b^n,
  68.                    (x^a_)^b_ :> x^(a b),
  69.                    E^(Complex[c_,a_] b_.) :> 
  70.                      E^(c b) Cos[a b] + I E^(c b) Sin[a b]
  71.                    },x],x,xmin,xmax],
  72.                 inter = FailInt
  73.                 ];
  74.                 If[ !FreeQ[inter,FailInt] && xmin=!=0 &&
  75.                     FreeQ[xmin,DirectedInfinity],
  76.                     Dispatcher[1,f/.x->z+xmin,z,0,
  77.                        If[ !FreeQ[xmax,DirectedInfinity],
  78.                            xmax,xmax-xmin] ],
  79.                     inter
  80.                   ],
  81.                 inter
  82.               ] ,
  83.             If[ Head[f]===Sin || Head[f]===Cos,
  84.                 Indeterminate,
  85.                 Infinity ]
  86.           ] /. SimpGfunction;
  87.     If[ Not[FreeQ[r,FailInt]] || Not[FreeQ[r,FailIntDiv]], 
  88.         Clear[positive] ];
  89.     If[ Not[FreeQ[r,DirectedInfinity]] || Not[FreeQ[r,FailIntDiv]] ,
  90.         Infinity, 
  91.         TransfAnswer[r]
  92.       ]/; FreeQ[r,FailInt] && FreeQ[r,MeijerG] && FreeQ[r,KellyIntegrate]
  93.   ] /; FreeQLaplace[f] &&
  94.  And@@(FreeQ[f,#]&/@{Blank,Integrate,IntegrateG}) && FreeQ[x,Blank] 
  95.  
  96. (* ======================================================================== *)
  97.  
  98.  Dispatcher[done_,c_,x_,xmin_,xmax_] := FailInt/;
  99.  Not[FreeQ[{done,c},FailInt]]
  100.  
  101.  Dispatcher[done_,0,x_,xmin_,xmax_] := 0
  102.  
  103.  Dispatcher[1,c_,x_,xmin_,xmax_] := c (xmax-xmin)/;FreeQ[c,x]
  104.  
  105.  Dispatcher[done_,c_,x_,xmin_,xmax_] := 
  106.    c Dispatcher[done,1,x,xmin,xmax]/;FreeQ[c,x] && c=!=1
  107.  
  108.  Dispatcher[done_,c_ f_,x_,xmin_,xmax_] := 
  109.     c Dispatcher[done,f,x,xmin,xmax]/;FreeQ[c,x]
  110.  
  111.  Dispatcher[done_,f_,x_,xmin_,xmax_] := FailInt/;!FreeQ[done,FailInt]
  112.  
  113.  Dispatcher[done_,f_,x_,-Infinity,Infinity] := 
  114.   Module[ {z,answer},
  115.    If[ Expand[f//.x->-z] === Expand[f//.x->z],
  116.        2 Dispatcher[done,f,x,0,Infinity],
  117.        answer = 
  118.          Dispatcher[done,ExpandDenominator[Together[
  119.                    (f/.x->z) + (f/.x->-z) ]],z,0,Infinity];
  120.        If[ FreeQ[answer,FailInt],
  121.            answer,
  122.            Expand[Dispatcher[done,f,x,0,Infinity] +
  123.                   Dispatcher[done,(f/.x->-z)/.z->x,x,0,Infinity]]
  124.          ]
  125.      ]
  126.   ]
  127.  
  128.  Dispatcher[done_,f_,x_,-Infinity,xmax_] := 
  129.   Module[ {z},
  130.     Dispatcher[done//.x->-z,f//.x->-z,z,-xmax,Infinity]
  131.   ] /; xmax=!=Infinity
  132.  
  133.  Dispatcher[done_,f_,x_,0,xmax_] := 
  134.     Dispatcher[done,Together[f/.HBfun],x,0,xmax]/;
  135.   Not[FreeQ[f,Csch]] || Not[FreeQ[f,Sech]]
  136.  
  137.  Dispatcher[done_,f_,x_,0,xmax_] := 
  138.     Dispatcher[done,Factor[Expand[f/.HBfun]],x,0,xmax] /;
  139.  Not[FreeQ[f,Sinh]] || Not[FreeQ[f,Cosh]]
  140.     
  141.  Dispatcher[done_,f_,x_,0,xmax_] :=
  142.     AnalysExp1[done,f,x,0,xmax]/;Not[FreeQ[f,E]] && xmax=!=Infinity
  143.     
  144.  Dispatcher[done_,f_,x_,xmin_,xmax_] :=
  145.     Module[ {inter},
  146.       inter = f/.ExpandIntoTrig/.TrRuleE/.{
  147.                Sin[z_. Complex[a_,b_]] :>
  148.                  Sin[z a] Cos[z b I] + Cos[z a] Sin[z b I]};
  149.       Dispatcher[done,Expand[inter], x,min,max] /; inter =!= f
  150.     ] /;
  151.  (!FreeQ[f,Sin] || !FreeQ[f,Cos]) && !FreeQ[f,Complex]
  152.  
  153.  Dispatcher[1,f1_[w1_]^n_. f2_[w2_]^m_.,x_,0,xmax_] :=
  154.     AnalysTrig[1,f1[w1]^n,f2[w2]^m,x,xmax]/;
  155.   xmax=!=Infinity && Complement[{f1,f2},{Sin,Cos,Sec,Csc,Tan,Cot}]==={}
  156.  
  157.  Dispatcher[1,x_ f_[w_]^n_.,x_,0,xmax_] :=
  158.     AnalysTrig1[1,f[w]^n,x,x,xmax]/;
  159.   xmax=!=Infinity && Complement[{f},{Sin,Cos,Sec,Csc,Tan,Cot}]==={}
  160.  
  161.  Dispatcher[1,f_[w_]^n_.,x_,0,xmax_] :=
  162.     AnalysTrig1[1,f[w]^n,1,x,xmax]/;
  163.   xmax=!=Infinity && Complement[{f},{Sin,Cos,Sec,Csc,Tan,Cot}]==={}
  164.     
  165.  Dispatcher[done_,f_,x_,xmin_,xmax_] :=
  166.     AnalysLog[done,f,x,xmin,xmax]/;Not[FreeQ[f,Log]]
  167.  
  168.  Dispatcher[1,(b_ + a_ x_^dg_.)^n_Integer?Positive f_.,x_,0,xmax_] :=
  169.      KellyIntegrate[f (b+a x^dg)^n,{x,0,xmax}] /; xmax=!=Infinity
  170.  
  171.  Dispatcher[done_,(b_ + a_ x_^dg_.)^n_ f_.,x_,0,xmax_] :=
  172.     AnalysAlg[done,b,1,a x^dg,n,f,x,{0,xmax}] /;xmax=!=Infinity&&
  173.   FreeQ[b,x] && FreeQ[a,x] && Znak[a] && Expand[b+a xmax^dg]=!=0
  174.  
  175.  Dispatcher[done_,(f1_ + f2_)^n_ f_.,x_,xmin_,xmax_] :=
  176.     AnalysAlg[done,f1,1,f2,n,f,x,{xmin,xmax}] /;
  177.   FreeQ[f1,x] && Not[FreeQ[f2,x]] 
  178.  
  179.  Dispatcher[done_,(f1_ + f2_)^n_ f_.,x_,xmin_,xmax_] :=
  180.     AnalysAlg[done,1,1,Simplify[f2/f1],n,f f1^n,x,{xmin,xmax}] /;
  181.   Not[FreeQ[f1,x]] && Not[FreeQ[f2,x]] 
  182.  
  183.  Dispatcher[1,f_,x_,xmin_,xmax_] := 
  184.     Module[ {z},
  185.      positiveList[xmin]; positiveList[xmax];
  186.      Dispatcher[1,MeijerG[{},{1},{0},{},{1,z/xmax}] (f/.x->z) -
  187.                   If[NumberQ[xmin] && Im[xmin]==0 && xmin<0,
  188.                      -MeijerG[{},{1},{0},{},{1,-z/xmin}] (f/.x->-z),
  189.                      MeijerG[{},{1},{0},{},{1,z/xmin}] (f/.x->z)],
  190.                z,0,Infinity] 
  191.    ] /;
  192.  xmin=!=0 && xmin=!=-Infinity && xmax=!=0 && xmax=!=Infinity
  193.  
  194.  Dispatcher[1,f_Plus,x_,xmin_,xmax_] := 
  195.     Block[ {IntFF},
  196.       inter = Dispatcher[1,#,x,xmin,xmax]&/@f;
  197.       IntFF[1,inter/.IntFF[a_,b_,c_] :> a b,x]
  198.     ]
  199.  
  200.  Dispatcher[1,f_,x_,xmin_,Infinity] := 
  201.     (positiveList[xmin];
  202.      Dispatcher[MeijerG[{1},{},{},{0},{1,x/xmin}],f,x,0,Infinity])/;
  203.    xmin=!=0 && xmin=!=-Infinity
  204.  
  205.  Dispatcher[done_,f_,x_,xmin_,Infinity] := 
  206.     Dispatcher[done,f,x,0,Infinity]/;
  207.    xmin=!=0 && xmin=!=-Infinity
  208.  
  209.  Dispatcher[1,f_,x_,0,xmax_] :=
  210.     (positiveList[xmax];
  211.      Dispatcher[MeijerG[{},{1},{0},{},{1,x/xmax}],f,x,0,Infinity])/;
  212.   xmax=!=Infinity
  213.  
  214.  Dispatcher[done_,f_,x_,0,xmax_] :=
  215.     Dispatcher[done,f,x,0,Infinity]/;
  216.   xmax=!=Infinity
  217.  
  218.  Dispatcher[done_, a_^(b_. x_^dg_.) f_.,x_,0,Infinity] :=
  219.     Dispatcher[done Release[
  220.       Hold[E^(-(-b) x^dg Log[a])]/.InputElem], f,x,0,Infinity]/;
  221.   Not[SameQ[a,E]] && FreeQ[a,x] && FreeQ[b,x] && FreeQ[dg,x] 
  222.     
  223.  Dispatcher[done_,f_,x_,0,Infinity] :=
  224.     AnalysExp2[done,f,x,0,Infinity]/;Not[FreeQ[f,E]] 
  225.  
  226.  Dispatcher[done_,f_,x_,0,Infinity] := IntFF[ done,f,x]
  227.  
  228.  Dispatcher[done_,f_,x_,xmin_,xmax_] := f FailInt
  229.  
  230. (*****************************************************************************
  231. *                     Search Logarithmic Expression
  232. *
  233. *****************************************************************************)
  234.  
  235.  AnalysLog[1,Log[w_. x_^dg_.]^n_. f_.,x_,0,Infinity] := 
  236.   (-1)^n AnalysLog[1,Log[w^(-1) x^(-dg)]^n f,x,0,Infinity]/;
  237.  IntegerQ[n] && n>0 && IntegerQ[dg] && dg<0
  238.  
  239.  AnalysLog[1,Log[w_. x_^dg_.]^n_. f_.,x_,0,Infinity] := 
  240.   Module[ {z,var,answer},
  241.     answer = Dispatcher[1,PowerExpand[(f//.x->w^(-1/dg) z^(1/dg))*
  242.                z^(1/dg-1+var)],z,0,Infinity]//.PolyGammaRule1;
  243.     If[ Not[FreeQ[answer,FailInt]], FailInt,
  244.     If[Not[NumberQ[dg]] , 1, Sign[dg]] dg^(-1) w^(-1/dg) n!*
  245.     Coefficient[Expand[Normal[Series[answer,
  246.                                     {var,0,n}] ]],var,n]]
  247.   ]/;IntegerQ[n] && n>0
  248.  
  249.  AnalysLog[done_,Log[w_. x_^dg_.]^n_. f_.,x_,xmin_,Infinity] := 
  250.     If[ SameQ[w xmin^dg,1] && FreeQ[w,x] && FreeQ[dg,x] && Not[Znak[w]],
  251.         Dispatcher[ done*
  252.           If[ Not[NumberQ[dg]] || dg > 0, Log[w x^dg]^n/.LogRule1,
  253.               (-1)^n Log[w^(-1) x^(-dg)]^n/.LogRule1 ],f,x,xmin,Infinity],             
  254.     FailInt ] /;xmin=!=0 && IntegerQ[n] && n>0
  255.  
  256.  AnalysLog[done_,Log[w_. x_^dg_.]^n_. f_.,x_,0,xmax_] :=
  257.     If[ SameQ[w xmax^dg,1] && FreeQ[w,x] && FreeQ[dg,x] && Not[Znak[w]], 
  258.         Dispatcher[ done *
  259.           If[ Not[NumberQ[dg]] || dg > 0 ,Log[w x^dg]^n/.LogRule2,
  260.               (-1)^n Log[w^(-1) x^(-dg)]^n/.LogRule2 ],f,x,0,xmax],
  261.     FailInt ] /;xmax=!=Infinity && IntegerQ[n] && n>0
  262.  
  263.  AnalysLog[done_,Log[w_. x_^dg_.]^n_. f_.,x_,xmin_,Infinity] := 
  264.   Module[ {z},
  265.     If[ SameQ[w xmin^dg,1] && FreeQ[w,x] && Not[Znak[w]],
  266.     If[ done===1 && (Not[NumberQ[dg]] || dg > 0),
  267.         Dispatcher[ done,z^n Expand[PowerExpand[E^(z/dg) *
  268.              f//.x->(1/w)^(1/dg) E^(z/dg)]],
  269.              z,0,Infinity] (1/w)^(1/dg)/dg,
  270.         (-1)^n AnalysLog[done,Log[w^(-1) x^(-dg)]^n f,x,xmin,Infinity] ],
  271.      FailInt ] ]/;xmin=!=0 
  272.  
  273.  AnalysLog[done_,Log[w_. x_^dg_.]^n_. f_.,x_,0,xmax_] := 
  274.   Module[ {z},
  275.     If[ SameQ[w xmax^dg,1] && FreeQ[w,x] && Not[Znak[w]],
  276.     If[ done===1 && (Not[NumberQ[dg]] || dg < 0),
  277.         -Dispatcher[ done,z^n Expand[PowerExpand[E^(z/dg)*
  278.              f//.x->(1/w)^(1/dg) E^(z/dg)]],
  279.              z,0,Infinity] (1/w)^(1/dg)/dg,
  280.         (-1)^n AnalysLog[done,Log[w^(-1) x^(-dg)]^n f,x,0,xmax] ],
  281.     FailInt ] ]/;xmax=!=Infinity 
  282.  
  283.  AnalysLog[1,Log[Tan[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  284.   Module[ {z},
  285.     Dispatcher[1,Log[z]^n (1+z^2)^(-1) (f//.x->ArcTan[z]/a)//.LogTrig,
  286.                z,0,1]/a
  287.     ]/; FreeQ[a,x] && xmax=== Pi/(4 a)
  288.  
  289.  AnalysLog[1,Log[Tan[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  290.   Module[ {z},
  291.     Dispatcher[1,Log[z]^n (1+z^2)^(-1) (f//.x->ArcTan[z]/a)//.LogTrig,
  292.                z,0,Infinity]/a
  293.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a)
  294.  
  295.  AnalysLog[1,Log[Sin[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  296.   Module[ {z},
  297.     Dispatcher[1,Log[z]^n (1-z^2)^(-1/2) (f//.x->ArcSin[z]/a)//.LogTrig,
  298.                z,0,1]/a
  299.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a)
  300.  
  301.  AnalysLog[1,Log[Csc[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  302.   Module[ {z},
  303.     Dispatcher[1,Log[1/z]^n (1-z^2)^(-1/2) (f//.x->ArcSin[z]/a)//.LogTrig,
  304.                z,0,1]/a
  305.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a)
  306.  
  307.  AnalysLog[1,Log[Cos[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  308.   Module[ {z},
  309.     Dispatcher[1,Log[z]^n (1-z^2)^(-1/2) (f//.x->ArcCos[z]/a)//.LogTrig,
  310.                z,0,1]/a 
  311.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a)
  312.  
  313.  AnalysLog[1,Log[Sec[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  314.   Module[ {z},
  315.     Dispatcher[1,Log[1/z]^n (1-z^2)^(-1/2) (f//.x->ArcCos[z]/a)//.LogTrig,
  316.                z,0,1]/a 
  317.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a)
  318.  
  319.  AnalysLog[1,Log[Sin[a_. x_]]^n_. f_.,x_,0,xmax_] := 
  320.   Module[ {z},
  321.     Dispatcher[1,Log[z]^n (1-z^2)^(-1/2) (f//.x->ArcSin[z]/a)//.LogTrig,
  322.                z,0,1]/a + 
  323.     AnalysLog[1,Log[Cos[a z]]^n (f//.x->z+Pi/(2 a))/.ExpandIntoTrig,
  324.               z,0,Pi/(2 a)]
  325.     ]/; FreeQ[a,x] && xmax=== Pi/a
  326.  
  327.  AnalysLog[1,Sin[a_. Log[x_]]^n_. f_.,x_,0,1] := 
  328.    Module[ {z},
  329.     -Dispatcher[1,Sin[a z] PowerExpand[E^(-z) f//.x->E^(-z)],z,0,Infinity]
  330.    ]/;FreeQ[a,x]
  331.  
  332.  AnalysLog[1,Cos[a_. Log[x_]]^n_. f_.,x_,0,1] := 
  333.    Module[ {z},
  334.     Dispatcher[1,Cos[a z] PowerExpand[E^(-z) f//.x->E^(-z)],z,0,Infinity]
  335.    ]/;FreeQ[a,x]
  336.  
  337.  AnalysLog[1,Log[a_+b_] f_.,x_,0,xmax_] := 
  338.    Module[ {inter},
  339.     inter = Log[a]//.{
  340.             Log[q_ w_] :> Log[q] + Log[w],
  341.             Log[q_^n_] :> n Log[q]};
  342.     positiveList[ComMult[a,x]]; positiveList[ComMult[b,x]];
  343.     If[ Head[inter]===Plus,
  344.         Map[ Dispatcher[1,f #,x,0,xmax]&,inter ],
  345.         Dispatcher[1,inter f,x,0,xmax]
  346.       ] + 
  347.      AnalysLog[1,Log[1+Expand[b/a]] f,x,0,xmax]
  348.    ]/;
  349.    Not[FreeQ[b,x]] && Not[FreeQ[a,x]] && Not[Znak[a]] && Not[Znak[b]]  
  350.  
  351.  AnalysLog[done_,Log[1 + a_ x_^p_.]^n_. f_.,x_,0,xmax_] := 
  352.   Module[ {z},
  353.     If[ Not[Znak[p]],
  354.        p^(-1) Dispatcher[(done//.x->z^(1/p)),(Log[1+a z]^n/.InputElem) *
  355.                PowerExpand[(f//.x->z^(1/p)) z^(1/p-1)],z,0,xmax^p ],
  356.        (-p)^(-1) Dispatcher[(done//.x->z^(-1/p)),(Log[1+a/z]^n/.InputElem)*
  357.                PowerExpand[(f//.x->z^(-1/p)) z^(-1/p-1)],z,0,xmax^(-p)] ]
  358.   ]/;xmax=!=Infinity && FreeQ[a,x] && FreeQ[p,x] &&
  359.      Expand[1+a xmax^p]===0 && IntegerQ[n] 
  360.  
  361.  AnalysLog[done_,Log[1 + a_. x_^p_.]^n_. f_.,x_,0,xmax_] := 
  362.   Module[ {z},
  363.     If[ Not[Znak[p]],
  364.        p^(-1) Dispatcher[done//.x->z^(1/p),(Log[1+a z]^n/.InputElem) *
  365.                PowerExpand[(f//.x->z^(1/p)) z^(1/p-1)],z,0,
  366.          If[xmax===Infinity,Infinity,xmax^p] ],
  367.        (-p)^(-1) Dispatcher[done//.x->z^(-1/p), (Log[1+a/z]^n/.InputElem) *
  368.                PowerExpand[(f//.x->z^(-1/p)) z^(-1/p-1)],z,0,
  369.          If[xmax===Infinity,Infinity,xmax^(-p)]] ]
  370.   ]/;FreeQ[a,x] && FreeQ[p,x] && IntegerQ[n]
  371.  
  372.  AnalysLog[done_,Log[1 + a_. x_^p_.]^n_. f_.,x_,xmin_,Infinity] := 
  373.   Module[ {z},
  374.     If[ Not[Znak[p]],
  375.        p^(-1) Dispatcher[done//.x->z^(1/p),(Log[1+a z]^n/.InputElem) *
  376.            PowerExpand[(f//.x->z^(1/p)) z^(1/p-1)],z,xmin^p,Infinity],
  377.        (-p)^(-1) Dispatcher[done//.x->z^(-1/p),(Log[1+a/z]^n/.InputElem) *
  378.            PowerExpand[(f//.x->z^(-1/p)) z^(-1/p-1)],z,xmin^(-p),Infinity] ]
  379.   ]/;FreeQ[a,x] && FreeQ[p,x] && IntegerQ[n]
  380.  
  381.  AnalysLog[1,Log[1 + a_. E^(b_. x_)]^n_. f_.,x_,0,Infinity] := 
  382.   Module[ {z},
  383.    If[ Not[Znak[b]],
  384.    b^(-1) Dispatcher[1,Log[1+a z]^n (f//.x->1/b Log[z])/z,z,1,Infinity],
  385.    -b^(-1) Dispatcher[1,Log[1+a z]^n (f//.x->1/b Log[z])/z,z,0,1] ]
  386.     ]/; FreeQ[b,x] && FreeQ[a,x]
  387.  
  388.  AnalysLog[1,Log[1+b_. f_[a_. x_]^m_.]^n_. g_[w_]^m_.,x_,0,xmax_] := 
  389.   Module[ {int},
  390.     int = Integrate[g[w]^m,x];
  391.     (int Log[1+b f[a x]^m]^n/.{x->xmax}) - 
  392.     (int Log[1+b f[a x]^m]^n/.{x->0}) +
  393.     b m Map[ Dispatcher[1,#/(1+b f[a x]^m),x,0,xmax]&,
  394.              Expand[TrigRuleConv[int f[a x]^(m-1) D[f[a x],x]]] ]                  
  395.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a) && IntegerQ[n] &&
  396.   Complement[{f,g},{Sin,Cos}]==={}
  397.  
  398.  AnalysLog[1,Log[1+b_. Sin[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  399.   Module[ {z},
  400.     Dispatcher[1,Log[1+b z^m]^n (1-z^2)^(-1/2) (f//.x->ArcSin[z]/a)//.LogTrig,
  401.                z,0,1]/a
  402.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a) && IntegerQ[n]
  403.  
  404.  AnalysLog[1,Log[1+b_. Cos[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  405.   Module[ {z},
  406.     Dispatcher[1,Log[1+b z^m]^n (1-z^2)^(-1/2) (f//.x->ArcCos[z]/a)//.LogTrig,
  407.                z,0,1]/a 
  408.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a) && IntegerQ[n]
  409.  
  410.  AnalysLog[1,Log[1+b_. Tan[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  411.   Module[ {z},
  412.     Dispatcher[1,Log[1+b z^m]^n (1+z^2)^(-1) (f//.x->ArcTan[z]/a)//.LogTrig,
  413.                z,0,Infinity]/a 
  414.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a) && IntegerQ[n]
  415.  
  416.  AnalysLog[1,Log[1+b_. Cot[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  417.   Module[ {z},
  418.     Dispatcher[1,Log[1+b z^(-m)]^n (1+z^2)^(-1) (f//.x->ArcTan[z]/a)//.LogTrig,
  419.                z,0,Infinity]/a 
  420.     ]/; FreeQ[a,x] && xmax=== Pi/(2 a) && IntegerQ[n]
  421.  
  422.  AnalysLog[1,Log[1+b_. Sin[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  423.   Block[ {zn,HyperInteg},Factor[SimpPower[Expand[
  424.     AnalysLog[1,Log[1+b Sin[a zn]^m]^n (f//.x->zn),zn,0,Pi/(2 a)]/a + 
  425.     AnalysLog[1,Log[1+b Cos[a zn]^m]^n (f//.x->zn+Pi/(2 a))/.ExpandIntoTrig,
  426.               zn,0,Pi/(2 a)]]]/.{
  427.         Arg[s_] :> Pi/;Znak[s],
  428.         Arg[s_] :> 0/;Not[Znak[s]]}]
  429.     ]/; FreeQ[a,x] && xmax=== Pi/a && IntegerQ[n]
  430.  
  431.  AnalysLog[1,Log[1+b_. Cos[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  432.   Block[ {zn,HyperInteg},Factor[SimpPower[Expand[
  433.     AnalysLog[1,Log[1+b Cos[a zn]^m]^n (f//.x->zn),zn,0,Pi/(2 a)]/a + 
  434.     AnalysLog[1,Log[1-b Sin[a zn]^m]^n (f//.x->zn+Pi/(2 a))/.
  435.               ExpandIntoTrig,zn,0,Pi/(2 a)]]]/.{
  436.         Arg[s_] :> Pi/;Znak[s],
  437.         Arg[s_] :> 0/;Not[Znak[s]]}]
  438.     ]/; FreeQ[a,x] && xmax=== Pi/a && IntegerQ[n]
  439.  
  440.  AnalysLog[1,Log[1+b_. Sin[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  441.   Block[ {z,HyperInteg},Expand[
  442.     AnalysLog[1,Log[1+b Sin[a z]^m]^n (f//.x->z+Pi/a)/.ExpandIntoTrig,
  443.               z,0,Pi/a] + 
  444.     AnalysLog[1,Log[1+(-1)^m b Sin[a z]^m]^n (f//.x->z+Pi/a)/.
  445.               ExpandIntoTrig,z,0,Pi/a]]
  446.     ]/; FreeQ[a,x] && xmax=== 2 Pi/a && IntegerQ[n]
  447.  
  448.  AnalysLog[1,Log[1+b_. Cos[a_. x_]^m_.]^n_. f_.,x_,0,xmax_] := 
  449.   Block[ {z,HyperInteg},Expand[
  450.     AnalysLog[1,Log[1+b Cos[a z]^m]^n (f//.x->z+Pi/a)/.ExpandIntoTrig,
  451.               z,0,Pi/a] + 
  452.     AnalysLog[1,Log[1+(-1)^m b Cos[a z]^m]^n (f//.x->z+Pi/a)/.
  453.               ExpandIntoTrig,z,0,Pi/a]]
  454.     ]/; FreeQ[a,x] && xmax=== 2 Pi/a && IntegerQ[n]
  455.  
  456.  AnalysLog[done_,Log[Abs[1+a_ x_^n_.]] f_.,x_,0,Infinity] :=
  457.     Dispatcher[done,(Log[Abs[1+a x^n]]/.InputElem) f,x,0,Infinity]
  458.  
  459.  AnalysLog[done_,Log[(1+ x_)/(1-x_)] f_.,x_,0,xmax_] :=
  460.     Module[ {inter},
  461.       inter = Log[(1+x)/(1-x)]/.InputElem;
  462.        If[ FreeQ[inter,MeijerG], FailInt,
  463.            Dispatcher[done,inter f,x,0,xmax]]
  464.     ]
  465.  
  466.  AnalysLog[done_,Log[(1+x_)/(x_-1)] f_.,x_,1,xmax_] :=
  467.     Module[ {inter},
  468.       inter = Log[(1+x)/(x-1)]/.InputElem;
  469.        If[ FreeQ[inter,MeijerG], FailInt,
  470.            Dispatcher[done,inter f,x,1,xmax]]
  471.     ]
  472.  
  473.  AnalysLog[1,Log[a_Plus] f_.,x_,0,xmax_] := 
  474.    Module[ {add},
  475.     add = ComPlus[a,x];
  476.     If[ add===0 || add===1, FailInt,
  477.         positiveList[add];
  478.         positiveList[ComMult[a-add,x]];
  479.         Log[add] Dispatcher[1,f,x,0,xmax] + 
  480.         AnalysLog[1,Log[1+Expand[(a-add)/add]] f,x,0,xmax]
  481.     ]]
  482.  
  483.  AnalysLog[1,Log[Abs[a_Plus]] f_.,x_,0,xmax_] := 
  484.    Module[ {add},
  485.     add = ComPlus[a,x];
  486.     If[ add===0 || add===1, FailInt,
  487.         Log[Abs[add]] Dispatcher[1,f,x,0,xmax] + 
  488.         AnalysLog[1,Log[Abs[1+Expand[(a-add)/add]]] f,x,0,xmax]
  489.     ]]
  490.  
  491.  AnalysLog[ __ ] := Module[ {w}, w FailInt ]
  492.  
  493. (*****************************************************************************
  494. *                      Search Algebraic Expression
  495. *
  496. *****************************************************************************)
  497.  
  498.  AnalysAlg[done_,s_,m_,s1_+s2_,n_,f_,x_,lim_] := 
  499.     AnalysAlg[done,s+s1,m,s2,n,f,x,lim]/;
  500.   FreeQ[s1,x]
  501.  
  502.  AnalysAlg[done_,s_,m_,m1_ m2_,n_,f_,x_,lim_] := 
  503.     AnalysAlg[done,s,m m1,m2,n,f,x,lim]/;
  504.   FreeQ[m1,x]
  505.  
  506.  AnalysAlg[done_,s_,m_,x_^dg_,n_,f_,x_,{xmin_,xmax_}] := 
  507.   Module[ {z},
  508.     dg^(-1) SearchRule[done//.x->z^(1/dg),s,m,1,n,PowerExpand[Simplify[
  509.               (f//.x->z^(1/dg)) z^(1/dg-1)]],
  510.               z,{If[xmin===-Infinity,-Infinity,
  511.                     If[xmin===0,0,xmin^dg]],
  512.                  If[xmax===Infinity, Infinity, 
  513.                     If[xmax===0,0,xmax^dg]]}]
  514.    ]/; Not[NumberQ[N[dg]]]
  515.  
  516.  AnalysAlg[done_,s_,m_,x_^dg_.,n_,f_,x_,lim_] := 
  517.     SearchRule[done,s,m,dg,n,f,x,lim]
  518.  
  519.  AnalysAlg[1,s_,m_,Exp[a_. x_^dg_.+const_.],n_,f_,x_,{0,Infinity}] :=
  520.     Module[ {var},
  521.       AnalysAlg[1,s,m,Exp[a var^(-dg)+const/.x->1/var],n,
  522.        (f/.x->1/var) var^(-2),var,{0,Infinity}] ]/;
  523.   FreeQ[a,x] && NumberQ[dg] && Im[dg]==0 && dg<0 
  524.  
  525.  AnalysAlg[1,s_,m_,Exp[a_. x_^dg_.+const_/;FreeQ[const,x]],n_,f_,x_,interv_] :=
  526.    E^(const n) AnalysAlg[1,s E^(-const),m,E^(a x^dg),n,f,x,interv] 
  527.  
  528.  AnalysAlg[1,s_,m_,Exp[a_ x_^dg_.],n_,x_^k_. f_.,x_,{0,Infinity}] :=
  529.   Block[{z,var,var1,var2,HyperInteg},
  530.     var1 = s/m;
  531.     If[ Znak[var1],var=-var2;var1=-s/m,var=var2];
  532.     m^n (-1/a)^(1/dg) dg^(-1) Dispatcher[1,Gamma[-n]^(-1)*
  533.            MeijerG[ {n+1},{},{0},{},{1,var z^dg} ]*
  534.         Log[z]^(1/dg-1) Expand[x^k f//.x->(-1/a)^(1/dg) Log[z]^(1/dg)]/
  535.          z^(n+1),z,1,Infinity]/.{var2->var1} 
  536.     ]/; 
  537.   FreeQ[a,x] && Znak[a] && NumberQ[dg] && Im[dg]==0 && dg>0 &&
  538.   NumberQ[n] && Im[n]==0 && n<0
  539.  
  540.  AnalysAlg[1,s_,m_,Exp[a_ x_^dg_.],n_,f_,x_,{0,Infinity}] :=
  541.   Block[{z,var,var1,var2,HyperInteg},
  542.     var1 = s/m;
  543.     If[ Znak[var1],var=-var2;var1=-s/m,var=var2];
  544.     m^n (-1/a)^(1/dg) dg^(-1) Dispatcher[1,Gamma[-n]^(-1)*
  545.            MeijerG[ {n+1},{},{0},{},{1,var z^dg} ]*
  546.         Log[z]^(1/dg-1) Expand[f//.x->(-1/a)^(1/dg) Log[z]^(1/dg)]/
  547.          z^(n+1),z,1,Infinity]/.{var2->var1} 
  548.     ]/; 
  549.   Not[Znak[s/m]] && FreeQ[a,x] && Znak[a] && NumberQ[dg] && 
  550.   Im[dg]==0 && dg>0 && NumberQ[n] && Im[n]==0 && n<0
  551.  
  552.  AnalysAlg[1,s_,m_,Exp[a_. x_^dg_.],n_,x_^k_. f_.,x_,{0,Infinity}] :=
  553.   Block[{z,var,var1,var2,HyperInteg},
  554.     If[ s+m==0 && n<-1, Return[ var Infinity ] ];
  555.     var1 = m/s;
  556.     If[ Znak[var1],var=-var2;var1=-m/s,var=var2];
  557.     s^n (1/a)^(1/dg)/dg Dispatcher[1,Gamma[-n]^(-1)*
  558.           MeijerG[ {n+1},{},{0},{},{1,var z^dg} ]*
  559.          Log[z]^(1/dg-1) z^(-1) * 
  560.          Expand[x^k f//.x->(1/a)^(1/dg) Log[z]^(1/dg)]/.{E^(r1_+r2_) :>
  561.       (E^r1) (E^r2)},z,1,Infinity]/.{var2->var1}  
  562.     ]/;
  563.   FreeQ[a,x] && Not[Znak[a]] && NumberQ[dg] && Im[dg]==0 && dg>0 && 
  564.   NumberQ[n] && Im[n]==0 && n<0
  565.  
  566.  AnalysAlg[1,s_,m_,Exp[a_. x_^dg_.],n_,f_,x_,{0,Infinity}] :=
  567.   Block[{z,var,var1,var2,HyperInteg},
  568.     var1 = m/s;
  569.     If[ Znak[var1],var=-var2;var1=-m/s,var=var2];
  570.     s^n (1/a)^(1/dg)/dg Dispatcher[1,Gamma[-n]^(-1)*
  571.           MeijerG[ {n+1},{},{0},{},{1,var z^dg} ]*
  572.          Log[z]^(1/dg-1) z^(-1) * 
  573.          Expand[f//.x->(1/a)^(1/dg) Log[z]^(1/dg)]/.{E^(r1_+r2_) :>
  574.       (E^r1) (E^r2)},z,1,Infinity]/.{var2->var1}  
  575.     ]/;
  576.   Not[Znak[s/m]] && FreeQ[a,x] && Not[Znak[a]] && NumberQ[dg] &&  
  577.   Im[dg]==0 && dg>0 && NumberQ[n] && Im[n]==0 && n<0
  578.  
  579.  AnalysAlg[done_,s_,m_,trigf_[a_. x_]^dg_.,n_,f_,x_,lim_] :=
  580.     AnalysAlgTrig[done,s,m,trigf[a x]^dg,n,f,x,lim]/; 
  581.   FreeQ[a,x] && Complement[{trigf},{Sin,Cos,Tan,Cot}]==={}
  582.  
  583.  AnalysAlg[ __ ] := Module[ {w}, w FailInt ]
  584.  
  585.  SearchRule[done_,num1_ s_,num2_ m_,dg_,n_,f_,x_,lim_] :=
  586.   E^(I Pi n) SearchRule[done,Abs[num1] s,Abs[num2] m,dg,n,f,x,lim]/;
  587.    NumberQ[num1] && NumberQ[num2] && Im[num1]==0 && 
  588.    Im[n]==0 && num1<0 && num2<0
  589.  
  590.  SearchRule[done_,num_ s_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  591.     SearchRuleGen2[done,num,s,m,dg,n,f,x,{xmin,xmax}]/;
  592.  NumberQ[num] && Im[num]==0 && num<0
  593.  
  594.  SearchRule[done_,num_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  595.     SearchRuleGen2[done,num,1,m,dg,n,f,x,{xmin,xmax}]/;
  596.  NumberQ[num] && Im[num]==0 && num<0
  597.  
  598.  SearchRuleGen2[done_,num_,s_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  599.     If[ N[n]<-1,FailInt,
  600.         (s num)^n Pi Dispatcher[ done, 
  601.         MeijerG[ {0},{1/2},{0},{1/2},{1,-m x^dg/(s num)} ] f,
  602.         x,xmin,xmax ]]/;xmax=!=Infinity &&xmin<N[(-s num/m)^(1/dg)]<xmax&&
  603.  (And@@(NumberQ[#]&/@N[{s,num,m,dg,xmin,xmax}]))&&N[n]<=-1
  604.  
  605.  SearchRuleGen2[done_,num_,s_,m_,dg_,n_,x_^k_. f_.,x_,{xmin_,xmax_}] :=
  606.   Module[ {z,lim1,lim2,function},
  607.   lim1 = xmin;  lim2 = xmax;
  608.   function =  
  609.   If[ n === -1 && (xmin==0&&xmax===Infinity||done=!=1||!FreeQ[f,Power]
  610.       || !FreeQ[f,Log] || !FreeQ[f,ArcCos] || !FreeQ[f,ArcSin]), 
  611.       Pi MeijerG[ {0},{1/2},{0},{1/2},{1,m x^dg/(Abs[num] s)}]/(num s),
  612.   If[ !n === -1,
  613.     If[ xmax===Infinity && xmin =!=-Infinity && 
  614.         Expand[m xmin^dg+num s] === 0 ||
  615.         xmax===Infinity && xmin===0 && done=!=1, lim1 = 0;
  616.         (Abs[num] s)^n *
  617.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  618.         MeijerG[ {n+1},{},{},{0},{1,m x^dg/(Abs[num] s)} ] ,
  619.     If[ EvenQ[dg] &&xmin ===-Infinity&&Expand[m xmax^dg+num s]===0 &&
  620.             Expand[x^k f//.x->-z] === Expand[x^k f//.x->z],
  621.         lim1 = 0; lim2 = Infinity;
  622.         (Abs[num] s)^n *
  623.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  624.         MeijerG[ {n+1},{},{},{0},{1,m x^dg/(Abs[num] s)} ],
  625.         FailInt ]], 
  626.    FailInt ]]; 
  627.    Dispatcher[ done function,x^k f,x,lim1,lim2 ]
  628.    ]
  629.  
  630.  SearchRuleGen2[done_,num_,s_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  631.   Module[ {z,lim1,lim2,function},
  632.   lim1 = xmin;  lim2 = xmax;
  633.   function =  
  634.   If[ n === -1 && (xmin==0&&xmax===Infinity||done=!=1||!FreeQ[f,Power]
  635.       || !FreeQ[f,Log] || !FreeQ[f,ArcCos] || !FreeQ[f,ArcSin]), 
  636.       Pi MeijerG[ {0},{1/2},{0},{1/2},{1,m x^dg/(Abs[num] s)}]/(num s),
  637.   If[ !n === -1,
  638.     If[ xmax===Infinity && xmin =!=-Infinity && 
  639.         Expand[m xmin^dg+num s] === 0 ||
  640.         xmax===Infinity && xmin===0 && done=!=1, lim1 = 0;
  641.         (Abs[num] s)^n*
  642.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  643.         MeijerG[ {n+1},{},{},{0},{1,m x^dg/(Abs[num] s)} ] ,
  644.     If[ EvenQ[dg] &&xmin ===-Infinity&&Expand[m xmax^dg+num s]===0 &&
  645.             Expand[f//.x->-z] === Expand[f//.x->z],
  646.         lim1 = 0; lim2 = Infinity;
  647.         (Abs[num] s)^n*
  648.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  649.         MeijerG[ {n+1},{},{},{0},{1,m x^dg/(Abs[num] s)} ],
  650.         FailInt ]], 
  651.    FailInt ]]; 
  652.    Dispatcher[ done function,f,x,lim1,lim2 ]
  653.    ]
  654.  
  655.  SearchRule[done_,s_,num_ m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  656.     SearchRuleGen1[done,s,num,m,dg,n,f,x,{xmin,xmax}]/;
  657.  NumberQ[num] && Im[num]==0 && num<0
  658.  
  659.  SearchRule[done_,s_,num_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  660.     SearchRuleGen1[done,s,num,1,dg,n,f,x,{xmin,xmax}]/;
  661.  NumberQ[num] && Im[num]==0 && num<0
  662.  
  663.  SearchRuleGen1[done_,s_,num_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  664.     If[ N[n]<-1,FailInt,
  665.         s^n Pi Dispatcher[ done, 
  666.         MeijerG[ {0},{1/2},{0},{1/2},{1,-m num x^dg/s} ] f,x,
  667.         xmin,xmax]]/;xmax=!=Infinity&&xmin<N[(-s/(num m))^(1/dg)]<xmax&&
  668.  (And@@(NumberQ[#]&/@N[{s,num,m,dg,n,xmin,xmax}]))&&N[n]<=-1
  669.  
  670.  SearchRuleGen1[done_,s_,num_,m_,dg_,n_,x_^k_. f_.,x_,{xmin_,xmax_}] :=
  671.   Module[ {z,lim1,lim2,function},
  672.   lim1 = xmin;  lim2 = xmax;
  673.   If[ xmax=!=Infinity && Expand[m num xmax^dg+s] =!= 0 &&
  674.       Expand[m num xmin^dg+s] =!= 0,
  675.     positiveList[-m num]; positiveList[s]; 
  676.     Return[
  677.       s^n Gamma[-n]^(-1)*
  678.     Dispatcher[ done, 
  679.                 MeijerG[ {n+1},{},{0},{},{1,m num x^dg/s} ] x^k f,
  680.                 x,lim1,lim2 ] ],
  681.   function = 
  682.   If[ n === -1 && (xmin==0&&xmax===Infinity||done=!=1||!FreeQ[f,Power]||
  683.       !FreeQ[f,Log]||!FreeQ[f,ArcCos]||!FreeQ[f,ArcSin]||!FreeQ[f,PolyLog]),  
  684.       positiveList[-m num]; positiveList[s]; 
  685.       s^n Pi MeijerG[ {0},{1/2},{0},{1/2},{1,m Abs[num] x^dg/s} ],
  686.   If[ !n === -1,
  687.     If[ xmax=!=Infinity && Expand[m num xmax^dg+s] === 0 &&
  688.         Expand[m num xmin^dg+s] =!= 0 ||
  689.         xmax===Infinity && done=!=1, lim2 = Infinity;
  690.         s^n *
  691.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  692.         MeijerG[ {},{n+1},{0},{},{1,Abs[num] m x^dg/s} ],
  693.     If[ Expand[m num xmin^dg+s] === 0 && xmax === 0 && EvenQ[dg] &&
  694.           Expand[x^k f//.x->-z] === (x^k f//.x->z),
  695.         lim1 = 0; lim2 = -xmin;
  696.         s^n *
  697.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  698.         MeijerG[ {},{n+1},{0},{},{1,Abs[num] m x^dg/s} ],
  699.     If[ Expand[m num xmin^dg+s] === 0 && Expand[m num xmax^dg+s] === 0 &&   
  700.           EvenQ[dg] && Expand[x^k f//.x->-z] === (x^k f//.x->z),
  701.         lim1 = 0; lim2 = Infinity;
  702.         2 s^n *
  703.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  704.         MeijerG[ {},{n+1},{0},{},{1,Abs[num] m x^dg/s} ],
  705.         FailInt ]]],
  706.     FailInt ]]];
  707.     Dispatcher[ done function,x^k f,x,lim1,lim2 ]
  708.     ]
  709.  
  710.  SearchRuleGen1[done_,s_,num_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  711.   Module[ {z,lim1,lim2,function},
  712.   lim1 = xmin;  lim2 = xmax;
  713.   If[ xmax=!=Infinity && Expand[m num xmax^dg+s] =!= 0 &&
  714.       Expand[m num xmin^dg+s] =!= 0,
  715.     positiveList[-m num]; positiveList[s]; 
  716.     Return[
  717.       s^n Gamma[-n]^(-1)*
  718.     Dispatcher[ done, 
  719.                 MeijerG[ {n+1},{},{0},{},{1,m num x^dg/s} ] f,
  720.                 x,lim1,lim2 ] ],
  721.   function = 
  722.   If[ n === -1 && (xmin==0&&xmax===Infinity||done=!=1||!FreeQ[f,Power]||
  723.       !FreeQ[f,Log]||!FreeQ[f,ArcCos]||!FreeQ[f,ArcSin]||!FreeQ[f,PolyLog]),
  724.       positiveList[-m num]; positiveList[s];  
  725.       s^n Pi MeijerG[ {0},{1/2},{0},{1/2},{1,m Abs[num] x^dg/s} ],
  726.   If[ !n === -1,
  727.     If[ xmax=!=Infinity && Expand[m num xmax^dg+s] === 0 &&
  728.         Expand[m num xmin^dg+s] =!= 0 ||
  729.         xmax===Infinity && done=!=1, lim2 = Infinity;
  730.         s^n *
  731.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  732.         MeijerG[ {},{n+1},{0},{},{1,Abs[num] m x^dg/s} ],
  733.     If[ Expand[m num xmin^dg+s] === 0 && xmax === 0 && EvenQ[dg] &&
  734.           Expand[f//.x->-z] === (f//.x->z),
  735.         lim1 = 0; lim2 = -xmin;
  736.         s^n *
  737.         If[NumberQ[n] && Im[n]==0 && n<-1,FailInt,Gamma[Expand[n+1]]]*
  738.         MeijerG[ {},{n+1},{0},{},{1,Abs[num] m x^dg/s} ],
  739.     If[ Expand[m num xmin^dg+s] === 0 && Expand[m num xmax^dg+s] === 0 &&   
  740.           EvenQ[dg] ,
  741.       If[ Expand[(f//.x->-z) + (f//.x->z)]===0,0, 
  742.         If[ Expand[f//.x->-z] === (f//.x->z),
  743.             lim1 = 0; lim2 = Infinity;
  744.             2 s^n *
  745.             If[ NumberQ[n] && Im[n]==0 && n<-1,
  746.                 FailInt,
  747.                 Gamma[Expand[n+1]]
  748.               ] *
  749.             MeijerG[ {},{n+1},{0},{},{1,Abs[num] m x^dg/s} ],
  750.         FailInt ]]]]],
  751.     FailInt ]]];
  752.     If[ function===0,0,
  753.         Dispatcher[ done function,f,x,lim1,lim2 ]]
  754.     ]
  755.  
  756.  SearchRule[done_,s_,m_,dg_,n_,f_,x_,{0,xmax_}] :=
  757.    s^n Dispatcher[done (1+x^dg)^n,f,x,0,xmax]/;
  758.   IntegerQ[n] && n> 0
  759.  
  760.  SearchRule[done_,s_,m_,dg_,n_,f_,x_,{xmin_,xmax_}] :=
  761.   Module[ {lim1,lim2,function,z},
  762.   lim1 = xmin;  lim2 = xmax;
  763.   function =
  764.     If[ xmin === -Infinity && xmax === Infinity &&EvenQ[dg] && 
  765.         Expand[f//.x->-z] === (f//.x->z),
  766.         lim1 = 0; lim2 = Infinity; 
  767.         positiveList[m]; positiveList[s];
  768.         2 s^n*
  769.         If[NumberQ[n] && Im[n]==0 && n>0,FailInt,Gamma[Expand[-n]]^(-1) ]*
  770.         MeijerG[ {n+1},{},{0},{},{1,m x^dg/s} ],
  771.         positiveList[m]; positiveList[s];
  772.         s^n *
  773.         If[NumberQ[n] && Im[n]==0 && n>0,FailInt,Gamma[Expand[-n]]^(-1) ]*
  774.         MeijerG[ {n+1},{},{0},{},{1,m x^dg/s} ]
  775.       ];
  776.   Dispatcher[ done,function f,x,lim1,lim2 ]
  777.   ] 
  778.  
  779. (****************************************************************************
  780. *           Trigonometric Functions into Algebraic Functions     
  781. *
  782. *****************************************************************************)
  783.  
  784.  AnalysAlgTrig[1,s_,m_,Cos[a_. x_]^dg_.,n_,f_,x_,{0,xmax_}] :=
  785.   Module[{z,r}, 
  786.     r = Expand[((f//.x->ArcCos[z]/a)/.TrigMultArg//.LogTrig)*
  787.                (1-z^2)^(-1/2)]//.z->x;
  788.     a^(-1)*
  789.     If[Head[r]===Plus,
  790.        Map[Dispatcher[1, (s+m x^dg)^n #,x,0,1]&,r],
  791.        Dispatcher[1, (s+m x^dg)^n r,x,0,1]]
  792.     ]/; xmax=== Pi/(2 a)
  793.  
  794.  AnalysAlgTrig[1,s_,m_,Sin[a_. x_]^dg_.,n_,f_,x_,{0,xmax_}] :=
  795.   Module[{z,r},
  796.     r = Expand[((f//.x->ArcSin[z]/a)/.TrigMultArg//.LogTrig)*
  797.                (1-z^2)^(-1/2)]//.z->x;
  798.     a^(-1)*
  799.     If[Head[r]===Plus,
  800.        Map[Dispatcher[1, (s+m x^dg)^n #,x,0,1]&,r],
  801.        Dispatcher[1, (s+m x^dg)^n r,x,0,1]]
  802.     ]/; xmax=== Pi/(2 a) 
  803.  
  804.  AnalysAlgTrig[1,s_,m_,Tan[a_. x_]^dg_.,n_,f_,x_,{0,xmax_}] :=
  805.   Module[{z},
  806.       a^(-1) Dispatcher[1,(1+z^2)^(-1) (s+m z^dg)^n *
  807.        Expand[f//.x->ArcTan[z]/a]//.LogTrig,z,0,Infinity]
  808.     ]/; xmax=== Pi/(2 a) 
  809.  
  810.  AnalysAlgTrig[1,s_,m_,Cot[a_. x_]^dg_.,n_,f_,x_,{0,xmax_}] :=
  811.   Module[{z},
  812.       a^(-1) Dispatcher[1,(1+z^2)^(-1) (s+m z^(-dg))^n *
  813.        Expand[f//.x->ArcTan[z]/a]//.LogTrig,z,0,Infinity]
  814.     ]/; xmax=== Pi/(2 a) 
  815.  
  816.  AnalysAlgTrig[done_,s_,m_,trigf_[a_. x_]^dg_.,n_,f_,x_,{0,xmax_}] :=
  817.   Block[ {z,answer,HyperInteg},
  818.    answer = AnalysAlg[done//.x->z,s,m,trigf[a z]^dg,n,f//.x->z,z,{0,Pi/(2 a)}];
  819.    If[ FreeQ[answer,FailInt], 
  820.        SimpPower[Expand[answer +
  821.        AnalysAlg[done,s,m,trigf[a z+Pi/2]^dg/.TrigRule,n,
  822.                 (f//.x->z+Pi/(2 a))//.TrigRule/.ExpandIntoTrig,
  823.                  z,{0,Pi/(2 a)}]] ]//.SimpSign1/.{
  824.           Arg[w_]:>Pi/;Znak[w], Arg[w_]:>0/;Not[Znak[w]]} ,
  825.        FailInt]
  826.    ]/; xmax=== Pi/a
  827.  
  828.  AnalysAlgTrig[done_,s_,m_,trigf_[a_. x_]^dg_.,n_,f_,x_,{0,xmax_}] :=
  829.   Block[ {z,answer,HyperInteg},
  830.    answer = AnalysAlg[done//.x->z,s,m,trigf[a z]^dg,n,f//.x->z,z,{0,Pi/a}];
  831.    If[ FreeQ[answer,FailInt], Expand[answer +
  832.     AnalysAlg[done,s,m,trigf[a z+Pi]^dg/.TrigRule,n,
  833.        (f//.x->z+Pi/a)//.TrigRule/.ExpandIntoTrig,z,{0,Pi/a}]],
  834.     FailInt]
  835.    ]/; xmax=== 2 Pi/a
  836.  
  837.  AnalysAlgTrig[ __ ] := Module[ {var}, var FailInt] 
  838.  
  839. (*****************************************************************************
  840. *                  Search Trigonometric Functions
  841. *
  842. *****************************************************************************)
  843.  
  844.  AnalysTrig[done_,f1_,f2_Plus,x_,xmax_] :=
  845.    Map[AnalysTrig[done,f1,#,x,xmax]&,f2]
  846.  
  847.  AnalysTrig[done_,f1_,const_ f2_,x_,xmax_] :=
  848.    const AnalysTrig[done,f1,f2,x,xmax]/;FreeQ[const,x] 
  849.  
  850.  AnalysTrig[done_,const_ f1_,f2_,x_,xmax_] :=
  851.    const AnalysTrig[done,f1,f2,x,xmax]/;FreeQ[const,x] 
  852.  
  853.  AnalysTrig[done_,f1_[a_. x_]^n1_.,f2_[b_. x_]^n2_.,x_,xmax_] :=
  854.   If[ a xmax=!=Pi/2 ,AnalysTrig[done,f2[b x]^n2,f1[a x]^n1,x,xmax],
  855.       a^(-1) Dispatcher[done 2,((f1[ArcCos[x]]^n1 f2[b/a ArcCos[x]]^n2*
  856.               (1-x^2)^(-1/2))//.LogTrig)//.InputInvTrig,x,0,1]/2]/;    
  857.   a xmax===Pi/2 || b xmax===Pi/2
  858.  
  859.  AnalysTrig[done_,Sin[x_]^n_.,f2_[b_. x_],x_,Pi] :=
  860.   2^(n+1) Dispatcher[done,x^n (1-x^2)^(n/2-1/2) *
  861.       f2[2 b ArcCos[x]]/.InputInvTrig,x,0,1]
  862.  
  863.  AnalysTrig[done_,f1_[x_]^n_.,f2_[b_. x_],x_,Pi] :=
  864.   Block[ {answer,HyperInteg},
  865.    answer = AnalysTrig[done,f1[x]^n,f2[b x],x,Pi/2];
  866.    If[ FreeQ[answer,FailInt], Expand[answer +
  867.    AnalysTrig[done,PowerExpand[f1[x + Pi/2]^n/.TrigRule],
  868.           f2[b x+b Pi/2]/.TrRuleE,x,Pi/2]],
  869.     FailInt] ]
  870.  
  871.  AnalysTrig[done_,f1_[a_. x_]^n_,f2_[b_. x_]^m_.,x_,xmax_] :=
  872.     a^(-1) AnalysTrig[done,f1[x]^n,f2[b x/a],x,Pi]/;
  873.   a xmax===Pi && m==1
  874.  
  875.  AnalysTrig[done_,f1_[a_. x_]^n_.,f2_[b_. x_]^m_,x_,xmax_] :=
  876.     b^(-1) AnalysTrig[done,f2[x]^m,f1[a x/b],x,Pi]/;
  877.   b xmax===Pi && n==1
  878.   
  879.  AnalysTrig[ __ ] := Module[ {var}, var FailInt]
  880.  
  881.  AnalysTrig1[1,f_[a_. x_]^n_.,1,x_,xmax_] :=
  882.   Module[ {answer},
  883.    answer = Integrate[f[a x]^n,x];
  884.    (answer/.x->xmax) - (answer/.x->0)
  885.     ]/;Complement[{f},{Sin,Cos}]==={} && IntegerQ[n]
  886.  
  887.  AnalysTrig1[done_,f_[a_. x_]^n_.,w_,x_,xmax_] :=
  888.    a^(-1) Dispatcher[done,(f[ArcCos[x]]^n If[w===1,1,ArcCos[x]/a] *
  889.               (1-x^2)^(-1/2)//.LogTrig)//.InputInvTrig,x,0,1]/;    
  890.   a xmax===Pi/2 
  891.  
  892.  AnalysTrig1[done_,Sin[a_. x_]^n_.,w_,x_,xmax_] :=
  893.    a^(-1) If[w===1,2,Pi/a] AnalysTrig1[done,Sin[x]^n,1,x,Pi/2]/;    
  894.   a xmax===Pi 
  895.  
  896.  AnalysTrig1[done_,const_ Sin[a_. x_]^n_.,w_,x_,xmax_] :=
  897.    a^(-1) If[w===1,2,Pi/a] Dispatcher[done,(1-x^2)^(n/2-1/2)*
  898.           If[w===1,1,ArcCos[x]],x,0,1] const/;    
  899.   a xmax===Pi && FreeQ[const,x]
  900.   
  901.  AnalysTrig1[ __ ] := Module[ {var}, var FailInt]
  902.  
  903.  
  904. (*****************************************************************************
  905. *                    Search Exp Functions
  906. *
  907. *****************************************************************************)
  908.  
  909.  AnalysExp1[done_,f_,x_,0,xmax_] := 
  910.    AnalysExp11[done, f/.{
  911.      E^z_ :> Module[ {inter},
  912.           inter = Together[Expand[z]];
  913.           E^(Collect[Numerator[inter],x]/
  914.              Collect[Denominator[inter],x])
  915.           ] /;!FreeQ[z,x]
  916.      },x,0,xmax] 
  917.  
  918.  AnalysExp11[done_,E^(a_. x_^dg_. + c_.) f_.,x_,0,xmax_] :=  
  919.     E^c Dispatcher[done,If[ Znak[a],E^(a x^dg)/.InputElem,
  920.            E^(a x^dg)/.InputExp ] f,x,0,xmax]/;
  921.   FreeQ[a,x] && FreeQ[c,x]
  922.  
  923.  AnalysExp11[done_,E^(a_. x_^dg1_. + b_. x_^dg2_. + c_.) f_.,x_,0,xmax_] :=  
  924.     E^c Dispatcher[done,(E^(a x^dg1)/.InputExp) (E^(b x^dg2)/.InputExp) f,
  925.     x,0,xmax]/;FreeQ[a,x] && FreeQ[b,x] && FreeQ[c,x] 
  926.  
  927.  AnalysExp11[ __ ] := Module[ {var}, var FailInt]
  928.  
  929.  AnalysExp2[done_,E^c_. f_.,x_,0,Infinity] := 
  930.    E^c AnalysExp21[done, f/.{E^z_ :> E^Collect[z,x]/;!FreeQ[z,x]},
  931.          x,0,Infinity]/;FreeQ[c,x]
  932.  
  933.  AnalysExp2[done_,f_,x_,0,Infinity] := 
  934.    AnalysExp21[done, Expand[f]/.{
  935.        E^z_ :> E^Collect[z,x]/;!FreeQ[z,x]} /.{
  936.        Abs[n_. z_] :> Abs[-n z] /; NumberQ[n] && Negative[n]
  937.       },x,0,Infinity]
  938.  
  939.  AnalysExp21[done_,f_,x_,0,Infinity] := 
  940.    IntFF[done,
  941.      f/.{
  942.          d_ - d_. E^(a_. x^dg_.+c_.) :> 
  943.            (
  944.            positiveList[-a];
  945.            d (1- E^(a x^dg)/.InputElem) E^c
  946.            )/;FreeQ[d,E] && FreeQ[a,x] && FreeQ[c,x],
  947.          d_. E^(a_. x^dg_.+c_.) - d_ :> 
  948.            (
  949.            positiveList[-a];
  950.            -d (1- E^(a x^dg)/.InputElem) E^c
  951.            )/;FreeQ[d,E] && FreeQ[a,x] && FreeQ[c,x],
  952.          E^(a_. x^dg_.+c_.) :> FailInt/;
  953.                 NumberQ[a] && Im[a]==0 &&a>0 && FreeQ[c,x],
  954.          E^(a_. x^dg_.+c_.) :> 
  955.            (
  956.            positiveList[-a];
  957.            (E^(a x^dg)/.InputElem) E^c
  958.            )/;FreeQ[a,x] && FreeQ[c,x],
  959.          E^(a_. Abs[x]^dg_.+c_.) :> 
  960.            (
  961.            positiveList[-a];
  962.            (E^(a x^dg)/.InputElem) E^c
  963.            )/;FreeQ[a,x] && FreeQ[c,x],
  964.          E^(a_. x^dg1_. + b_. x^dg2_.+c_.) :>
  965.            (
  966.            positiveList[-a]; positiveList[-b];
  967.            (E^(a x^dg1)/.InputElem) *
  968.            (E^(b x^dg2)/.InputElem) E^c
  969.            )/;FreeQ[a,x] && FreeQ[b,x] && FreeQ[c,x] 
  970.       },x]
  971.  
  972.  AnalysExp21[ done_,f_,x_,xmin_,xmax_ ] := f FailInt
  973.  
  974. (*****************************************************************************
  975. *                   Search Other Functions
  976. *
  977. *****************************************************************************)
  978.  
  979.  IntFF[done_,f_,x_] := Module[ {},
  980.     positive[__] = False;
  981.     IntFF1[done,f,x] ]
  982.  
  983.  IntFF1[done_,MeijerG[par__] f_.,x_] := IntFF1[done MeijerG[par],f,x]
  984.  
  985.  IntFF1[done_,x_^dg_.,x_] := IntGG[dg+1,done,x] /; FreeQ[dg,x]
  986.  
  987.  IntFF1[done_,const_ f_,x_] := const IntFF1[done,f,x]/;FreeQ[const,x]
  988.  
  989.  IntFF1[done_,const_,x_] := const IntGG[1,done,x]/;FreeQ[const,x]
  990.  
  991.  IntFF1[done_,x_^deg_. f_,x_] := 
  992.     FindIntegrand[ deg+1,done,f,x ] /;FreeQ[deg,x]
  993.  
  994.  IntFF1[done_,f_,x_] := FindIntegrand[ 1,Simplify[done],f,x ] 
  995.  
  996.  FindIntegrand[alfa_,1,pol1_. f_[w_]^n_.+pol2_.,x_] :=
  997.   Module[ {answer},
  998.     answer = SingleGfunction[
  999.              alfa,CollectSC[Expand[Expand[
  1000.              pol1 f[w]^n+pol2,Trig->True]/.ColTerm]],
  1001.              pol1 f[w]^n+pol2,x];
  1002.     answer/;FreeQ[answer,FailInt]
  1003.    ] /;
  1004.   Complement[{f},{Sin,Cos}]==={} && PolynomialQ[pol1,x] &&
  1005.   PolynomialQ[pol2,x]
  1006.  
  1007.  FindIntegrand[alfa_,1,f1_[w1_]^n_. f2_[w2_]^m_.+pol_.,x_] :=
  1008.   Module[ {answer},
  1009.     answer =  SingleGfunction[
  1010.               alfa,CollectSC[Expand[Expand[
  1011.               f1[w1]^n f2[w2]^m+pol,Trig->True]/.ColTerm]],
  1012.               f1[w1]^n f2[w2]^m+pol,x];
  1013.     answer/;FreeQ[answer,FailInt]
  1014.    ] /;
  1015.   Complement[{f1,f2},{Sin,Cos}]==={} && PolynomialQ[pol,x]
  1016.  
  1017.  FindIntegrand[alfa_,1,pol1_. f1_[w1_]^n_.+pol2_. f2_[w2_]^m_.+pol3_.,x_] :=
  1018.   Module[ {answer},
  1019.     answer =  SingleGfunction[
  1020.               alfa,CollectSC[Expand[Expand[ pol1 f1[w1]^n +
  1021.               pol2 f2[w2]^m+pol3,Trig->True]/.ColTerm]],
  1022.               pol1 f1[w1]^n + pol2 f2[w2]^m+pol3,x];
  1023.     answer/;FreeQ[answer,FailInt]
  1024.    ] /;
  1025.   Complement[{f1,f2},{Sin,Cos}]==={} && 
  1026.   (And@@(PolynomialQ[#,x]&/@{pol1,pol2,pol3}))
  1027.  
  1028.  FindIntegrand[alfa_,done_,f_,x_] := 
  1029.    GGfunctions[alfa,done,CollectSC[Expand[
  1030.           Expand[f,Trig->True]/.ColTerm]]//.{
  1031.       Sin[w_+v_] :>
  1032.         Sin[w] Cos[v] + Cos[w] Sin[v]/;Not[FreeQ[v,x]] && Not[FreeQ[w,x]],
  1033.       Cos[w_+v_] :> 
  1034.         Cos[w] Cos[v] - Sin[w] Sin[v]/;Not[FreeQ[v,x]] && Not[FreeQ[w,x]],
  1035.       Sin[w_Plus] :> 
  1036.        Module[ {add = ComPlus[w,x]},
  1037.           Sin[add] Cos[w-add] + Cos[add] Sin[w-add]
  1038.        ],
  1039.       Cos[w_Plus] :> 
  1040.        Module[ {add = ComPlus[w,x]},
  1041.           Cos[add] Cos[w-add] - Sin[add] Sin[w-add]
  1042.        ]
  1043.       },x]/;
  1044.      Not[FreeQ[f,Sin]] || Not[FreeQ[f,Cos]]
  1045.  
  1046.  FindIntegrand[alfa_,done_,f_,x_] := GGfunctions[alfa,done,f,x]
  1047.  
  1048.  SingleGfunction[alfa_,f_,oldf_,x_] := 
  1049.     TaylorSeriesTrig[alfa,CondTrigDegree[f,x],f,oldf,x]/;
  1050.   CondTrig[f,x]
  1051.  
  1052.  SingleGfunction[alfa_,f_,oldf_,x_] := GGfunctions[alfa,1,oldf,x]
  1053.  
  1054.  TaylorSeriesTrig[ alfa_,{dg_,True},f_,oldf_,x_ ] :=
  1055.     Module[ {var},      
  1056.      -1/dg *
  1057.      TaylorSeriesTrig[ alfa/dg,{1,True},f/.x->var^(1/dg),
  1058.                                         oldf,var]
  1059.     ] /; 
  1060.  NumberQ[dg] && Negative[dg]
  1061.  
  1062.  GGfunctions[ alfa_,done_,f_,x_ ] := 
  1063.      f IntGG[alfa,done,x] /; FreeQ[f,x]
  1064.  
  1065.  GGfunctions[ alfa_,done_,f_,x_ ] :=  
  1066.     IntGG[alfa,FindGfunctionGl[done,f,x],x] 
  1067.  
  1068.  FindGfunctionGl[done_,f_Plus,x_] := Map[ FindGfunctionGl[done,#,x]&,f ]
  1069.  
  1070.  FindGfunctionGl[done_,MeijerG[par__] f_.,x_] := 
  1071.           FindGfunctionGl[done MeijerG[par],f,x]
  1072.  
  1073.  FindGfunctionGl[done_,f_,x_] := f done/;FreeQ[f,x]
  1074.  
  1075.  FindGfunctionGl[done_,const_ f_,x_] := 
  1076.     const FindGfunctionGl[done,f,x]/;FreeQ[const,x]
  1077.  
  1078.  FindGfunctionGl[done_,f_,x_] := FindGfunction[done,f,x]
  1079.  
  1080.  FindGfunction[done_,f_,x_] := FindGfunction1[done,Expand[f/.InputBessel],x]/;
  1081.     Apply[Or,Not[FreeQ[f,#]]&/@ListBessel] && Not[FreeQ[f,x]]
  1082.  
  1083.  FindGfunction[done_,f_,x_] := FindGfunction1[done,Expand[f/.InputOther],x]/;
  1084.     Apply[Or,Not[FreeQ[f,#]]&/@ListOther] && Not[FreeQ[f,x]]
  1085.  
  1086.  FindGfunction[done_,f_,x_] := 
  1087.     Module[ {answer},
  1088.       answer = f/.InputElem;
  1089.       If[ Not[SameQ[answer,f]],
  1090.           FindGfunction1[done,Expand[answer],x],
  1091.           Expand[f done] ]
  1092.     ]/;
  1093.     Apply[Or,Not[FreeQ[f,#]]&/@ListElem] && Not[FreeQ[f,x]]
  1094.  
  1095.  FindGfunction[ done_,f_,x_] := Expand[f done]
  1096.  
  1097.  FindGfunction1[ done_,f_Plus,x_] := Map[FindGfunction1[done,#,x]&,f]
  1098.  
  1099.  FindGfunction1[done_,MeijerG[par1__] MeijerG[par2__] f_.,x_] :=
  1100.     FindGfunction1[done MeijerG[par1] MeijerG[par2],f,x]
  1101.  
  1102.  FindGfunction1[done_,MeijerG[par__]^2 f_.,x_] :=
  1103.     FindGfunction1[done MeijerG[par]^2,f,x]
  1104.  
  1105.  FindGfunction1[done_,MeijerG[par__] f_.,x_] :=
  1106.     FindGfunction1[done MeijerG[par],f,x]
  1107.  
  1108.  FindGfunction1[done_,Sign[par_] f_.,x_] :=
  1109.     FindGfunction1[done Sign[par],f,x]
  1110.  
  1111.  FindGfunction1[done_,f_,x_] := f FailInt/;Not[FreeQ[f,MeijerG]]
  1112.  
  1113.  FindGfunction1[done_,c_. f_,x_] := 
  1114.     c FindGfunction[done,f,x]/;Not[FreeQ[f,x]] && FreeQ[c,x]
  1115.  
  1116.  FindGfunction1[done_,f_,x_] := Expand[f done] 
  1117.  
  1118. (*****************************************************************************
  1119. *                     Convergent
  1120. *
  1121. *****************************************************************************)
  1122.  
  1123.  Convergent[ b_. f_[a_.x_^r_. + c_.],{x_,xmin_,Infinity} ] := 
  1124.    If[ NumberQ[r] && Re[r]<=1, False, True ] /;
  1125.  (f===Sin || f===Cos) && FreeQ[{a,b,r,c},x]
  1126.  
  1127.  Convergent[ f_,{x_,xmin_/;xmin=!=0,Infinity} ] :=
  1128.   Module[ 
  1129.    {answer =
  1130.      Module[ {test},
  1131.        Off[General::indet,Infinity::indet,Power::infy,General::dbyz];
  1132.        test = {PowerExpand[x f//.{
  1133.           a_ + b_. x^n_. :> b x^n /; Re[n]>0 && FreeQ[{a,b},x],
  1134.           a_. x^n1_. + b_. x^n2_. :> b x^Max[n1,n2] /; Im[n1]==0 &&
  1135.           Im[n2]==0 && FreeQ[{a,b},x] }
  1136.               ]/.x->Infinity, f/.x->Infinity};    
  1137.        On[General::indet,Infinity::indet,Power::infy,General::dbyz]; 
  1138.        test
  1139.      ]},
  1140.     If[ FreeQ[x f,x] || 
  1141.         answer[[1]] === DirectedInfinity[-1] ||
  1142.         answer[[1]] === DirectedInfinity[1]  ||
  1143.         answer[[2]] === RealInterval[{-Infinity, Infinity}] ||
  1144.         (FreeQ[answer[[1]],x] && answer[[1]]=!=0 && answer[[2]]=!=0 && 
  1145.          And@@(FreeQ[answer,#]&/@{ComplexInfinity,Indeterminate,
  1146.                             DirectedInfinity,RealInterval})),        
  1147.         False,
  1148.         True
  1149.       ]
  1150.    ] /; FreeQ[xmin,DirectedInfinity]
  1151.  
  1152.  Convergent[ f_,{x_,0,xmax_/;FreeQ[xmax,DirectedInfinity]} ] :=
  1153.    Module[ {z},
  1154.     Convergent[Together[PowerExpand[f/.x->1/z]/z^2],{z,1/xmax,Infinity}]
  1155.    ]
  1156.  
  1157.  Convergent[ f_,{x_,0,Infinity} ] :=
  1158.    Convergent[f,{x,0,1}] && Convergent[f,{x,1,Infinity}]
  1159.  
  1160.  Convergent[ f_,{x_,xmin_,xmax_} ] := True       
  1161.  
  1162. (*****************************************************************************
  1163. *                     Supplement
  1164. *
  1165. *****************************************************************************)
  1166.  FreeQLaplace[ f_ ] :=
  1167.    If[ Names["LaplaceTransform"] =!= {}, 
  1168.        FreeQ[f, ToExpression["LaplaceTransform"]],
  1169.        True
  1170.      ]
  1171.  
  1172.  LogarithmCase[ {___,v_,___,u_,___} ] := True /;
  1173.     IntegerQ[Expand[u-v]]
  1174.  
  1175.  LogarithmCase[ {___} ] := False
  1176.   
  1177.  Delta[k_,x_] :=
  1178.   Expand[Flatten[ Map[ Table[ (#+i)/Floor[k],{i,0,Floor[k]-1} ] &, x ]]] /;
  1179.  NumberQ[k] && NonNegative[k] && (k-Floor[k])==0
  1180.   
  1181.  Delta[k_,x_] := {}
  1182.  
  1183.  ReducePar[{w1___,u_,w2___},{w3___,v_,w4___}] :=
  1184.       ReducePar[{w1,w2},{w3,w4}]/;u===v
  1185.  
  1186.  ReducePar[w1_,w2_] := {w1,w2}
  1187.  
  1188.  MultGamma[a_] :=
  1189.   Apply[ Times, Map[ Gamma, Expand[a] ] ]
  1190.  
  1191.  MultPochham[a_,k_] :=
  1192.   Apply[ Times, Map[ Pochhammer[ #,k] &, a] ]
  1193.  
  1194.  Znak[n_ a_] := True/;NumberQ[n] && Im[n]===0 && n<0
  1195.  
  1196.  Znak[Complex[0,n_] a_.] := True/;n<0
  1197.  
  1198.  Znak[n_] := True/;NumberQ[n] && Im[n]===0 &&n<0
  1199.  
  1200.  Znak[a_] := False
  1201.  
  1202.  SimpPower[f_Plus] := Map[ SimpPower[#]&,f ]
  1203.  
  1204.  SimpPower[f_Times] := Map[ SimpPower[#]&,f]
  1205.  
  1206.  SimpPower[Power[v_ u_,c_]] := SimpPower[v^c] SimpPower[u^c]
  1207.  
  1208.  SimpPower[Log[f_]] := Log[SimpPower[f]]
  1209.  
  1210.  SimpPower[Power[n_Integer,v_]] := n^Expand[v]
  1211.  
  1212.  SimpPower[Power[a_,v_+u_]] := SimpPower[a^v] SimpPower[a^u]
  1213.  
  1214.  SimpPower[Power[v_Plus,c_]] := 
  1215.    Module[ {w},
  1216.      w = Factor[v];     
  1217.      If[ w=!=v, SimpPower[w^c], Map[ SimpPower[#]&,v ]^c]
  1218.    ]/;Length[v]>2
  1219.  
  1220.  SimpPower[Power[v_Plus,c_]] := 
  1221.    Module[ {w},
  1222.      w = Together[v];     
  1223.      If[ w=!=v, SimpPower[w^c], Map[ SimpPower[#]&,v ]^c ]
  1224.    ]
  1225.  
  1226.  SimpPower[ Power[a_Rational,Times[b_Rational,f_]] ] :=
  1227.        (Numerator[a]^b)^f (Denominator[a]^Abs[b])^(-f Sign[b])
  1228.  
  1229.  SimpPower[ Power[Power[a_,n_Integer],m_Rational] ] :=
  1230.      If[positive[a],a^(n m),Abs[a]^(n m)]/;  
  1231.  EvenQ[n] && EvenQ[Denominator[m]]
  1232.  
  1233.  SimpPower[ Power[Power[a_,n_Integer],Times[m_Rational,b_]] ] :=
  1234.      If[positive[a],a^Expand[n m b],Abs[a]^Expand[n m b]]/;  
  1235.  EvenQ[n] && EvenQ[Denominator[m]]
  1236.  
  1237.  SimpPower[ Power[Power[E,u_],n_] ] := E^(u n)/;NumberQ[n]
  1238.  
  1239.  SimpPower[Power[4, Rational[1, 4]]] := 2^(1/2)
  1240.  
  1241.  SimpPower[Power[4, Rational[-1, 4]]] := 2^(-1/2)
  1242.  
  1243.  SimpPower[ f_] := f
  1244.  
  1245.  SimpIncompleteGamma[ expr_,args_/;Length[args] >1 ] :=
  1246.     Module[ {el,min,var},
  1247.       el = Union[ args/.n_. + v_. :> v/;NumberQ[n] ];
  1248.       If[ Length[el] >1, FailInt, 
  1249.           argn = args/.el[[1]]->var;
  1250.           min =  Min[argn/.n_. + v_. var :> n/;NumberQ[n]];
  1251.           SimpGamma[ (expr/.el[[1]]->var)//.Gamma[k_. + v_. var,n_,m_] :>
  1252.           (k+v var-1) Gamma[k+v var-1,n,m] - m^(k+v var-1) E^(-m)/;
  1253.           NumberQ[k] && k>min ]/.var->el[[1]] ]
  1254.      ]
  1255.  
  1256.  SimpIncompleteGamma[ expr_,args_ ] := FailInt
  1257.  
  1258.  SimpIncompleteGamma1[ expr_,{arg1_,arg___} ] :=
  1259.     Module[ {r,rnew},
  1260.       rnew = 
  1261.       Factor[Plus@@((r=Cases[expr,a_. arg1])/.a_. arg1 :> a)] arg1; 
  1262.       SimpIncompleteGamma1[ (expr - Plus@@r)+rnew,{arg} ]
  1263.     ]
  1264.  
  1265.  SimpIncompleteGamma1[ expr_, {___} ] := expr
  1266.  
  1267.  SimpGamma[ expr_Plus/;Not[FreeQ[expr,Gamma[u__]/;Length[{u}]>1]] ] :=
  1268.     Module[ {answer,r},
  1269.       answer = SimpIncompleteGamma[expr,
  1270.       Union[(r = Cases[ expr,a_. Gamma[u_,n_,m_] ])/.
  1271.             b_ Gamma[v_,n_,m_] :> v] ];
  1272.       If[ Not[FreeQ[answer,FailInt]], 
  1273.           answer = SimpIncompleteGamma1[expr,
  1274.             Union[r/.b_ Gamma[v_,n_,m_] :> Gamma[v,n,m]] ]
  1275.         ];
  1276.       answer /; FreeQ[answer,FailInt]
  1277.     ]
  1278.  
  1279.  SimpGamma[f_Plus] := Map[ SimpGamma[#]&,f ]
  1280.  
  1281.  SimpGamma[ expr_/;Length[expr]>1 ] :=
  1282.    Module[ {p},
  1283.      ( expr/.Gamma[_]:>1) *
  1284.        SimpGamma1[ (Times@@Cases[p expr,Gamma[a_]^n_.])/.
  1285.                    Gamma[r_]:>Gamma[Expand[r]] ] 
  1286.    ]
  1287.  
  1288.  SimpGamma1[ Times[v1___,Gamma[w1_]^n_.,v2___,Gamma[w2_]^m_.] ] := 
  1289.      If[ (w2-w1)>0,
  1290.            SimpGamma1[v1 v2 ]/Factor[Pochhammer[w1,w2-w1]^n],
  1291.            Factor[Pochhammer[w2,w1-w2]^n] SimpGamma1[v1 v2 ]
  1292.        ] /; IntegerQ[w2-w1] && IntegerQ[n] && n>0 && n+m == 0
  1293.  
  1294.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,Gamma[v_]^m_.]] := 
  1295.      If[ SameQ[Expand[v/2-u+1/2],0],
  1296.          (2^Expand[v-1] Pi^(-1/2))^Sign[m] *
  1297.          SimpGamma1[ Gamma[u]^(n+Sign[m])*
  1298.                      Gamma[v]^(m-Sign[m]) v1 v2 *
  1299.                      Gamma[Expand[u-1/2]]^Sign[m] ],
  1300.          (2^Expand[u-1] Pi^(-1/2))^Sign[n] *
  1301.          SimpGamma1[ Gamma[u]^(n-Sign[n])*
  1302.                      Gamma[v]^(m+Sign[n]) v1 v2 *
  1303.                      Gamma[Expand[v-1/2]]^Sign[n] ]
  1304.       ]/;
  1305.   (Expand[u/2-v+1/2]===0 || Expand[v/2-u+1/2]===0) && m n < 0 
  1306.  
  1307.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,Gamma[v_]^m_.]] := 
  1308.      If[ SameQ[Expand[v/2-u],0],
  1309.          (2^Expand[v-1] Pi^(-1/2))^Sign[m] *
  1310.          SimpGamma1[ Gamma[u]^(n+Sign[m])*
  1311.                      Gamma[v]^(m-Sign[m]) v1 v2 *
  1312.                      Gamma[Expand[u+1/2]]^Sign[m] ],
  1313.          (2^Expand[u-1] Pi^(-1/2))^Sign[n] *
  1314.          SimpGamma1[ Gamma[u]^(n-Sign[n])*
  1315.                      Gamma[v]^(m+Sign[n]) v1 v2 *
  1316.                      Gamma[Expand[v+1/2]]^Sign[n] ]
  1317.       ]/;
  1318.   (Expand[u/2-v]===0 || Expand[v/2-u]===0) && m n < 0 
  1319.  
  1320.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,Gamma[v_]^m_.]] := 
  1321.      If[ SameQ[Expand[v-u],1/2],(2^Expand[1-2 u] Pi^(1/2))^Sign[m] *
  1322.          SimpGamma1[ Gamma[u]^(n-Sign[m])*
  1323.                      Gamma[v]^(m-Sign[m]) v1 v2 *
  1324.                      Gamma[Expand[2 u]]^Sign[m] ],
  1325.          (2^Expand[1-2 v] Pi^(1/2))^Sign[n] *
  1326.          SimpGamma1[ Gamma[u]^(n-Sign[n])*
  1327.                      Gamma[v]^(m-Sign[n]) v1 v2 *
  1328.                      Gamma[Expand[2 v]]^Sign[n] ]
  1329.       ]/;
  1330.   Abs[Expand[u-v]]===1/2 && m n > 0
  1331.  
  1332.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,Gamma[v_]^m_.]] := 
  1333.      SimpGamma1[ v1 v2 Gamma[u]^(n-Sign[n]) Gamma[v]^(m-Sign[m]) ] *
  1334.      (Pi/Sin[Expand[Pi u]])^Sign[n] /;
  1335.    Expand[u+v]===1 && m n > 0
  1336.  
  1337.  SimpGamma1[Times[v1___,Gamma[1+u_]^n_.,v2___,Gamma[1+v_]^m_.]] := 
  1338.     u^Sign[n] (Pi/(Sin[Expand[Pi u]]/.TrigRule))^Sign[n]*
  1339.     SimpGamma1[ v1 v2 Gamma[1+u]^(n-Sign[n]) Gamma[1+v]^(m-Sign[m]) ] /;
  1340.    Expand[u+v]===0 && m n > 0
  1341.  
  1342.  SimpGamma1[Times[v1___,Gamma[u_]^n_.,v2___,w_^m_.]] := 
  1343.     Module[ {p},
  1344.        SimpGamma1[v1 v2 Gamma[u+1]^(Sign[n] (p=Min[Abs[m],Abs[n]])) *
  1345.               Gamma[u]^(n-Sign[n] p) u^(n-Sign[n] p) ]
  1346.     ]/;Not[NumberQ[u]] && w===u && m n>0
  1347.  
  1348.  SimpGamma1[v_] := v
  1349.  
  1350.  SimpGamma[v__] := v
  1351.  
  1352.  SimpCond[ v_^n_ >= 1 ] := v^(-n)<=1/;Im[n]==0 &&n<0
  1353.  
  1354.  SimpCond[ v_^n_ > 1 ] := v^(-n)<1/;Im[n]==0 &&n<0
  1355.  
  1356.  SimpCond[ Abs[v_^n_ u_^m_] > 1 ]  := Abs[v u] >1/;n-m==0 && Im[n]==0 &&n>0
  1357.  
  1358.  SimpCond[ Abs[v_^n_ u_^m_] > 1 ]  := Abs[v/u] >1/;n+m==0 && Im[n]==0 &&n>0
  1359.  
  1360.  SimpCond[ Abs[v_^n_ u_^m_] >= 1 ] := Abs[v u]>=1/;n-m==0 && Im[n]==0 &&n>0
  1361.  
  1362.  SimpCond[ Abs[v_^n_ u_^m_] >= 1 ] := Abs[v/u]>=1/;n+m==0 && Im[n]==0 &&n>0
  1363.  
  1364.  SimpCond[ Abs[v_^n_ u_^m_] == 1 ] := Abs[v u]==1/;n-m==0 && Im[n]==0 &&n>0
  1365.  
  1366.  SimpCond[ Abs[v_^n_ u_^m_] == 1 ] := Abs[v/u]==1/;n+m==0 && Im[n]==0 &&n>0
  1367.  
  1368.  SimpCond[v_] := v
  1369.  
  1370.  CondTrig[f_,x_] := Apply[ And,Map[ TrigMon[#,x]&,Cases[f,z_]]]
  1371.  
  1372.  TrigMon[u_. Sin[c_. x_^n_.],x_] := True/;PolynomialQ[Expand[u],x]
  1373.  
  1374.  TrigMon[u_. Cos[c_. x_^n_.],x_] := True/;PolynomialQ[Expand[u],x]
  1375.  
  1376.  TrigMon[u_,x_] := True/;PolynomialQ[Expand[u],x]
  1377.  
  1378.  CollectSC[v_] :=
  1379.     Fold[ Collect[#1,#2[[2]]]&,
  1380.           v,
  1381.           Cases[Apply[Plus,
  1382.             Cases[v,Sin[_] | Cos[_],2]],a_ b_] ]
  1383.  ColTerm = {
  1384.   Sin[a_] :> Sin[Simplify[a]],
  1385.   Cos[a_] :> Cos[Simplify[a]]
  1386.        }
  1387.  CondTrigDegree[Sin[a_. x_^n_.],x_] := {n,True}/;FreeQ[a,x]
  1388.  
  1389.  CondTrigDegree[Cos[a_. x_^n_.],x_] := {n,True}/;FreeQ[a,x]
  1390.  
  1391.  CondTrigDegree[f_Plus,x_] := CondTrigDegree1[
  1392.      Cases[ Cases[f,Sin[_] | Cos[_],2],a_. x^_.,2 ],x]
  1393.  
  1394.  CondTrigDegree[f_,x_] := CondTrigDegree1[
  1395.      Cases[ Cases[f,Sin[_] | Cos[_]],a_. x^_.,2],x]
  1396.  
  1397.  CondTrigDegree1[{u_. x_^n_.},x_] := {n,True}/;FreeQ[u,x] 
  1398.  
  1399.  CondTrigDegree1[{___,u_. x_^n_.,___,v_. x_^m_.,___},x_] :=
  1400.      {n,True} /; n===m && FreeQ[u,x] && FreeQ[v,x]
  1401.  
  1402.  ComMult[b_ f_,x_] := b ComMult[f,x]/;FreeQ[b,x]
  1403.  
  1404.  ComMult[f_,x_] := 1
  1405.  
  1406.  ComPlus[b_ + f_,x_] := b + ComPlus[f,x]/;FreeQ[b,x]
  1407.  
  1408.  ComPlus[f_,x_] := 0
  1409.  
  1410.  positiveList[(n_)*(v_)] := positiveList[v] /; NumberQ[n] && Positive[n]
  1411.  
  1412.  positiveList[(n_)*(v_Symbol)] := (positive[n v] = True) /; 
  1413.  NumberQ[n] && Negative[n]
  1414.  
  1415.  positiveList[v_Times] := (positiveList[v[[1]]]; positiveList[Rest[v]])
  1416.  
  1417.  positiveList[v_^n_] := positiveList[v^(-n)] /;NumberQ[n]&&n<0
  1418.  
  1419.  positiveList[v_] := (positive[v] = True)
  1420.  
  1421.  SimpLog = {
  1422.  Log[Abs[a_]] :> Log[a],
  1423.  Log[a_ b_]   :> Log[a] + Log[b],
  1424.  Log[a_Plus]  :> Log[Together[a]],
  1425.  Log[a_Rational] :> -Log[1/a]/;Numerator[a]==1 
  1426.      }
  1427.  
  1428.  SimpGfunction = {
  1429.    MeijerG[{0},{},{0},{0,1/2},{a_,z_}] :> Cos[2 Sqrt[z]]/Sqrt[Pi],
  1430.    MeijerG[{1/2},{},{1/2},{1/2,0},{a_,z_}] :> 
  1431.                   Sin[2 Sqrt[z]]/Sqrt[Pi] 
  1432.    }
  1433.  
  1434.  TransfAnswer[v_. If[c_,t_,f_]] := 
  1435.    Apply[ If,{SimpCond[c/.arg[e_] :> Arg[e]], TransfAnswer[v t],
  1436.        If[ f===Infinity,Infinity,v f/.arg[e_] :> Arg[e]
  1437.          ] }]
  1438.  
  1439.  TransfAnswer[ v_ ] := 
  1440.   Module[ {answer = v},
  1441.     If[ !FreeQ[v,HypergeometricU],
  1442.        answer = (v/.arg[k_?Positive]:>0)//.HypergeometricURule ];
  1443.     answer = answer/.{arg[e_] :> Arg[e]};
  1444.     answer = PowerExpandMy[Expand[answer//.LogTrig]/.SimpSign//.SimpSign1];
  1445.     answer = 
  1446.     If[ Not[FreeQ[v,PolyGamma]], SimpPolyGamma[answer]//.SimpTrigSum,
  1447.                                  answer];
  1448.     answer = 
  1449.     If[ Not[FreeQ[v,Gamma]], SimpGamma[answer],answer];
  1450.     answer = 
  1451.     If[ Not[FreeQ[v,Hypergeometric2F1]], answer/.SimpGaussSum,answer];
  1452.     answer =
  1453.     If[ Not[FreeQ[answer,Arg]],PowerExpand[SimpPower[answer]]//.{
  1454.               Arg[s_] :> Pi/;Znak[s],
  1455.               Arg[s_] :> 0/;Not[Znak[s]]},answer]; 
  1456.     If[ !FreeQ[answer,SinIntegral],
  1457.          answer = answer/.
  1458.           {SinIntegral[w_. Abs[q_]] :> Sign[q] SinIntegral[w q]}];
  1459.     answer = 
  1460.     (Expand[PowerExpand[SimpPower[answer//.SimpLog]]/.LogTrig//.SimpSign1]/.{
  1461.      Sign[u_] Abs[w_]^(-1) :> 1/(w (-1)^If[w===u,0,1])/;w-u===0 || w+u===0,
  1462.      E^(w1_+ w2_) :> E^w1 E^w2})/.{
  1463.      Abs[u1_]^n_. Abs[u2_]^m_. :> If[Expand[u1+u2]===0,u1^(2 n),
  1464.                       Abs[Expand[u1 u2]]^n]/;n===m};
  1465.     Clear[positive];
  1466.     If[ !FreeQ[answer,Log],answer = SimpLogFun[answer] ];
  1467.     answer = 
  1468.     If[ Head[answer]===Plus && Depth[answer]<8 && Length[answer]<6 &&
  1469.         FreeQ[answer,Complex],
  1470.         Factor[answer]/.SimpSign2/.{
  1471.         Sign[u_] u_^n_. :> Abs[u] u^(n-1)/;OddQ[n] && n>0 },answer];
  1472.     If[ Not[FreeQ[answer,PolyGamma]], answer//.SimpPolyGammaSum,answer]
  1473.    ]/;FreeQ[v,HypergeometricPFQ]
  1474.  
  1475.  TransfAnswer[ v_ ] := ( Clear[positive]; v//.{
  1476.                          arg[e_] :> Arg[e],
  1477.                          Arg[s_] :> Pi/;Znak[s],
  1478.                          Arg[s_] :> 0/;Not[Znak[s]]}//.SimpLog )
  1479.  
  1480.  SimpLogFun[ expr_Plus ] :=
  1481.    Module[ {exprN = Expand[expr],list,div,pos = {},i=0 },
  1482.      list = Union[Cases[exprN,w_. Log[n_Integer]/;FreeQ[w,Log]]/.
  1483.                       w_. Log[n_] :> n];
  1484.      div = GCD@@list;
  1485.      If[ Length[list]>1 && div!=1, 
  1486.          list = Complement[list,{div}];
  1487.          SimpLogFun[exprN//.BuildRule[
  1488.          Log[#]&/@list ,Log[div]+Log[#]&/@(list/div) ]],
  1489.          If[ Length[list]==1 || Length[list]==2,
  1490.              expr,
  1491.              While[Length[pos]==0 && Length[list]>1, 
  1492.               i = i+ 1;
  1493.               listN = {list[[1]],#}&/@Rest[list];
  1494.               list = Rest[list];
  1495.               pos = Position[ (GCD@@#)&/@listN,a_/; a != 1 ]
  1496.              ];
  1497.              If[ Length[pos]!=0,
  1498.                  list = Take[listN,pos[[1]]][[1]];
  1499.                  div = GCD@@list; 
  1500.                  SimpLogFun[exprN//.BuildRule[Log[#]&/@list ,      
  1501.                          Log[div]+Log[#]&/@(list/div) ]],
  1502.                  expr
  1503.                ]
  1504.            ]
  1505.        ]
  1506.    ] /; !FreeQ[expr,Log]   
  1507.  
  1508.  SimpLogFun[ expr_ ] := expr
  1509.  
  1510.  BuildRule[{l_,lR___},{r_,rR___}] :=
  1511.   Join[{l :> r},BuildRule[{lR},{rR}]]
  1512.  
  1513.  BuildRule[{},{}] := {}
  1514.  
  1515.  SimpTrigSum = {
  1516.   a_. Tan[x_] + b_. Cot[x_] +c_.:> c + 2 a Csc[2 x]/;a===b,
  1517.   a_. Tanh[x_] + n_?Negative b_. Coth[x_] +c_.:> c-2 a Csch[2 x]/;
  1518.       a+b n===0&&Not[Znak[a]],
  1519.   n_?Negative a_. Tanh[x_] + b_. Coth[x_] +c_.:> c+2 a Csch[2 x]/;
  1520.       a n+b===0&&Not[Znak[b]]
  1521.   }
  1522.  
  1523.  SimpPolyGamma[ expr_ ] :=
  1524.    Module[ {exprP,listP,exprRest},
  1525.     exprP = Cases[ expr,w_/;Not[FreeQ[w,PolyGamma]] ];
  1526.     listP = Union[ exprP/.
  1527.        {a_ PolyGamma[n_,w_] :> PolyGamma[n,w]/;FreeQ[a,PolyGamma]}];
  1528.     exprP = 
  1529.      Plus@@(Factor[Plus@@Cases[exprP,a_. #]]&/@listP) +
  1530.      If[ Length[exprRest = expr - Plus@@exprP] < 7,
  1531.         Factor[ exprRest ],
  1532.         exprRest ];
  1533.     exprP//.SimpPolyGammaSum/.PolyGammaRule
  1534.    ]
  1535.