home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / ALGEBRA.PAK / SYMBOLIC.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  53.5 KB  |  1,503 lines
  1.  
  2. (* Copyright 1991 Wolfram Research Inc.*)
  3.  
  4. (*:Version: Mathematica 2.0 *)
  5.  
  6. (*:Name: Algebra`SymbolicSum` *)
  7.  
  8. (*:Author:
  9.     Victor S. Adamchik, February 1991.
  10. *)
  11.  
  12. (*:Keywords:
  13.     InfiniteSum, FiniteSum, Product
  14. *)
  15.  
  16. (*:Requirements: none. *)
  17.  
  18. (*:Limitations:
  19.     This package can evaluate symbolic sums of the following type
  20.                Sum[ a[k],{k,min,max} ] ,
  21.         where
  22.         a[k+1]/a[k] is a rational function.
  23. *)
  24.  
  25.  BeginPackage["Algebra`SymbolicSum`"]
  26.  
  27.  SymbolicSum::usage = "SymbolicSum[f, {i, imin, imax}] attempts
  28. to find the value of Sum[f, {i, imin, imax} ] for symbolic
  29. imin,imax. SymbolicSum[f, {i, imax}] evaluates the sum of f
  30. with i running from 1 to imax."
  31.  
  32.  Begin["`Private`"]
  33.  
  34. (*========================================================================*)
  35.  
  36.  Unprotect[ Sum,SymbolicSum,Product ]
  37.  
  38.  trig = offHyper = True
  39.  
  40.  Sum[ expr_,{k_Symbol,max_} ] := Sum[expr,{k,1,max}]/;Not[NumberQ[max]]
  41.  
  42.  Sum[ expr_,{k_Symbol,min_,max_} ] :=
  43.    Module[ {answer,inter=FailSum,p},
  44.     answer = SymbolicSumD[expr//.{
  45.             a_^(b_. k) :> (a^b)^k/;FreeQ[{a,b},k],
  46.             a_^k b_^k :> (a b)^k/;FreeQ[{a,b},k]}/.{
  47.         (- a_)^b_ :> (-1)^b a^b /; a=!=1 },{k,min,max}];
  48.     If[ !FreeQ[answer,Donor],
  49.         While[ !FreeQ[inter,FailSum],
  50.           inter =  
  51.           Block[ {FiniteSum},
  52.                  Reduction[SumFloor[ expr,{k,min,max},
  53.                      Cases[p answer,w_/;Not[FreeQ[w,Donor]]][[1]]/.
  54.                      a_. Donor[x_,y_] :> x], FiniteSum]
  55.                ];
  56.           answer = If[ Length[answer[[2]]] == 0,
  57.                        Donor[True,{}],
  58.                        Donor[answer[[2,1]],Complement[Rest[answer[[2]]]]]];
  59.           inter
  60.         ];
  61.         answer = inter,
  62.         answer ];
  63.     (answer//.complex) /; FreeQ[answer,FailSum] 
  64.    ]/;
  65.  FreeQ[min,Floor] && Not[FreeQ[max,Floor]] 
  66.  
  67.  Sum[ expr_, {k_Symbol,min_,max_} ] := 
  68.    Module[ {answer},
  69.      answer = SymbolicSumD[Expand[expr//.{
  70.             a_^(b_. k) :> (a^b)^k/;FreeQ[{a,b},k],
  71.             a_^k b_^k :> (a b)^k/;FreeQ[{a,b},k]}/.{
  72.         (- a_)^b_ :> (-1)^b a^b /; a=!=1 }],{k,min,max}];
  73.      If[ FreeQ[{max,min}, DirectedInfinity],
  74.          Factor[answer],
  75.      answer ]/; And@@(FreeQ[answer,#]&/@{FailSum,Donor})
  76.    ]/;FreeQ[{min,max}, Complex] &&(!NumberQ[max] || !NumberQ[min])
  77.    
  78. (*========================================================================*)
  79.  
  80.  SymbolicSum[ expr_,{k_Symbol,max_} ] := 
  81.    SymbolicSum[expr,{k,1,max}]/;Not[NumberQ[N[max]]]
  82.  
  83.  SymbolicSum[ expr_,{k_Symbol,min_,max_} ] :=
  84.    Module[ {answer,inter=FailSum,p},
  85.     answer = SymbolicSumD[expr//.{
  86.             a_^(b_. k) :> (a^b)^k/;FreeQ[{a,b},k],
  87.             a_^k b_^k :> (a b)^k/;FreeQ[{a,b},k]}/.{
  88.         (- a_)^b_ :> (-1)^b a^b /; a=!=1 },{k,min,max}];
  89.     If[ !FreeQ[answer,Donor],
  90.         While[ !FreeQ[inter,FailSum],
  91.           inter =  
  92.           Block[ {FiniteSum},
  93.                  Reduction[SumFloor[ expr,{k,min,max},
  94.                      Cases[p answer,w_/;Not[FreeQ[w,Donor]]][[1]]/.
  95.                      a_. Donor[x_,y_] :> x], FiniteSum]
  96.                ];
  97.           answer = If[ Length[answer[[2]]] == 0,
  98.                        Donor[True,{}],
  99.                        Donor[answer[[2,1]],Complement[Rest[answer[[2]]]]]];
  100.           inter
  101.         ];
  102.         answer = inter,
  103.         answer ];
  104.     (answer//.complex) /; FreeQ[answer,FailSum] 
  105.    ]/;
  106.  FreeQ[min,Floor] && Not[FreeQ[max,Floor]] 
  107.  
  108.  SymbolicSum[ expr_, {k_Symbol,min_,max_} ] := 
  109.    Module[ {answer},
  110.      answer = SymbolicSumD[Expand[expr//.{
  111.             a_^(b_. k) :> (a^b)^k/;FreeQ[{a,b},k],
  112.             a_^k b_^k :> (a b)^k/;FreeQ[{a,b},k]}/.{
  113.         (- a_)^b_ :> (-1)^b a^b /; a=!=1 }],{k,min,max}];
  114.      If[ FreeQ[{max,min}, DirectedInfinity],
  115.          Factor[answer],
  116.      answer ]/; And@@(FreeQ[answer,#]&/@{FailSum,Donor})
  117.    ] /; FreeQ[{min,max}, Complex] &&(!NumberQ[max] || !NumberQ[min]) 
  118.  
  119.  
  120. (*========================================================================*)
  121.  
  122. (*========================================================================*)
  123.  
  124.  Product[ expr_,{k_Symbol,max_} ] := 
  125.       Product[expr,{k,1,max}] /; Not[NumberQ[N[max]]]
  126.  
  127.  Product[ expr_, {k_Symbol,min_,max_} ] := 
  128.    Module[ {answer,r},
  129.      Flag1 = Flag2 = Flag3 = True;
  130.      answer = SymbolicProduct[expr,{k,min,max}];
  131.      If[ !FreeQ[answer,FailSum],
  132.          If[ !SameQ[r = Factor[expr]/.
  133.         { c_. k^2+a_. k+b_ :> c PowerExpand[
  134.                   (k+(a/c+Sqrt[a^2/c^2-4b/c])/2) *
  135.                   (k+(a/c-Sqrt[a^2/c^2-4b/c])/2),{k}] /;
  136.                   FreeQ[{a,b,c},k] 
  137.         },expr],
  138.              answer = SymbolicProduct[r ,{k,min,max}]
  139.            ]
  140.        ];
  141.      If[ !FreeQ[answer,FailSum],
  142.          If[ !SameQ[r = Together[expr],expr],
  143.              answer = SymbolicProduct[r ,{k,min,max}]
  144.            ]
  145.        ];
  146.      If[ !FreeQ[answer,Product],
  147.          TransfAnswerForProduct[answer/.
  148.            Product[f_,{p_,minp_,maxp_}] :>
  149.            Product[f/.p->k,{k,minp,maxp}]],
  150.          TransfAnswerForProduct[answer] 
  151.        ] /; FreeQ[answer,FailSum]
  152.    ]/;FreeQ[{min,max},Null] && (Not[NumberQ[N[max]]] || Not[NumberQ[N[min]]])
  153.  
  154. (*========================================================================*)
  155.  
  156.  SymbolicSumD[ expr_,{k_,min_Integer,max_Integer} ] := 
  157.    Sum[expr,{k,min,max}] 
  158.  
  159.  SymbolicSumD[ expr_,{k_,DirectedInfinity[-1],max_/;max=!=Infinity} ] :=
  160.    Module[ {var},
  161.      SymbolicSumD[ expr/.k->-var,{var,-max,Infinity} ] 
  162.    ] 
  163.  
  164.  SymbolicSumD[ expr_,{k_,min_,max_} ] := 0/; Not[NumberQ[N[min]]] &&
  165.  Not[NumberQ[N[max]]] && max=!=Infinity && ZnakSum[max-min] 
  166.  
  167.  SymbolicSumD[ const_ expr_,{k_,min_,max_} ] := 
  168.    const SymbolicSumD[expr,{k,min,max}] /;
  169.  FreeQ[const,k]
  170.  
  171.  SymbolicSumD[ expr1_ + expr2_,{arg__} ] := 
  172.    Module[ { answer },
  173.      answer = SymbolicSumD[expr1,{arg}];
  174.      If[ !FreeQ[answer,FailSum] || !FreeQ[answer,DirectedInfinity],
  175.      answer = FailSum,
  176.      answer += SymbolicSumD[expr2,{arg}];
  177.      If[ !FreeQ[answer,FailSum] || !FreeQ[answer,DirectedInfinity],
  178.          FailSum,
  179.          TransfAnswer[ answer ] 
  180.     ]
  181.      ]
  182.   ]
  183.  
  184.  SymbolicSumD[ q_^(c_. (a1_+a2_)) expr_.,{k_,min_,max_} ] := 
  185.    q^(c a1) SymbolicSumD[(q^c)^a2 expr/.
  186.             (-1)^(n_?EvenQ s_) :> 1,{k,min,max}]/;
  187.    FreeQ[{q,a1,c},k]
  188.  
  189.  SymbolicSumD[ (-1)^(n_?Negative s_) expr_,{k_,min_,max_} ] := 
  190.    SymbolicSumD[ Times@@{(-1)^(-n s),expr},{k,min,max} ]
  191.  
  192.  SymbolicSumD[ expr_,{k_,min_,Infinity} ] := 
  193.    Module[ {p,answer},
  194.      answer = SymbolicSumD[(expr/.k->(p+min))/.{Plus->ExpandPlus}/.
  195.                  {a_^b_ :> a^Expand[b]},{p,0,Infinity}];
  196.      If[ !FreeQ[answer,FailSum],
  197.          SymbolicSumD[expr/.k->(p+min),{p,0,Infinity}],
  198.          answer ]
  199.    ] /;min=!=DirectedInfinity[-1] &&
  200.  (Not[NumberQ[min]] || IntegerQ[min] && Positive[min])
  201.  
  202.  ExpandPlus[ v__ ] := Expand[Plus[v]]
  203.  
  204.  SymbolicSumD[ expr_,{k_,min_Integer,max_} ] := 0 /; ZnakSum[max]
  205.  
  206.  SymbolicSumD[ expr_,{k_,n_Integer?Positive + Floor[p_],m_} ] := 0/;
  207.  Expand[m-p]<=0
  208.  
  209.  SymbolicSumD[ expr_,{k_,n_Integer?Positive + Floor[p_],Floor[m_]} ] := 0/;
  210.  Expand[m-p]<=0
  211.  
  212.  SymbolicSumD[ expr_,{k_,min_,max_} ] :=
  213.    Module[ {p},
  214.      SymbolicSumD[(expr/.k->(p+min))/.{
  215.        q_^w_ :> q^Expand[w],
  216.        Cos[ w_ ] :> Cos[Expand[w]]/;Not[FreeQ[w,k]],
  217.        Sin[ w_ ] :> Sin[Expand[w]]/;Not[FreeQ[w,k]]
  218.       }/.Plus->ExpandPlus,{p,0,max-min}]
  219.    ]/; FreeQ[{min,max},Floor] && max=!=Infinity &&
  220.  !NumberQ[N[min]] && !NumberQ[N[max]]  
  221.  
  222.  SymbolicSumD[ expr_,{k_,min_,max_} ] := 
  223.    Module[ {exprnew},
  224.     exprnew = Expand[expr,Trig->True]/.
  225.      { Cos[ w_ ] :> Cos[Collect[w,k]]/;Not[FreeQ[w,k]],
  226.        Sin[ w_ ] :> Sin[Collect[w,k]]/;Not[FreeQ[w,k]] };
  227.     SymbolicSumDTrig[ exprnew,{k,min,max} ]
  228.   ]/; trig &&
  229.  Or@@(Not[FreeQ[expr,#]]&/@{Sin,Cos})
  230.  
  231.  SymbolicSumD[ expr_,{k_,min_,max_} ] := 
  232.     SymbolicSumD[ Expand[expr//.
  233.      {
  234.       Sinh[w_] :> E^w/2 - E^(-w)/2,
  235.       Cosh[w_] :> E^w/2 + E^(-w)/2
  236.      }], {k,min,max}]/;
  237.  Or@@(Not[FreeQ[expr,#]]&/@{Sinh,Cosh})
  238.  
  239.  SymbolicSumD[ expr_,{k_,min_Integer,DirectedInfinity[1]} ] := 
  240.     GlobInfiniteSum[expr,{k,min,DirectedInfinity[1]}]
  241.  
  242.  SymbolicSumD[ expr_,{k_,DirectedInfinity[-1],DirectedInfinity[1]} ] := 
  243.     GlobInfiniteSum[expr,
  244.               {k,DirectedInfinity[-1],DirectedInfinity[1]}]
  245.  
  246.  SymbolicSumD[ expr_,{k_,min_Integer,max_} ] := 
  247.    Block[ {answer,TransfAnswer},
  248.      answer = FiniteSum[expr,{k,min,max}];
  249.      If[ FreeQ[answer,Donor] && FreeQ[answer,TransfAnswer], 
  250.          TransfAnswer[answer],
  251.          answer ] /; And@@(FreeQ[answer,#]&/@{FailSum,DirectedInfinity})
  252.    ]/;
  253.  Not[IntegerQ[max]] && max=!=Infinity
  254.  
  255.  SymbolicSumD[ expr_,{k_,min_,max_} ] := k FailSum
  256.  
  257. (*========================================================================
  258.  
  259.                  Trigonometric Finite Sum
  260.   
  261.   ========================================================================*)
  262.  
  263.  SymbolicSumDTrig[ const_ expr_,{k_,min_,max_} ] := 
  264.    const SymbolicSumDTrig[expr,{k,min,max}]/;FreeQ[const,k]
  265.  
  266.  SymbolicSumDTrig[ expr_Plus,{k_,min_,max_} ] := 
  267.    SymbolicSumDTrig[#,{k,min,max}]&/@expr
  268.  
  269.  SymbolicSumDTrig[ f_[x_. k_ + a_.],
  270.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  271.    Csc[x/2] Sin[Expand[x (max+1)/2]] f[Expand[x max/2 + a]] + 
  272.    If[Negative[min],1,-1] SumNew[f[x k+a],{k,0,min-1}] /;
  273.  (f===Sin || f===Cos) && FreeQ[{a,x,max},k] && max=!=Infinity 
  274.  
  275.  SymbolicSumDTrig[ (-1)^k_ f_[x_. k_+a_.],
  276.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  277.    Sec[x/2] Sin[Expand[(x+Pi) (max+1)/2]] f[Expand[(x+Pi) max/2] + a] +
  278.    If[Negative[min],1,-1] SumNew[(-1)^k f[x k+a],{k,0,min-1}] /;
  279.  (f===Sin || f===Cos) && FreeQ[{a,x,max},k] && max=!=Infinity 
  280.  
  281.  SymbolicSumDTrig[ Binomial[max_,k_] f_[x_. k_ + a_.],
  282.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  283.    2^max Cos[x/2]^max f[Expand[a+ max x/2]] + 
  284.    If[Negative[min],1,-1] SumNew[Binomial[max,k] f[x k+a],{k,0,min-1}] /;
  285.  (f===Sin || f===Cos) && FreeQ[{a,x,max},k] && max=!=Infinity 
  286.  
  287.  SymbolicSumDTrig[ (-1)^k_ Binomial[max_,k_] f_[x_. k_ + a_.],
  288.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  289.    (-1)^max 2^max Sin[x/2]^max f[Expand[a+ max (Pi+x)/2]] + 
  290.    If[Negative[min],1,-1] *
  291.    SumNew[ (-1)^k Binomial[max,k] f[x k+a],{k,0,min-1}] /;
  292.  (f===Sin || f===Cos) && FreeQ[{a,x,max},k] && max=!=Infinity 
  293.  
  294.  SymbolicSumDTrig[ k_^m_Integer?EvenQ f_[x_. k_ + a_.],
  295.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  296.    Module[ {var},
  297.      (-1)^(m/2) *
  298.      D[ SymbolicSumDTrig[f[var k+a],{k,min,max}], {var,m}]/.var->x
  299.    ] /; Positive[m] 
  300.  
  301.  SymbolicSumDTrig[ (-1)^k_ k_^m_Integer?EvenQ f_[x_. k_ + a_.],
  302.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  303.    Module[ {var},
  304.      (-1)^(m/2) *
  305.      D[SymbolicSumDTrig[(-1)^k f[var k+a],{k,min,max}],{var,m}]/.var->x
  306.    ] /; Positive[m] 
  307.  
  308.  SymbolicSumDTrig[ k_^m_. f_[x_. k_ + a_.],
  309.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  310.    Module[ {var},
  311.      D[ SymbolicSumDTrig[ 
  312.        If[ f===Sin,
  313.          If[ OddQ[Floor[(m-1)/2]],1,-1] Cos[var k+a],
  314.          If[ OddQ[Floor[(m-1)/2]],-1,1] Sin[var k+a] ],
  315.        {k,min,max} ],{var,m} ]/.var->x
  316.    ] /; IntegerQ[m] && OddQ[m] && Positive[m]
  317.  
  318.  SymbolicSumDTrig[ (-1)^k_ k_^m_. f_[x_. k_ + a_.],
  319.                 {k_,min_Integer,max_/;FreeQ[max,Floor]} ] :=
  320.    Module[ {var},
  321.      D[ SymbolicSumDTrig[ 
  322.        If[ f==Sin,
  323.          If[ OddQ[Floor[(m-1)/2]],1,-1] Cos[var k+a] (-1)^k,
  324.          If[ OddQ[Floor[(m-1)/2]],-1,1] Sin[var k+a] (-1)^k ],
  325.        {k,min,max} ],{var,m} ]/.var->x
  326.    ] /; IntegerQ[m] && OddQ[m] && Positive[m]
  327.  
  328.  SymbolicSumDTrig[ expr_,{k_,min_,max_} ] :=  
  329.     SymbolicSumD[expr,{k,min,max}] /; FreeQ[expr,Sin] && FreeQ[expr,Cos]
  330.  
  331.  SymbolicSumDTrig[ expr_,{k_,min_,max_} ] := 
  332.     Module[ { answer },
  333.       trig = False; 
  334.       answer = SymbolicSumD[ Expand[expr//.
  335.        {
  336.          Sin[w_Plus] :> Module[ {const}, const = ComPlus[w,k];
  337.             Sin[w-const] Cos[const] + Cos[w-const] Sin[const] ] /;!FreeQ[w,k],
  338.          Cos[w_Plus] :> Module[ {const}, const = ComPlus[w,k];
  339.             Cos[w-const] Cos[const] - Sin[w-const] Sin[const] ] /;!FreeQ[w,k],
  340.          Sin[w_] :> - I E^(w I)/2 + I E^(-w I)/2 /;!FreeQ[w,k],
  341.          Cos[w_] :> E^(w I)/2 + E^(-w I)/2 /;!FreeQ[w,k]
  342.        }
  343.        ], {k,min,max}];
  344.       trig = True;
  345.       answer
  346.     ]
  347.       
  348.  
  349. (*========================================================================
  350.  
  351.                            Infinite  Sum
  352.   
  353.   ========================================================================*)
  354.  
  355.  GlobInfiniteSum[ expr_,{k_,min_Integer,DirectedInfinity[1]} ] := 
  356.    Block[ {TransfAnswer,answer,p},
  357.      answer = InfiniteSum[(Expand[expr]//.
  358.          { a_^(b_. k+r1_.) c_^(d_. k+r2_.) :> 
  359.             a^r1 c^r2 (a^b c^d)^k/;FreeQ[{a,b,c,d},k],
  360.            Floor[a_Times] :> Floor[Expand[a]],
  361.            Floor[k+n_.] :> k+n /; IntegerQ[n],
  362.            Floor[k+n_Rational] :> k+Floor[n] 
  363.          })/.
  364.            {(n_?Negative a_)^b_ :> (-1)^b (-n a)^b},k,min]; 
  365.      If[ !FreeQ[answer,DirectedInfinity],
  366.          answer,
  367.          If[ !FreeQ[answer,FailSum], 
  368.              answer = InfiniteSum[(Factor[expr]//.
  369.                       { 
  370.             a_^(b_. k+r1_.) c_^(d_. k+r2_.) :> 
  371.             a^r1 c^r2 (a^b c^d)^k/;FreeQ[{a,b,c,d},k]
  372.               })/.{(n_?Negative a_)^b_ :> (-1)^b (-n a)^b
  373.                   },
  374.               k,min]; 
  375.              If[ !FreeQ[answer,FailSum],
  376.                  p FailSum,
  377.                  TransfAnswer[answer/.TransfAnswer[ w_ ] :> w] 
  378.              ],
  379.          TransfAnswer[answer/.TransfAnswer[ w_ ] :> w]
  380.     ]
  381.      ]
  382.   ]
  383.  
  384.  GlobInfiniteSum[ expr_,{k_,DirectedInfinity[-1],DirectedInfinity[1]} ] := 
  385.    Block[ {TransfAnswer,answer,r},
  386.     If[ Expand[expr/.k->-z] === Expand[expr/.k->z],
  387.         answer = 2 GlobInfiniteSum[expr,{k,0,DirectedInfinity[1]}] - 
  388.                  (expr/.k->0),
  389.         answer = 
  390.           SymbolicSumD[expr,{k,0,Infinity}] + 
  391.           SymbolicSumD[expr/.k->-r,{r,1,Infinity}]/.
  392.           {TransfAnswer[ w_ ] :> w}];
  393.      TransfAnswer[ answer ] /; FreeQ[answer,FailSum]
  394.    ]
  395.  
  396.  GlobInfiniteSum[ __ ] := Module[ {var}, var FailSum ]
  397.  
  398.  InfiniteSum[ k_^_Integer?Negative expr_.,k_,0 ] := 
  399.  (Message[Power::infy,HoldForm[1/0]]; DirectedInfinity[])
  400.  
  401.  InfiniteSum[ expr1_ + expr2_,k_,min_ ] := 
  402.    Module[ { answer },
  403.      answer = InfiniteSum[expr1,k,min];
  404.      If[ !FreeQ[answer,FailSum] || !FreeQ[answer,DirectedInfinity],
  405.      answer = FailSum,
  406.      answer += InfiniteSum[expr2,k,min];
  407.      If[ !FreeQ[answer,FailSum] || !FreeQ[answer,DirectedInfinity],
  408.          FailSum,
  409.          TransfAnswer[ answer ] 
  410.     ]
  411.      ]
  412.   ]
  413.  
  414.  InfiniteSum[ expr_,k_,min_ ] := expr Infinity/;FreeQ[expr,k]
  415.  
  416.  InfiniteSum[ const_ expr_,k_,min_ ] := 
  417.    const InfiniteSum[expr,k,min] /;FreeQ[const,k]
  418.  
  419.  InfiniteSum[ q_^(a1_+a2_) expr_.,k_,min_ ] := 
  420.    q^a1 InfiniteSum[q^a2 expr/.(-1)^(n_?EvenQ s_) :> 1,k,min]/;
  421.    FreeQ[{q,a1},k]
  422.  
  423.  InfiniteSum[ (-1)^(n_?Negative s_) expr_,k_,min_ ] := 
  424.    InfiniteSum[ Times@@{(-1)^(-n s),expr},k,min ]
  425.  
  426.  InfiniteSum[ q_^k_ expr_,k_,min_ ] :=
  427.    Module[ { exprnew, pp, pp1},
  428.       exprnew = expr//.
  429.       {
  430.       a_. (d_. k+c_.)^2 +b_ :> (pp1 = Sqrt[b];
  431.                 (Sqrt[a] d k+Sqrt[a] c+I pp)*
  432.                 (Sqrt[a] d k+Sqrt[a] c-I pp) )/;
  433.       FreeQ[{a,b,c,d},k] && Not[Znak[a]]&&Not[Znak[b]],
  434.       a_. (d_. k+c_.)^n_+b_ :> Factor[a (d k+c)^n+b] /;
  435.       IntegerQ[n] && FreeQ[{a,b,c,d},k]
  436.       };
  437.       exprnew = Expand[q^k Apart[exprnew,k]];
  438.       ( InfiniteSum[ exprnew,k,min ]/.pp->pp1 )/; 
  439.     Head[exprnew]===Plus && expr=!=exprnew
  440.    ]
  441.  
  442. (*===============  Zeta Function ========================================*)
  443.  
  444.  InfiniteSum[ k_^s_.,k_,1 ] := Zeta[-s]/;
  445.    FreeQ[s,k]&&(Not[NumberQ[s]] || Re[s]<-1)
  446.  
  447.  InfiniteSum[ k_^s_.,k_,min_?Positive ] := 
  448.    Zeta[-s] - Sum[k^s,{k,1,min-1}]/;
  449.    FreeQ[s,k]&&(Not[NumberQ[s]] || Re[s]<-1)
  450.  
  451.  InfiniteSum[ (b_. k_+a_)^s_.,k_,0 ] := 
  452.    If[ !IntegerQ[a/b] || Positive[N[a/b]] || !NumberQ[s],
  453.     b^s Zeta[-s,a/b],
  454.     0^s
  455.    ]/; FreeQ[{a,b,s},k] && 
  456.    (!NumberQ[s] || Re[s]<-1) 
  457.  
  458.  InfiniteSum[ (b_. k_+a_)^s_.,k_,min_/;min=!=0 ] := 
  459.    b^s Zeta[-s,a/b] + 
  460.    If[Negative[min],1,-1] SumNew[(b k+a)^s,{k,0,min-1}]/;
  461.    FreeQ[{a,b,s},k]&&(Not[NumberQ[s]] || Re[s]<-1)
  462.  
  463.  InfiniteSum[ (b_. k_+a_.)^s_.,k_,min_ ] := Infinity/;FreeQ[{a,b,s},k]
  464.  
  465.  InfiniteSum[ (-1)^k_ k_^s_.,k_,1 ] := 
  466.    If[(-s)===1,-Log[2],(2^(1+s) - 1) Zeta[-s]]/;
  467.    FreeQ[s,k]&&(Not[NumberQ[s]] || Re[s]<0)
  468.  
  469.  InfiniteSum[ (-1)^k_ k_^s_.,k_,min_?Positive ] := 
  470.    If[(-s)===1,-Log[2],(2^(1+s) - 1) Zeta[-s]] -
  471.    Sum[(-1)^k k^s,{k,1,min-1}]/;
  472.    FreeQ[s,k]&&(Not[NumberQ[s]] || Re[s]<0)
  473.  
  474.  InfiniteSum[ (-1)^k_ (b_. k_+a_)^s_.,k_,0 ] := 
  475.    If[ (-s)===1,
  476.        (PolyGamma[0,(a/b+1)/2]-PolyGamma[0,a/(2b)])/(2b),
  477.        If[ !IntegerQ[a/b] || Positive[a/b] || !NumberQ[s],
  478.            (2b)^s (Zeta[-s,a/(2b)] - Zeta[-s,a/(2b)+1/2]),
  479.        0^s
  480.     ]
  481.   ]/;
  482.  FreeQ[{a,b,s},k]&&(Not[NumberQ[s]] || Re[s]<0)
  483.  
  484.  InfiniteSum[ (-1)^k_ (b_. k_+a_)^s_.,k_,min_/;min=!=0 ] := 
  485.    If[(-s)===1,(PolyGamma[0,a/(2b)+1/2]-PolyGamma[0,a/(2b)])/(2b) -
  486.          If[Negative[min],1,-1] SumNew[(-1) (b k+a)^s,{k,0,min-1}],
  487.          (2b)^s (Zeta[-s,a/(2b)] - Zeta[-s,a/(2b)+1/2]) + 
  488.          If[Negative[min],1,-1] SumNew[(-1)^k (b k+a)^s,{k,0,min-1}]]/;
  489.    FreeQ[{a,b,s},k]&&(Not[NumberQ[s]] || Re[s]<0)
  490.  
  491.  InfiniteSum[ (-1)^k_ (b_. k_+a_.)^s_.,k_,min_ ] := FailSum/;FreeQ[{a,b,s},k]
  492.  
  493.  
  494. (*===============  LerchPhi Function =======================================*)
  495.  
  496.  InfiniteSum[ x_^(c_. k_) (b_. k_ + a_.)^s_.,k_,min_ ] :=
  497.     InfiniteSumLerchPhi[(x^c)^k (b k+a)^s,k,min] /;
  498.  FreeQ[{a,b,c,x,s},k]
  499.  
  500.  InfiniteSum[ (-1)^k_ x_^(c_. k_) (b_. k_ + a_.)^s_.,k_,min_ ] :=
  501.     InfiniteSumLerchPhi[(-x^c)^k (b k+a)^s,k,min]/;
  502.  FreeQ[{a,b,c,x,s},k]
  503.  
  504.  InfiniteSumLerchPhi[ x_^k_ k_^s_.,k_,min_?Positive ] :=
  505.    x LerchPhi[x,-s,1] - Sum[x^k k^s,{k,1,min-1}]/;FreeQ[{x,s},k]
  506.  
  507.  InfiniteSumLerchPhi[ x_^k_ (b_. k_ + a_.)^s_.,k_,min_ ] :=
  508.    ComplexInfinity /;IntegerQ[a/b] && (a + min) <= 0
  509.  
  510.  InfiniteSumLerchPhi[ x_^k_ (b_. k_ + a_.)^s_.,k_,min_ ] :=
  511.    b^s LerchPhi[x,-s,a/b] +
  512.    If[Negative[min],1,-1] SumNew[x^k (b k+a)^s,{k,0,min-1}]/;
  513.  FreeQ[{a,b,x,s},k] && Not[CondLerch[a/b,min]]
  514.  
  515.  InfiniteSumLerchPhi[ x_^k_ (b_. k_ + a_)^s_.,k_,min_ ] :=
  516.    b^s Module[{n},
  517.          InfiniteSum[x^Expand[n-a/b] n^s,n,min+a/b]]/;
  518.  FreeQ[{a,b,x,s},k] && CondLerch[a/b,min]
  519.  
  520.  CondLerch[ a_,min_ ] := True/;IntegerQ[a]&&Negative[a]&&min+a>0
  521.  
  522.  CondLerch[ __ ] := False
  523.  
  524. (*==========================================================================*)
  525.  
  526.  InfiniteSum[ (-1)^(c_. k_),k_,min_ ] := FailSum 
  527.  
  528.  InfiniteSum[ x_^(c_. k_),k_,min_ ] := Infinity /;
  529.  Abs[N[x^c]] >= 1.
  530.  
  531.  InfiniteSum[ (-1)^k_ x_^(c_. k_),k_,min_ ] := Infinity /;
  532.  Abs[N[x^c]] > 1.
  533.  
  534. (*===============  Hypergeometric Function =================================*)
  535.  
  536.  InfiniteSum[ 1/(k_^4 + a_),k_,min_ ] := 
  537.    Module[ { v = Pi Sqrt[2] a^(1/4) },
  538.     1/(2a) + Pi^4(Sinh[v]+Sin[v])/((Cosh[v]-Cos[v]) v^3) -
  539.     Sum[1/(i^4+a^4),{i,0,min-1}] 
  540.    ]/;
  541.  FreeQ[a,k] && !Znak[a]
  542.  
  543.  InfiniteSum[ (-1)^k/(k_^4 + a_),k_,min_ ] := 
  544.    Module[ { v = Pi Sqrt[2] a^(1/4), u = Pi a^(1/4)/Sqrt[2] },
  545.     1/(2a) - Pi^4(Sinh[v]+Sin[v])/((Cosh[v]-Cos[v]) v^3) +
  546.     Pi^4(Sinh[u]+Sin[u])/((Cosh[u]-Cos[u]) v^3) -
  547.     Sum[If[i==0,1,(-1)^i]/(i^4+a^4),{i,0,min-1}] 
  548.   ]/;
  549.  FreeQ[a,k] && !Znak[a]
  550.  
  551.  InfiniteSum[ expr_. Gamma[c_. + k_/2]^n_.,k_,0 ] := 
  552.    Module[ {m},
  553.      GlobInfiniteSum[(expr Gamma[c+m]^n)/.k->(2 m),{m,0,Infinity}] +
  554.      GlobInfiniteSum[(expr Gamma[c+m+1/2]^n)/.k->(2 m+1),{m,0,Infinity}]
  555.    ]
  556.  
  557.  InfiniteSum[ expr_,k_,min_ ] := 
  558.    Module[ { eps,exprnew,exprold }, 
  559.     exprnew = expr//.{
  560.                 Gamma[a_Times] :> Gamma[Expand[a]],
  561.                 Factorial[a_Times] :> Factorial[Expand[a]]
  562.         };
  563.     If[ !FreeQ[exprnew,Pochhammer],
  564.         exprnew = exprnew/.{
  565.                   Pochhammer[a_,n_Integer?Positive + k] :>
  566.                   Pochhammer[a,n] Pochhammer[a+n,k]
  567.          }
  568.     ];
  569.     exprold = exprnew;
  570.     If[ !FreeQ[exprnew,Gamma],
  571.     exprnew = exprnew//.
  572.        {Gamma[a_. k+b_]^n_. :> 
  573.         Gamma[b]^n (a^(n a))^k *
  574.             Product[Pochhammer[(b+i)/a,k]^n,{i,0,a-1}] /;
  575.             FreeQ[b,k] && IntegerQ[a] && a>0 && IntegerQ[n],
  576.         Gamma[a_. k+b_]^n_. :> 
  577.             (-1)^(-a k n) Gamma[b]^n ((-a)^(-n a))^k *
  578.             Product[Pochhammer[Expand[(b-i)/a],k]^(-n),{i,1,-a}]/;
  579.             FreeQ[b,k] && IntegerQ[a] && a<0 && IntegerQ[n] 
  580.        }];
  581.     If[ !FreeQ[exprnew,Factorial] || !FreeQ[exprnew,Binomial],
  582.         exprnew = exprnew//.
  583.         { Binomial[w_,v_]^n_. :> 
  584.         w!^n/(v!^n (w-v)!^n),
  585.           (a_. k+b_.)!^n_. :> 
  586.         Gamma[b+1]^n (a^(n a))^k *
  587.             Product[Pochhammer[(b+i)/a,k]^n,{i,1,a}]/;
  588.             IntegerQ[n] && IntegerQ[a] && a>0 && FreeQ[b,k]  
  589.        }];
  590.      exprnew = exprnew//.
  591.      {
  592.       c_. k^2 + a_. k + b_   :> c PowerExpand[(k+(a/c+Sqrt[a^2/c^2-4b/c])/2)*
  593.                                 (k+(a/c-Sqrt[a^2/c^2-4b/c])/2),{k}] /;
  594.       FreeQ[{a,b,c},k],
  595.       a_. (d_. k+c_.)^2 + b_ :> (Sqrt[a] d k+Sqrt[a] c+I Sqrt[b])*
  596.                                 (Sqrt[a] d k+Sqrt[a] c-I Sqrt[b])/;
  597.       FreeQ[{a,b,c,d},k] && !Znak[a] && !Znak[b],
  598.       a_. (d_. k+c_.)^n_+ b_ :> (exprold=exprold/.
  599.                                 {a(d k+c)^n+b :> Factor[a (d k+c)^n+b]};
  600.                 Factor[a (d k+c)^n+b])/;
  601.       IntegerQ[n] && FreeQ[{a,b,c,d},k],
  602.       a_. k+b_ :> b Pochhammer[1+b/a,k]/Pochhammer[b/a,k]/;
  603.       FreeQ[{a,b},k] && Not[CondLim[b/a]],
  604.       a_. k+b_ :> (exprold=exprold/.{a k+ b:> a k+b+eps};
  605.                    (b+eps) Pochhammer[1+b/a+eps/a,k]/
  606.                    Pochhammer[b/a+eps/a,k])/;
  607.       FreeQ[{a,b},k] && CondLim[b/a]
  608.      }/.{a_^k b_^k :> (a b)^k}; 
  609.       HypergeometricSeries[1,exprold,exprnew,k,min,eps]
  610.    ]
  611.  
  612.  HypergeometricSeries[ c_,exprold_,const_ expr_,k_,min_,eps_ ] := 
  613.    HypergeometricSeries[
  614.      If[!FreeQ[const,Complex],ExpandAll[c const],c const],
  615.      exprold,expr,k,min,eps]/;
  616.  FreeQ[const,k] && FreeQ[const,eps]
  617.  
  618.  HypergeometricSeries[ c_,exprold_,expr_. Pochhammer[n_,k_]^(s_Symbol d_.),
  619.                        k_,min_,eps_ ] := eps FailSum 
  620.  
  621.  HypergeometricSeries[ c_,exprold_,expr_. (-1)^m_/;!FreeQ[m,Pochhammer],
  622.                        k_,min_,eps_ ] := eps FailSum 
  623.  
  624.  HypergeometricSeries[ c_,exprold_,expr_,k_,min_,eps_ ] := 
  625.    Module[ {cond,arg,l,uppar,lowpar,coef,res},
  626.     If[ offHyper, Off[HypergeometricPFQ::hdiv]; offHyper=False];
  627.     uppar  = Join[{1},Flatten[
  628.              Cases[l expr,Pochhammer[a_,k]^n_./;IntegerQ[n]&&Positive[n]]/.
  629.              {Pochhammer[a_,b_]^n_. :> Table[a,{i,1,n}]}]];
  630.     lowpar = Flatten[ 
  631.              Cases[l expr,Pochhammer[a_,k]^n_./;IntegerQ[n]&&Negative[n]]/.
  632.              {Pochhammer[a_,b_]^n_. :> Table[a,{i,1,-n}]}];
  633.     {cond,arg,l,coef} = 
  634.           BuildList[AnalysRest[(expr/.
  635.                     Pochhammer[a_,b_]^n_. :> 1/;IntegerQ[n]) //.
  636.             { a_^(b_. k) :> (a^b)^k/;FreeQ[{a,b},k],
  637.               a_^k b_^k :> (a b)^k/;FreeQ[{a,b},k]}//.{
  638.           a_^(b_. k) v_^k :> (a^b v)^k/;!NumberQ[v] && FreeQ[{a,b,v},k]
  639.         },k,eps]];    
  640.     If[cond,    
  641.     If[FreeQ[expr,eps] && l>=0, 
  642.         If[ FreeQ[ res = 
  643.             HypergeometricPFQ[ If[l==0,uppar,
  644.                       Join[Table[1+eps,{i,1,l}],uppar]],
  645.                                If[l==0,lowpar,
  646.                       Join[Table[eps,{i,1,l}],lowpar]],arg]/.GaussRule,
  647.           DirectedInfinity],
  648.             On[HypergeometricPFQ::hdiv]; offHyper=True;
  649.             If[ l==0,
  650.                 coef(Simplify[c] res + If[ Negative[min],1,-1 ] *
  651.                      SumNew[ exprold,{k,0,min-1} ] ),
  652.                 coef Expand[eps^l Simplify[c] res + 
  653.                       If[ Negative[min],1,-1 ] *
  654.                       SumNew[ exprold (k+eps)^l/k^l,{k,0,min-1} ]]/.
  655.                      eps->0],
  656.            DirectedInfinity[]
  657.        ],
  658.        CoefNotZeroTerm[LimitSum[Expand[coef eps^l *
  659.         Simplify[c] (HypergeometricPFQ[
  660.               If[l==0,uppar,
  661.                  Join[Table[If[l>0,1+eps,eps],{i,1,Abs[l]}],uppar]],
  662.               If[l==0,lowpar,
  663.                  Join[Table[If[l>0,eps,1+eps],{i,1,Abs[l]}],lowpar]],
  664.           arg]/.GaussRule) +
  665.        If[Negative[min],1,-1] *
  666.        Apply[SumNew,{exprold (k+eps)^l/k^l,{k,0,min-1}}]],eps,0],1,eps,0]],
  667.      FailSum eps]
  668.    ] /;
  669.  CorrectExpr[ expr, k ]
  670.  
  671.  HypergeometricSeries[ c__, eps_ ] := eps FailSum
  672.  
  673.  CorrectExpr[ c_. Pochhammer[n_,k_]^l_Integer, k_ ] := 
  674.  CorrectExpr[ c,k ] /; FreeQ[n,k]
  675.  
  676.  CorrectExpr[ c_. Pochhammer[n_,k_], k_ ] := CorrectExpr[ c,k ]/; FreeQ[n,k]
  677.  
  678.  CorrectExpr[ k_^n_., k_ ] := True /; IntegerQ[n]
  679.  
  680.  CorrectExpr[ c_. x_^(a_. k_), k_ ] := CorrectExpr[ c,k ] /;FreeQ[{x,a},k]
  681.  
  682.  CorrectExpr[ c_, k_ ] := True /; FreeQ[c,k] 
  683.  
  684.  CorrectExpr[ c_, k_ ] := False
  685.  
  686. (*========================================================================
  687.  
  688.                            Finite  Sum
  689.   
  690.   ========================================================================*)
  691.  
  692.  FiniteSum[ const_ expr_,{k_,min_,max_} ] := 
  693.    const FiniteSum[expr,{k,min,max}]/;FreeQ[const,k]
  694.  
  695.  FiniteSum[ a_^(b_. k_),{k_,min_,max_} ] := 
  696.    (1 - a^Expand[b (max+1)])/(1 - a^b) + 
  697.    If[Negative[min],1,-1] SumNew[ a^(b k),{k,0,min-1} ] /;
  698.  FreeQ[{a,b},k] 
  699.  
  700.  FiniteSum[ expr_Plus,{k_,min_,max_} ] := FiniteSum[#,{k,min,max}]&/@expr
  701.  
  702.  FiniteSum[ expr_, {k_, min_, max_}] := expr (max+1-min) /; 
  703.  FreeQ[expr, k]
  704.  
  705.  FiniteSum[(m_. k_ + c_.)^i_., {k_, n0_, n1_}] :=
  706.     m^i(BernoulliB[i+1, n1+1+c/m] - BernoulliB[i+1, n0+c/m])/(i+1) /; 
  707.  IntegerQ[i] && i>0 && FreeQ[{m,c},k]
  708.  
  709.  FiniteSum[(-1)^k_ (m_. k_ + c_.)^i_., {k_, n0_, n1_}] :=
  710.     m^i((-1)^n1 EulerE[i, n1+1+c/m] + (-1)^n0 EulerE[i, n0+c/m])/2/; 
  711.  IntegerQ[i] && i>0 && FreeQ[{m,c},k]
  712.  
  713.  FiniteSum[(m_. k_ + c_.)^s_, {k_, min_?Negative, max_}] :=
  714.     FiniteSum[(-m k+c)^s,{k,1,-min}] +
  715.     FiniteSum[(m k+c)^s,{k,0,max}]
  716.  
  717.  FiniteSum[(m_. k_ + c_.)^s_, {k_, min_?NonNegative, max_}] :=
  718.       If[ s===-1,m^s(PolyGamma[0,max+1+c/m]-PolyGamma[0,min+c/m]),
  719.            m^s(Zeta[-s,min+c/m] - Zeta[-s,max+1+c/m]) ]
  720.  
  721.  FiniteSum[(-1)^k_ (m_. k_ + c_.)^s_, {k_, min_?Negative, max_}] :=
  722.     FiniteSum[(-1)^k (-m k+c)^s,{k,1,-min}] +
  723.     FiniteSum[(-1)^k (m k+c)^s,{k,0,max}]
  724.  
  725.  FiniteSum[(-1)^k_ (m_. k_ + c_.)^s_, {k_,min_?NonNegative, max_}] :=
  726.     If[s===-1,
  727.            m^s/2 (
  728.        (-1)^max(PolyGamma[0,max/2+1+c/(2m)]-
  729.                 PolyGamma[0,max/2+1/2+c/(2m)]) + 
  730.        (-1)^min(PolyGamma[0,min/2+1/2+c/(2m)]- 
  731.                 PolyGamma[0,min/2+c/(2m)]) ),
  732.        2^s m^s (
  733.        (-1)^min(Zeta[-s,min/2+c/(2m)] - Zeta[-s,min/2+1/2+c/(2m)]) +
  734.        (-1)^max(Zeta[-s,max/2+1/2+c/(2m)] - Zeta[-s,max/2+1+c/(2m)]) )]
  735.  
  736.  FiniteSum[ expr_, {k_, min_?Negative, max_} ] :=
  737.     Module[ {var},
  738.      SymbolicSumD[ expr/.k->-var,{var,1,-min}] +
  739.          SymbolicSumD[ expr,{k,0,max}]
  740.     ]
  741.     
  742.  FiniteSum[ expr_, {k_, min_, max_}] :=
  743.     SymbolicSumD[ Expand[expr],{k,min,max}] /;
  744.  PolynomialQ[Expand[expr],k]
  745.    
  746.  FiniteSum[ Binomial[n_,k_ m_Integer + p_Integer],
  747.         {k_,min_?NonNegative,Floor[r_]}] :=
  748.     If[min==0,
  749.        2^n Sum[Cos[k Pi/m]^n Cos[Expand[(n-2p) Pi k/m]],{k,1,m}]/m,
  750.        2^n Sum[Cos[k Pi/m]^n Cos[Expand[(n-2p) Pi k/m]],{k,1,m}]/m - 
  751.        Sum[Binomial[n,k m + p],{k,0,min-1}] ]/;
  752.  FreeQ[n,k] && Floor[Expand[r-n/m+p/m]]===0 && m>=p+1
  753.     
  754.  FiniteSum[ Binomial[n_,k_ m_Integer],
  755.         {k_,min_?NonNegative,Floor[r_]}] :=
  756.     If[min==0,
  757.        2^n Sum[Cos[k Pi/m]^n Cos[n Pi k/m],{k,1,m}]/m,
  758.        2^n Sum[Cos[k Pi/m]^n Cos[n Pi k/m],{k,1,m}]/m - 
  759.        Sum[Binomial[n,k m],{k,0,min-1}] ]/;
  760.  FreeQ[n,k] && Floor[Expand[r-n/m]]===0
  761.  
  762.  FiniteSum[ expr_, {k_, n0_Integer, n1_}] :=
  763.    Module[ {exprnew,list,elem,lim,answer},
  764.     exprnew = expr//.
  765.      {
  766.      Binomial[w_,v_]^n_. :> Expand[w]!^n/(Expand[v]!^n Expand[w-v]!^n),
  767.      (a_. k+b_.)!^n_. :> 
  768.        (b!)^n (a^(n a))^k *
  769.        Product[Pochhammer[Expand[(b+i)/a],k]^n,{i,1,a}]/;
  770.        IntegerQ[a] && a>0,
  771.      (a_. k+b_.)!^n_. :> 
  772.        (-1)^(-a k n) (b!)^n ((-a)^(n a))^k *
  773.        Product[Pochhammer[Expand[(b-i+1)/a],k]^(-n),{i,1,-a}]/;
  774.        IntegerQ[a] && a<0,
  775.      Gamma[a_. k+b_]^n_. :> 
  776.        Gamma[b]^n (a^(n a))^k *
  777.        Product[Pochhammer[Expand[(b+i)/a],k]^n,{i,0,a-1}]/;
  778.        IntegerQ[a] && a>0 && IntegerQ[n],
  779.      Gamma[a_. k+b_]^n_. :> 
  780.        (-1)^(-a k n) Gamma[b]^n ((-a)^(-n a))^k *
  781.        Product[Pochhammer[Expand[(b-i)/a],k]^(-n),{i,1,-a}]/;
  782.        IntegerQ[a] && a<0 && IntegerQ[n],
  783.       a_. k+b_ :> b Pochhammer[1+b/a,k]/Pochhammer[b/a,k]/;
  784.        Not[CondLim[b/a]]
  785.      };
  786.      list = Expand[Cases[exprnew,
  787.        Pochhammer[a_,k]^n_./;IntegerQ[n] && Positive[n] && (
  788.                    ZnakSum[a] || IntegerQ[Expand[n1+a]])]/.
  789.        Pochhammer[a_,k]^n_. :> a];
  790.      answer = 
  791.      If[ Length[list] == 0, FailSum,
  792.          elem = Union[list/.a_ b_. + c_. :> a/;Head[a]===Symbol];
  793.          lim = 
  794.          If[ Length[elem] == 1, -SymbolicMax[list,elem],
  795.            If[ !FreeQ[-list,n1],n1, FailSum] 
  796.          ]];
  797.      answer = 
  798.      If[ !FreeQ[{answer,lim}, FailSum], FailSum,
  799.      If[ NumberQ[lim],-SumNew@@{exprnew//.PochToAlg,{k,lim+1,n1}} + 
  800.                       GlobInfiniteSum[exprnew,{k,n0,Infinity}],
  801.      If[ !FreeQ[n1,Floor] && ZnakSum[Expand[(n1/.Floor[r_]:>r)-lim]],
  802.           Donor[lim,Complement[-list,{lim}]],
  803.      If[ (ExpandAll[exprnew/.k->(lim+1)]/.
  804.          {Pochhammer[a_,b_] :> 0/;Expand[a+b-1]===0})===0,        
  805.           -SumNew@@{expr,{k,lim+1,n1}}  + 
  806.           GlobInfiniteSum[exprnew,{k,n0,Infinity}],
  807.           FailSum]
  808.        ]]]; 
  809.      (answer//.PochToAlg)/;FreeQ[answer,FailSum]   
  810.    ]/;Not[FreeQ[expr,Binomial]] || Not[FreeQ[expr,Factorial]]
  811.  
  812.  FiniteSum[ expr_, {k_, min_Integer, max_}] :=
  813.    Module[ {var,answer},
  814.      answer = InfiniteSum[expr,k,min];
  815.      ((answer - GlobInfiniteSum[(expr/.k->var+max+1)/.
  816.        a_^b_ :> a^Expand[b],{var,0,Infinity}]) /.
  817.          {HypergeometricPFQ[uppar_,lowpar_,arg_] :> var FailSum /;
  818.                             Length[uppar] > Length[lowpar]+1})/;
  819.      And@@(FreeQ[answer,#]&/@{FailSum,DirectedInfinity})   
  820.    ]
  821.  
  822.  FiniteSum[ __ ] := Module[ {var}, var FailSum ]
  823.  
  824. (*========================================================================
  825.  
  826.                          Product
  827.   
  828.   ========================================================================*)
  829.  
  830.  SymbolicProduct[ const_,{k_,min_,max_} ] := 
  831.    const^(max-min+1) /; FreeQ[const,k]
  832.  
  833.  SymbolicProduct[ expr_,{k_,min_Integer,max_Integer} ] := 
  834.    Product[expr,{k,min,max}] 
  835.  
  836.  SymbolicProduct[ const_ expr_,{k_,min_,max_} ] := 
  837.    const^(max-min+1) SymbolicProduct[expr,{k,min,max}] /;
  838.  FreeQ[const,k] && FreeQ[{min,max},DirectedInfinity]
  839.  
  840.  SymbolicProduct[ k_^n_.,{k_,min_Integer,Infinity} ] := 
  841.    If@@{Re[N[n]]>=0,
  842.         If[FreeQ[n,Complex],Infinity,ComplexInfinity], 
  843.         0} /; FreeQ[n,k]
  844.  
  845.  SymbolicProduct[ (c_ k_+a_.)/(c_ k_ + b_.),{k_,min_,max_} ] := 
  846.    SymbolicProduct[ (k+a/c)/(k+b/c),{k,min,max} ]
  847.  
  848.  SymbolicProduct[ (k_+a_.)/(k_ + b_.),{k_,min_Integer,Infinity} ] := 
  849.    If@@{Re[N[a-b]]>=0, 
  850.         If[FreeQ[N[{a,b}],Complex],Infinity,ComplexInfinity],
  851.         0} /; 
  852.  FreeQ[{a,b},k]
  853.  
  854.  SymbolicProduct[ 1+(-1)^k_ a_. (2k_+b_Integer)^n_Integer?Negative,
  855.                 {k_,1,Infinity} ] := 
  856.    If[ b==1, (Pi/2)^(-n) Abs[EulerE[-n-1]]/(2 (-n-1)!),
  857.    If[ Positive[b],
  858.         (Pi/2)^(-n) Abs[EulerE[-n-1]]/(2 (-n-1)!) /
  859.         Product[1+(-1)^k (2k+1)^n,{k,1,Floor[b/2]}],
  860.         (Pi/2)^(-n) Abs[EulerE[-n-1]]/(2 (-n-1)!) *
  861.         Product[1+(-1)^k (-2k+1)^n,{k,0,Floor[-b/2]}]
  862.      ]] /;    
  863.  OddQ[n] && OddQ[b] && a===(-1)^Floor[b/2]
  864.  
  865.  SymbolicProduct[ Sec[expr_]^n_. f_.,{k_,min_,max_} ] := 
  866.    SymbolicProduct[f,{k,min,max}] /
  867.    SymbolicProduct[Cos[expr],{k,min,max}]^n /;
  868.  FreeQ[n,k] && FreeQ[{min,max},DirectedInfinity]
  869.  
  870.  SymbolicProduct[ Csc[expr_]^n_. f_.,{k_,min_,max_} ] := 
  871.    SymbolicProduct[f,{k,min,max}] /
  872.    SymbolicProduct[Sin[expr],{k,min,max}]^n /;
  873.  FreeQ[n,k] && FreeQ[{min,max},DirectedInfinity]
  874.  
  875.  SymbolicProduct[ Tan[expr_]^n_. f_.,{k_,min_,max_} ] := 
  876.    SymbolicProduct[f,{k,min,max}] *
  877.    SymbolicProduct[Sin[expr],{k,min,max}]^n /
  878.    SymbolicProduct[Cos[expr],{k,min,max}]^n /;
  879.  FreeQ[n,k] && FreeQ[{min,max},DirectedInfinity]
  880.  
  881.  SymbolicProduct[ Cot[expr_]^n_. f_.,{k_,min_,max_} ] := 
  882.    SymbolicProduct[f,{k,min,max}] *
  883.    SymbolicProduct[Cos[expr],{k,min,max}]^n /
  884.    SymbolicProduct[Sin[expr],{k,min,max}]^n /;
  885.  FreeQ[n,k] && FreeQ[{min,max},DirectedInfinity]
  886.  
  887.  SymbolicProduct[ expr_,{k_,max_,max_} ] := 
  888.    expr /. k->max
  889.  
  890.  SymbolicProduct[ expr_,{k_,min_/;!IntegerQ[min],max_/;!IntegerQ[max]} ] := 
  891.    Module[ {var},
  892.      SymbolicProduct[expr/.k->(var+min),{var,0,max-min}]
  893.    ] /;
  894.  IntegerQ[max-min] && Positive[max-min]
  895.  
  896.  SymbolicProduct[ expr_,{k_,min_Integer/;min!=1,max_} ] := 
  897.    Module[ {var},
  898.     SymbolicProduct[ (expr/.{a_. k :> Expand[a(var+min-1)]/;FreeQ[a,k]})/.
  899.         {(-1)^(n_Integer + s_) :> (-1)^n (-1)^s},
  900.         {var,1, If[FreeQ[max,DirectedInfinity],max-min+1,max]}]
  901.    ]
  902.  
  903.  SymbolicProduct[ expr_Times,{k_,min_,max_} ] := 
  904.    Module[ { answer },
  905.     answer = Product[#,{k,min,max}]&/@expr;
  906.     If[ FreeQ[answer, FailSum] && FreeQ[answer, Product],
  907.         answer,
  908.         FailSum
  909.     ]
  910.    ] /; 
  911.  FreeQ[{min,max},DirectedInfinity]
  912.  
  913.  SymbolicProduct[ q_^(a1_+a2_) expr_.,{k_,min_,max_} ] := 
  914.    q^(a1 (max-min+1)) *
  915.    SymbolicProduct[q^a2 expr/.(-1)^(n_?EvenQ s_) :> 1,{k,min,max}]/;
  916.    FreeQ[{q,a1},k] && FreeQ[{min,max},DirectedInfinity]
  917.  
  918.  SymbolicProduct[ (-1)^(n_?Negative s_) expr_,{arg__} ] := 
  919.    SymbolicProduct[ Times@@{(-1)^(-n s),expr},{arg} ]
  920.  
  921.  SymbolicProduct[ k_^s_.,{k_,1,max_} ] := (max!)^s /; 
  922.  FreeQ[s,k] && max=!=Infinity
  923.  
  924.  SymbolicProduct[ (b_ k_ + a_)^s_.,{k_,min_,max_} ] := 
  925.    SymbolicProduct[ b^s (k+a/b)^s,{k,min,max} ] /;
  926.  FreeQ[a,k]
  927.  
  928.  SymbolicProduct[ (k_ + a_)^s_.,{k_,1,max_} ] := Pochhammer[a+1,max]^s /; 
  929.  FreeQ[{a,s},k] && max=!=Infinity
  930.  
  931.  SymbolicProduct[ (k_ + a_.)^(k_+c_),{k_,1,max_} ] := 
  932.    SymbolicProduct[ (k+a)^k,{k,1,max}] *
  933.    SymbolicProduct[ (k+a)^c,{k,1,max}] /;
  934.  FreeQ[{a,c},k] 
  935.  
  936.  SymbolicProduct[ (k_ + a_.)^k_,{k_,1,max_} ] := 
  937.    Gamma[max+a+1]^max Product[Gamma[k+a]^(-1),{k,1,max}] /;
  938.  FreeQ[a,k] && max=!=Infinity
  939.  
  940.  SymbolicProduct[ w_^expr_,{k_,min_,max_} ] :=
  941.    w^Sum[expr,{k,min,max}] /; FreeQ[w,k]
  942.  
  943.  SymbolicProduct[ Sin[2 k_ Pi a_] ,{k_,1,max_} ] :=
  944.    SymbolicProduct[ 2 Sin[k Pi/a] Cos[k Pi/a],{k,1,max}] /;
  945.  IntegerQ[1/a-max]
  946.  
  947.  SymbolicProduct[ Sin[k_ Pi a_] ,{k_,1,max_} ] :=
  948.    If[ Expand[1/a-max-1]===0, 2^(-max) (max+1),
  949.     If[ Negative[1/a-max-1], 
  950.         SymbolicProduct[ Sin[k Pi a] ,{k,1,1/a-1} ] *
  951.                 Product[ Sin[k Pi a] ,{k,1/a,max} ],
  952.         Module[ {y},
  953.          Limit[Product[ Sin[y+ k Pi a] ,{k,0,max} ]/Sin[y],y->0]
  954.         ] ]] /;
  955.  IntegerQ[1/a-max]
  956.  
  957.  SymbolicProduct[ Sin[y_. + k_ Pi a_/;!Znak[a]] ,{k_,1,max_} ] :=
  958.    If[ 1/a===max, -2^(1-max) Sin[Expand[y max]],
  959.    If[ Negative[1/a-max], 
  960.         SymbolicProduct[ Sin[y+ k Pi a] ,{k,1,1/a} ] *
  961.         Product[ Sin[y+ k Pi a] ,{k,1/a+1,max} ],
  962.      If[ Sin[y]=!=0,
  963.          SymbolicProduct[ Sin[y+ k Pi a] ,{k,0,max} ]/Sin[y],
  964.          FailSum]] ] /;
  965.  FreeQ[{y,a},k] && IntegerQ[1/a - max] 
  966.  
  967.  SymbolicProduct[ Sin[y_. + k_ Pi a_/;Znak[a]] ,{k_,1,max_} ] :=
  968.    If[ -1/a===max, (-1)^max 2^(1-max) Sin[Expand[y max]],
  969.    If[ Negative[-1/a-max], 
  970.         SymbolicProduct[ Sin[y+ k Pi a] ,{k,1,-1/a} ] *
  971.         Product[ Sin[y+ k Pi a] ,{k,-1/a+1,max} ],
  972.      If[ Sin[y]=!=0,
  973.          SymbolicProduct[ Sin[y+ k Pi a] ,{k,0,max} ]/Sin[y],
  974.          FailSum]] ] /;
  975.  FreeQ[{y,a},k] && IntegerQ[-1/a - max]
  976.  
  977.  SymbolicProduct[ Cos[y_. + k_ Pi a_/;!Znak[a]] ,{k_,1,max_} ] :=
  978.    If[ 1/a===max, -2^(1-max) Sin[Expand[(2y + Pi) max/2]],
  979.    If[ Negative[1/a-max], 
  980.         SymbolicProduct[ Cos[y+ k Pi a] ,{k,1,1/a} ] *
  981.         Product[ Cos[y+ k Pi a] ,{k,1/a+1,max} ],
  982.      If[ Cos[y]=!=0,
  983.          SymbolicProduct[ Cos[y+ k Pi a] ,{k,0,max} ]/Cos[y],
  984.          FailSum]] ] /;
  985.  FreeQ[{y,a},k] && IntegerQ[1/a - max] 
  986.  
  987.  SymbolicProduct[ Cos[y_. + k_ Pi a_/;Znak[a]] ,{k_,1,max_} ] :=
  988.    If[ -1/a===max, (-1)^max 2^(1-max) Sin[Expand[(2y + Pi) max/2]],
  989.    If[ Negative[-1/a-max], 
  990.         SymbolicProduct[ Cos[y+ k Pi a] ,{k,1,-1/a} ] *
  991.         Product[ Cos[y+ k Pi a] ,{k,-1/a+1,max} ],
  992.      If[ Cos[y]=!=0,
  993.          SymbolicProduct[ Cos[y+ k Pi a] ,{k,0,max} ]/Cos[y],
  994.          FailSum]] ] /;
  995.  FreeQ[{y,a},k] && IntegerQ[-1/a - max]
  996.  
  997.  SymbolicProduct[ 1 + a_. (b_ k_+c_)^n_Integer?Negative,{k_,1,Infinity} ] := 
  998.    SymbolicProduct[ 1 + a b^n (k+Expand[c/b])^n,{k,1,Infinity}] /;
  999.  FreeQ[{a,b,c},k]
  1000.  
  1001.  SymbolicProduct[ 1 + a_. (k_+c_Integer)^n_Integer?Negative,
  1002.                 {k_,1,Infinity} ] := 
  1003.    If[ Positive[c],
  1004.        Module[ {var,x},
  1005.         If[ (1+a c^n)=!=0,   
  1006.             SymbolicProduct[1+a (var+c-1)^n,{var,1,Infinity}] /
  1007.                   (1+a c^n),
  1008.             Limit[Product[1+a x (var+c-1)^n,{var,1,Infinity}]/
  1009.                   (1+a x c^n), x->1]]
  1010.        ],
  1011.      1/(k+c) /. k->-c] /;
  1012.  FreeQ[{a,c},k]
  1013.  
  1014.  SymbolicProduct[ 1 + a_. k_^n_Integer?Negative,{k_,1,Infinity} ] := 
  1015.    If[ n==-1, If[ Positive[N[a]], Infinity, FailSum ],
  1016.        a^(-1) *
  1017.        Product[ Gamma[E^(-Pi I (-n+1)/n) E^(-2 Pi I p/n) *
  1018.                 If[ Znak[a], E^(-Pi I/n) (-a)^(-1/n), a^(-1/n)] ]^(-1),
  1019.               {p,0,-n-1}]
  1020.    ] /;  
  1021.  FreeQ[a,k]
  1022.  
  1023.  SymbolicProduct[ 1 + a_./(k_ + b_)^2,{k_,1,Infinity} ] := 
  1024.    Gamma[b+1]^2/(Gamma[b+1+Sqrt[-a]] Gamma[b+1-Sqrt[-a]]) /;
  1025.  FreeQ[{a,b},k] && Znak[a]
  1026.  
  1027.  SymbolicProduct[ 1 + a_./(k_ + b_)^2,{k_,1,Infinity} ] := 
  1028.    Gamma[b+1]^2/(Gamma[b+1+I Sqrt[a]] Gamma[b+1-I Sqrt[a]]) /;
  1029.  FreeQ[{a,b},k] 
  1030.  
  1031.  SymbolicProduct[ expr_,{k_,min_,max_} ] :=
  1032.    ( Flag1 = False;
  1033.      answer = SymbolicProduct[Factor[expr],{k,min,max}]
  1034.    ) /;
  1035.  Flag1
  1036.  
  1037.  SymbolicProduct[ expr_,{k_,min_,max_} ] :=
  1038.    ( Flag2 = False;
  1039.      SymbolicProduct[Apart[expr,k],{k,min,max}]
  1040.    ) /;
  1041.  Flag2
  1042.  
  1043.  SymbolicProduct[ expr_,{k_,min_,max_} ] :=
  1044.    ( Flag3 = False;
  1045.      SymbolicProduct[expr/.
  1046.     {c_. k^2+a_. k+b_ :> 
  1047.         c PowerExpand[(k+(a/c+Sqrt[a^2/c^2-4b/c])/2) *
  1048.                    (k+(a/c-Sqrt[a^2/c^2-4b/c])/2),{k}] /;
  1049.                    FreeQ[{a,b,c},k] 
  1050.     },{k,min,max}]
  1051.    ) /;
  1052.  Flag3
  1053.  
  1054.  SymbolicProduct[ a__ ] := {a} + FailSum
  1055.  
  1056. (*========================================================================
  1057.  
  1058.                           Supplement
  1059.   
  1060.   ========================================================================*)
  1061.  
  1062.  Reduction[ expr_,function_ ] :=
  1063.    Module[ {len1,len2},
  1064.      len2 = Union[ 
  1065.             len1 = Cases[ Expand[expr],w_/;Not[FreeQ[w,function]] ]//.
  1066.             {w_. function@@{a_,{b__}} :> {a,{b}} } ];
  1067.      If[ Length[len2] < Length[len1],
  1068.          CollectExpr[expr,len2,function],
  1069.          expr ]
  1070.     ]
  1071.  
  1072.  CollectExpr[ expr_,{pat_},function_ ] := Collect[ expr,function@@pat ]
  1073.  
  1074.  CollectExpr[ expr_,{pat1_,pat__},function_ ] := 
  1075.    CollectExpr[ Collect[ expr, function@@pat1 ], {pat},function ]
  1076.  
  1077.  SumFloor[ expr_,{k_,min_Integer?NonNegative,max_},sup_ ] :=
  1078.     If[ (expr/.k->min)===(expr/.k->sup),
  1079.         SymbolicSumD[expr,{k,min,sup}]/2 +
  1080.         (expr/.k->Floor[sup/2]) (1+(-1)^sup)/4 +
  1081.         Sum[expr,{k,1+Floor[sup/2],max}],
  1082.     If[ Length[Cases[expr,k^n_Negative]]==0 && min>0,
  1083.         SumFloor[expr,{k,0,max},sup] -
  1084.         Sum[expr,{k,0,min-1}],
  1085.         FailSum ]]
  1086.  
  1087.  SumFloor[ __ ] := FailSum
  1088.  
  1089.  SymbolicMax[ {a_},elem_ ] := a
  1090.  
  1091.  SymbolicMax[ {a_,b_,v___},elem_ ] :=
  1092.    If[ Znak[(b-a)/.w1_. elem+w2_. :> w1], 
  1093.        SymbolicMax[{a,v},elem],
  1094.        SymbolicMax[{b,v},elem] ]
  1095.  
  1096.  BuildList[ a_ list[v__] ] := {v,a}
  1097.  
  1098.  BuildList[ list[v__] ] := {v,1}
  1099.  
  1100.  AnalysRest[ (eps_+a_.)^n_. expr_.,k_,eps_] :=
  1101.     AnalysRest[expr,k,eps] (eps+a)^n 
  1102.  
  1103.  AnalysRest[ a_^k_ x_^(n_. k_),k_,eps_ ] := 
  1104.     list[True, a x^n,0] /; FreeQ[{a,x,n},k]
  1105.  
  1106.  AnalysRest[ x_^(n_. k_),k_,eps_ ] := list[True,x^n,0]/;FreeQ[{x,n},k]
  1107.  
  1108.  AnalysRest[ 1,k_,eps_ ] := list[True,1,0]
  1109.  
  1110.  AnalysRest[ (-1)^k_,k_,eps_ ] := list[True,-1,0]
  1111.  
  1112.  AnalysRest[ (-1)^k_ x_^(n_. k_) k_^l_./;IntegerQ[l],k_,eps_ ] := 
  1113.     list[True,-x^n,l]/;FreeQ[{x,n},k]
  1114.  
  1115.  AnalysRest[ x_^(n_. k_) k_^l_./;IntegerQ[l],k_,eps_ ] := 
  1116.     list[True,x^n,l]/;FreeQ[{x,n},k]
  1117.  
  1118.  AnalysRest[ k_^l_./;IntegerQ[l],k_,eps_ ] := list[True,1,l]
  1119.  
  1120.  AnalysRest[ (-1)^k k_^l_./;IntegerQ[l],k_,eps ] := list[True,-1,l]
  1121.  
  1122.  AnalysRest[ __ ] := list[False,False,False]
  1123.  
  1124.  SumNew[ expr_,{var_,min_,max_} ] :=
  1125.     Sum[expr,{var,min,max}]/;Expand[min-max-1]<=0
  1126.  
  1127.  SumNew[ expr_,{var_,min_,max_} ] :=
  1128.     Sum[expr,{var,max+1,min-1}]
  1129.  
  1130.  CoefNotZeroTerm[f_,n_,x_,s_] :=
  1131.   Module[ {var,g,q=0,i=0},
  1132.    g = f/.x->(var+s);
  1133.    g = If[Not[FreeQ[g,PolyGamma]],g/.PolyGamma->PolyGamma1,g];
  1134.    While[ q===0,
  1135.       q = Normal[Series[g,{var,0,n+i}]]/.PolyGamma1->PolyGamma/.{
  1136.          Power[u_ v_,k_]:>Power[u,k] Power[v,k]};
  1137.       i=i+2 ];
  1138.    Expand[q/.{
  1139.      c_ var^k_Integer :> Together[c] var^k/;FreeQ[c,var] && k<0 }
  1140.    ]//.var->0]/;FreeQ[f,FailSum] && FreeQ[f,Infinity]
  1141.  
  1142.  CoefNotZeroTerm[f_/;Not[FreeQ[f,FailSum]],n_,x_,s_] := x FailSum
  1143.  
  1144.  CoefNotZeroTerm[f_/;Not[FreeQ[f,Infinity]],n_,x_,s_] := x Infinity
  1145.  
  1146.  SimpPochhammer[f_Plus] := Map[ SimpPochhammer1[#]&,f ]
  1147.  
  1148.  SimpPochhammer[v_] := SimpPochhammer1[v]       
  1149.  
  1150.  SimpPochhammer1[ Times[v1___,Pochhammer[w1_,v_]^n_.,v2___,
  1151.                               Pochhammer[w2_,v_]^m_.] ] :=
  1152.     Module[ {p}, 
  1153.       p = Min[ Abs[n], Abs[m] ];
  1154.       If[ (w1-w2)===1,
  1155.            SimpPochhammer1[v1 v2 Pochhammer[w1,v]^(n-p) *
  1156.                Pochhammer[w2,v]^(m+p)] ((w2+v)/w2)^p,
  1157.            SimpPochhammer1[v1 v2 Pochhammer[w1,v]^(n-p) *
  1158.                Pochhammer[w2,v]^(m+p)] (w1/(w1+v))^p
  1159.         ] 
  1160.     ]/; (w2-w1==1 || w1-w2==1) && IntegerQ[n] && n>0 && m<0
  1161.  
  1162.  SimpPochhammer1[v_] := v//.PochToAlg
  1163.  
  1164.  
  1165.  LimitSum[ f_,n_,x_,s_] := x FailSum/;
  1166.  !FreeQ[f,FailSum] || !FreeQ[f,DirectedInfinity]
  1167.  
  1168.  LimitSum[ f_Plus,x_,s_] := Map[LimitSum[#,x,s]&,f]
  1169.  
  1170.  LimitSum[Gamma[u_]^n_.,x_,s_] := 
  1171.    LimitSum[Gamma[u+1]^n/u^n,x,s]/;CondLim[u//.x->s]  
  1172.  
  1173.  LimitSum[PolyGamma[k_,u_]^n_.,x_,s_] := 
  1174.     LimitSum[Expand[(PolyGamma[k,u+1]-(-1)^k k! u^(-k-1))^n],x,s]/;
  1175.   CondLim[u//.x->s] 
  1176.  
  1177.  LimitSum[Times[v1___,Gamma[u_]^n_.,v2___],x_,s_] := 
  1178.    LimitSum[v1 v2 Gamma[u+1]^n/u^n ,x,s]/;CondLim[u//.x->s] 
  1179.  
  1180.  LimitSum[Times[v1___,Gamma[u_,0,a_]^n_.,v2___],x_,s_] := 
  1181.    LimitSum[Expand[v1 v2 (Gamma[u+1,0,a]/u + a^u E^(-a)/u)^n],x,s]/;
  1182.  CondLim[u//.x->s]  
  1183.  
  1184.  LimitSum[Times[v1___,Gamma[u_,a_]^n_.,v2___],x_,s_] := 
  1185.    LimitSum[Expand[v1 v2 (Gamma[u+1,a] + a^u E^(-a)/Gamma[u+1])^n],x,s]/;
  1186.  CondLim[u//.x->s]  
  1187.  
  1188.  LimitSum[Times[v1___,PolyGamma[k_,u_]^n_.,v2___],x_,s_] := 
  1189.     LimitSum[Expand[v1 v2 (PolyGamma[k,u+1]-(-1)^k k! u^(-k-1))^n],x,s]/;
  1190.   CondLim[u//.x->s] 
  1191.  
  1192.  LimitSum[Times[v1___,LerchPhi[z_,n_,u_],v2___],x_,s_] := 
  1193.     LimitSum[v1 v2,x,s] Module[ {p=u/.x->s},
  1194.     Sum[z^i/(i+u)^n,{i,0,-p}] + 
  1195.     Sum[z^i/(i+p)^n,{i,1-p,Infinity}] ]/;
  1196.  CondLim[u/.x->s]
  1197.  
  1198.  LimitSum[LerchPhi[z_,n_,u_],x_,s_] := 
  1199.     Module[ {p=u/.x->s},
  1200.       Sum[z^i/(i+u)^n,{i,0,-p}] +
  1201.       Sum[z^i/(i+p)^n,{i,1-p,Infinity}] ]/;
  1202.  CondLim[u/.x->s]
  1203.  
  1204.  LimitSum[Times[v1___,Literal[HypergeometricPFQ][up_,low_,arg_],v2___],x_,s_] :=
  1205.     (HypergeometricPFQ[up,low,arg]//.x->s) LimitSum[v1 v2,x,s]/;
  1206.   And@@(Not[CondLim[#/.x->s]]&/@Join[up,low])
  1207.  
  1208.  LimitSum[Times[v1___,Literal[Hypergeometric2F1][a_,b_,c_,arg_],v2___],x_,s_] :=
  1209.     (Hypergeometric2F1[a,b,c,arg]//.x->s) LimitSum[v1 v2,x,s]/;
  1210.   And@@(Not[CondLim[#/.x->s]]&/@{a,b,c})
  1211.  
  1212.  LimitSum[Times[v1___,Literal[Hypergeometric1F1][a_,b_,arg_],v2___],x_,s_] :=
  1213.     (Hypergeometric1F1[a,b,arg]//.x->s) LimitSum[v1 v2,x,s]/;
  1214.   And@@(Not[CondLim[#/.x->s]]&/@{a,b})
  1215.  
  1216.  LimitSum[Times[v1___,Literal[HypergeometricPFQ][up_,low_,arg_],v2___],x_,s_] :=
  1217.     LimitSum[Expand[v1 v2 SeriesForHyperFun[up,low,arg,
  1218.       Min[Select[up//.x->s,IntegerQ[#] && #<=0&]],x,s ]],x,s]/;FreeQ[low,x]
  1219.  
  1220.  LimitSum[Times[v1___,Literal[Hypergeometric2F1][a_,b_,c_,arg_],v2___],x_,s_] :=
  1221.    LimitSum[Expand[v1 v2 SeriesForHyperFun[{a,b},{c},arg,
  1222.       Min[Select[{a,b}//.x->s,IntegerQ[#] && #<=0&]],x,s ]],x,s]/;FreeQ[c,x]
  1223.  
  1224.  LimitSum[Times[v1___,Literal[Hypergeometric1F1][a_,b_,arg_],v2___],x_,s_] :=
  1225.     LimitSum[Expand[v1 v2 SeriesForHyperFun[{a},{b},arg,
  1226.       Min[Select[{a}//.x->s,IntegerQ[#] && #<=0&]],x,s ]],x,s]/;FreeQ[b,x]
  1227.  
  1228.  LimitSum[Times[v1___,Literal[Hypergeometric2F1][a_,b_,c_,arg_],v2___],x_,s_] :=
  1229.     LimitSum[v1 v2,x,s] *
  1230.     Module[ {answer,k}, answer = LimitInfiniteSum[ 
  1231.       Pochhammer[a,k] Pochhammer[b,k]/(k!*
  1232.       Pochhammer[c,k]) arg^k//.PochToAlg,k,x,s];
  1233.     If[FreeQ[answer,Hypergeometric2F1],answer,FailSum]]/;Not[FreeQ[c,x]]
  1234.  
  1235.  LimitSum[Literal[Hypergeometric2F1][a_,b_,c_,arg_],x_,s_] :=
  1236.     Module[ {answer,k}, answer = LimitInfiniteSum[ 
  1237.       Pochhammer[a,k] Pochhammer[b,k]/(k!*
  1238.       Pochhammer[c,k]) arg^k//.PochToAlg,k,x,s];
  1239.     If[FreeQ[answer,Hypergeometric2F1],answer,FailSum]]/;Not[FreeQ[c,x]]
  1240.  
  1241.  LimitSum[Times[v1___,Literal[Hypergeometric1F1][a_,c_,arg_],v2___],x_,s_] :=
  1242.     LimitSum[v1 v2,x,s] *
  1243.     Module[ {answer,k}, answer = LimitInfiniteSum[ 
  1244.       Pochhammer[a,k]/(k! Pochhammer[c,k]) arg^k//.PochToAlg,k,x,s];
  1245.     If[FreeQ[answer,FailSum],answer,FailSum]]/;Not[FreeQ[c,x]]
  1246.  
  1247.  LimitSum[Literal[Hypergeometric1F1][a_,c_,arg_],x_,s_] :=
  1248.     Module[ {answer,k}, answer = LimitInfiniteSum[ 
  1249.       Pochhammer[a,k]/(k! Pochhammer[c,k]) arg^k//.PochToAlg,k,x,s];
  1250.     If[FreeQ[answer,Hypergeometric1F1],answer,FailSum]]/;Not[FreeQ[c,x]]
  1251.  
  1252.  LimitSum[Times[v1___,Literal[HypergeometricPFQ][up_,low_,arg_],v2___],x_,s_] :=
  1253.     LimitSum[v1 v2,x,s] *
  1254.     Module[ {k}, 
  1255.       LimitInfiniteSum[ 
  1256.         MultPochham[up,k]/(k! MultPochham[low,k]) arg^k//.PochToAlg,
  1257.       k,x,s]
  1258.    ]/;Not[FreeQ[low,x]]
  1259.  
  1260.  LimitSum[f_,x_,s_] := f
  1261.  
  1262.  LimitInfiniteSum[ c_ expr_,k_,eps_,s_ ] := 
  1263.     c LimitInfiniteSum[ expr,k,eps,s ]/;FreeQ[c,k]
  1264.  
  1265.  LimitInfiniteSum[ expr_,k_,eps_,s_ ] := 
  1266.    Block[ {p,answer,LimitSum,m},
  1267.      p = If[ Length[p = Select[(Cases[expr,(k+c_. eps+w_.)^n_?Negative]/.
  1268.          (k+c_. eps+v_.)^m_:>(k+c eps+v)^(-m))/.{k->0, eps->s},IntegerQ]]==0,
  1269.          0,Min[p] ];
  1270.      answer = Sum[expr,{k,0,-p}] +
  1271.               Sum[expr/.eps->s,{k,1-p,DirectedInfinity[1]}]/.
  1272.                   TransfAnswer[a_]:>a; 
  1273.      If[ FreeQ[answer,LimitSum],answer,
  1274.          Sum[expr,{k,0,-p}] +
  1275.          Sum[expr/.eps->s/.k->m+1,{m,-p,DirectedInfinity[1]}]]
  1276.     ]
  1277.  
  1278.  SeriesForHyperFun[up_,low_,arg_,k_Integer,x_,s_] :=
  1279.     Sum[MultPochham[up,i] arg^i/((MultPochham[low,i]//.x->s) i!),
  1280.     {i,0,k+1}]
  1281.  
  1282.  SeriesForHyperFun[up_,low_,arg_,k_,x_,s_] :=
  1283.     (HypergeometricPFQ[up,low,arg]//.x->s)
  1284.  
  1285.  SeriesForHyperFun[ __ ] := FailSum
  1286.  
  1287.  PochToAlg = {
  1288.   Pochhammer[0,k_] :> 0,
  1289.   Pochhammer[n_Integer?Positive,k_] :> (k+n-1)!/(n-1)!,
  1290.   Pochhammer[a_,k_]^n_. Pochhammer[b_,k_]^(m_?Negative) :> a^n/(a+k)^n/;
  1291.     b-a===1 && n+m===0,
  1292.   Pochhammer[a_,k_]^n_. Pochhammer[b_,k_]^(m_?Negative) :> (a+k)^n/a^n/;
  1293.     a-b===1 && n+m===0,
  1294.   Pochhammer[a_,k_] :> (-1)^(-a) (-a)!/; a+k===0,
  1295.   Pochhammer[1/2,k_] :> 4^(-k) Expand[2k]!/k!,
  1296.   Pochhammer[3/2,k_] :> 4^(-k) Expand[2k+1]!/k!,
  1297.   Pochhammer[a_,k_]  :> (-1)^k Pochhammer[1-a-k,k]/;NumberQ[a+k],
  1298.   Pochhammer[a_?Negative,k_/;FreeQ[k,Floor[_]]]  :> a/(a+k) Pochhammer[1+a,k],
  1299.   (a_Rational)^k_    :> Numerator[a]^k/Denominator[a]^k,
  1300.   (a_)! :> Expand[a]!
  1301.     }
  1302.  
  1303.  CondLim[u_] := IntegerQ[u] && u <= 0
  1304.  
  1305.  Znak[n_ a_] := True/;NumberQ[n] && Im[n]===0 && n<0
  1306.  
  1307.  Znak[Complex[0,n_] a_.] := True/;n<0
  1308.  
  1309.  Znak[n_] := True/;NumberQ[n] && Im[n]===0 &&n<0
  1310.  
  1311.  Znak[a_] := False
  1312.  
  1313.  ZnakSum[n_ a_] := True/;NumberQ[n] && Im[n]===0 && n<0
  1314.  
  1315.  ZnakSum[Complex[0,n_] a_.] := True/;n<0
  1316.  
  1317.  ZnakSum[n_] := True/;NumberQ[n] && Im[n]===0 &&n<0
  1318.  
  1319.  ZnakSum[n_ + c_] := True/;NumberQ[n] && ZnakSum[c]
  1320.  
  1321.  ZnakSum[n_ + c_] := True/;ZnakSum[n] && ZnakSum[c]
  1322.  
  1323.  ZnakSum[a_] := False
  1324.  
  1325.  TransfAnswer[ Indeterminate ] := Module[ {var}, var FailSum ]
  1326.  
  1327.  TransfAnswer[ g_[f_,{r__}] v_. ] := 
  1328.    g[f,{r}] TransfAnswer[v] /; g===Sum || g===Product
  1329.  
  1330.  TransfAnswer[ v_ ] := 
  1331.   Module[ {answer = v//.{0^m_ :> 0,
  1332.         (n_Integer)^(m_Integer s_) :> (n^Abs[m])^(Sign[m] s)} },
  1333.     answer = If[ !FreeQ[answer,Zeta], 
  1334.                  answer/.Zeta[n_Integer?Positive,z_] :>
  1335.                          PolyGamma[n-1,z] (-1)^n/(n-1)!,
  1336.                  answer ];
  1337.     If[ !FreeQ[answer, Gamma],
  1338.     answer = SimplifyGamma[answer/.PochToGam//.GammaToFact]//.
  1339.         {n_Rational^k_ :> Numerator[n]^k Denominator[n]^(-k),
  1340.          (-1)^(-s_) :> (-1)^s} ];
  1341.     If[ !FreeQ[v,LerchPhi], answer = answer/.LerchRule];
  1342.     If[ !FreeQ[answer,Complex], answer = answer//.complex]; 
  1343.     If[ !FreeQ[answer,Log], answer = SimpLog[answer] ];   
  1344.     If[ !FreeQ[answer,PolyGamma], answer = SimplifyPolyGamma[answer] ];
  1345.     If[ Depth[answer] < 10 && Length[answer] <= 8,
  1346.             Simplify[answer//.SimpTrigSum], 
  1347.             answer
  1348.      ]
  1349.   ] /; 
  1350.   And@@(FreeQ[Hold[v],#]&/@{HypergeometricPFQ,Hypergeometric2F1})
  1351.  
  1352.  TransfAnswer[ v_ ] := v /.{
  1353.    HypergeometricPFQ[uppar_,lowpar_,arg_] :> arg FailSum /;
  1354.     (Length[uppar] > Length[lowpar]+1) &&
  1355.     And@@(NumberQ[#]&/@Join[uppar,lowpar]) }
  1356.  
  1357.  
  1358.  TransfAnswerForProduct[ g_[f_,{r__}] v_. ] := 
  1359.     g[f,{r}] TransfAnswerForProduct[v] /; g===Sum || g===Product
  1360.  
  1361.  TransfAnswerForProduct[ v_ ] := 
  1362.   Module[ {answer},
  1363.     answer = v//.
  1364.         {(n_Integer)^(m_Integer + s_) :> n^m n^s,
  1365.           n_Rational^k_ :> Numerator[n]^k Denominator[n]^(-k),
  1366.          (n_Integer)^(m_Integer s_) :> (n^Abs[m])^(Sign[m] s)};
  1367.     If[ !FreeQ[answer, Pochhammer],
  1368.         answer = SimpPochhammer[Expand[
  1369.            answer/.Pochhammer[a_,n_]:>Pochhammer[Expand[a],n]]]];
  1370.     If[ !FreeQ[answer, Gamma],
  1371.     answer = SimplifyGamma[answer]//.
  1372.         {n_Rational^k_ :> Numerator[n]^k Denominator[n]^(-k)} ];
  1373.     If[ Length[answer] < 7,
  1374.         Simplify[answer],
  1375.         answer]
  1376.   ]
  1377.  
  1378.  complex = {
  1379.   a_ Cos[b_] + Complex[0,c_] Sin[d_] :> a E^(I b)/;a===c && b===d,
  1380.   a_ Cos[b_] + Complex[0,c_] Sin[d_] :> a E^(-I b)/;a+c===0 && b===d,
  1381.   (1 + E^(Complex[0,c_] a_.))^n_. :> E^(I c n a/2) 2^n Cos[a c/2]^n,
  1382.   (1 - E^(Complex[0,c_] a_.))^n_. :> E^(I c n a/2) 2^n Sin[a c/2]^n (-I)^n,
  1383.   (-1 + E^(Complex[0,c_] a_.))^n_. :> E^(I c n a/2) 2^n Sin[a c/2]^n I^n
  1384.    }
  1385.  
  1386.  SimpLog[ expr_/; !FreeQ[expr,Log[_]] ] :=
  1387.    Module[ {exprN,list,div,pos = {},i=0 },
  1388.      exprN = Expand[expr//.{
  1389.          Log[n_ a_] :> Log[n] + Log[a] /; NumberQ[n] && NumberQ[a],
  1390.      Log[Rational[a_,b_]] :> Log[a]-Log[b],
  1391.      Log[Power[n_, m_]]   :> m Log[n]/; NumberQ[n] && NumberQ[m]}];
  1392.      list = Union[Cases[exprN,w_. Log[n_Integer]/;FreeQ[w,Log[_]]]/.
  1393.                       w_. Log[n_] :> n];
  1394.      div = GCD@@list;
  1395.      If[ Length[list]>1 && div!=1, 
  1396.          list = Complement[list,{div}];
  1397.          SimpLog[exprN//.BuildRule[
  1398.          Log[#]&/@list ,Log[div]+Log[#]&/@(list/div) ]]
  1399.     ,
  1400.          If[ Length[list]<=2,
  1401.              exprN
  1402.          ,
  1403.              While[Length[pos]==0 && Length[list]>1, 
  1404.               i = i+ 1;
  1405.               listN = {list[[1]],#}&/@Rest[list];
  1406.               list = Rest[list];
  1407.               pos = Position[ (GCD@@#)&/@listN,a_/; a != 1 ]
  1408.              ];
  1409.              If[ Length[pos]!=0,
  1410.                  list = Take[listN,pos[[1]]][[1]];
  1411.                  div = GCD@@list; 
  1412.                  SimpLog[exprN//.BuildRule[Log[#]&/@list ,      
  1413.                          Log[div]+Log[#]&/@(list/div) ]]
  1414.          ,
  1415.                  exprN
  1416.                ]
  1417.           ]
  1418.      ]
  1419.    ]    
  1420.  
  1421.  SimpLog[ expr_ ] := expr
  1422.  
  1423.  BuildRule[{l_,lR___},{r_,rR___}] :=
  1424.   Join[{l :> r},BuildRule[{lR},{rR}]]
  1425.  
  1426.  BuildRule[{},{}] := {}
  1427.  
  1428.  
  1429.  SimpTrigSum = {
  1430.   a_. Tan[x_] + b_. Cot[x_] +c_.:> c + 2 a Csc[2 x]/;a===b,
  1431.   a_. Tanh[x_] + n_?Negative b_. Coth[x_] +c_.:> c-2 a Csch[2 x]/;
  1432.       a+b n===0&&Not[Znak[a]],
  1433.   n_?Negative a_. Tanh[x_] + b_. Coth[x_] +c_.:> c+2 a Csch[2 x]/;
  1434.       a n+b===0&&Not[Znak[b]]
  1435.   }
  1436.  
  1437.  
  1438.  LerchRule = {
  1439.   LerchPhi[z_/;!Znak[z],n_,1/2] :> 
  1440.     2 (PolyLog[n,Sqrt[z]]-PolyLog[n,-Sqrt[z]])/Sqrt[z]
  1441.    }
  1442.  
  1443.  GammaToFact = {
  1444.   Gamma[ w_ ] :> ( Gamma[Expand[w]]/.GammaToFact1 )
  1445.   }
  1446.  
  1447.  GammaToFact1 = {
  1448.   Gamma[ n_+k_Plus ] :> (n+k-1)!/; FreeQ[k,Complex] && IntegerQ[n] && n>0 &&
  1449.            And@@(!Znak[#]&/@(k/.Plus->List)),
  1450.   Gamma[ 1/2+k_Plus ] :> Sqrt[Pi] Expand[2k]!/((4^k) k!)/;
  1451.            FreeQ[k,Complex] && And@@(!Znak[#]&/@(k/.Plus->List)),
  1452.   Gamma[ n_+k_Times ] :> (n+k-1)!/;FreeQ[k,Complex] && 
  1453.            IntegerQ[n] && n>0 && Not[Znak[k]],
  1454.   Gamma[ n_+k_Symbol ] :> (n+k-1)!/;IntegerQ[n]&&n>0 && Not[Znak[k]],
  1455.   Gamma[ 1/2+k_Times ] :> Sqrt[Pi] Expand[2k]!/((4^k) k!)/;
  1456.            FreeQ[k,Complex] && Not[Znak[k]],
  1457.   Gamma[ 1/2+k_Symbol ] :> Sqrt[Pi] Expand[2k]!/((4^k) k!),
  1458.   Gamma[ 1/2-k_Symbol ] :> (-1)^k Pi/Gamma[1/2+k]
  1459.    }
  1460.  
  1461.  PochToGam = {
  1462.   Pochhammer[ w_,n_ ] :> Gamma[w+n]/Gamma[w]
  1463.    }
  1464.  
  1465.  ComPlus[b_ + f_,x_] := b + ComPlus[f,x]/;FreeQ[b,x]
  1466.  
  1467.  ComPlus[f_,x_] := 0   
  1468.  
  1469.  MultPochham[a_,k_] := Times@@(Pochhammer[#,k]&/@a)
  1470.  
  1471.  GaussRule = {
  1472.  Literal[Hypergeometric2F1][ a_,b_/;ZnakSum[b],c_,z_/;Not[Znak[z]] ] :> 
  1473.     2^c/z^b Cos[2 b ArcCos[1/Sqrt[z]]]/;
  1474.  Expand[a-b-1/2]===0 && Expand[c-2 a]===0,
  1475.  Literal[Hypergeometric2F1][ b_/;ZnakSum[b],a_,c_,z_/;Not[Znak[z]] ] :> 
  1476.     2^c/z^b Cos[2 b ArcCos[1/Sqrt[z]]]/;
  1477.   Expand[a-b-1/2]===0 && Expand[c-2 a]===0,
  1478.  Literal[Hypergeometric2F1][ n_,m_,c_,z_/;Not[Znak[z]] ] :> (-1)^(-4n) (-2n)! *
  1479.     If[ Expand[c-2 n]===0, 1/(-2 n)!, Gamma[c]/Gamma[c-2n] ] *
  1480.     (z/4)^(-n) GegenbauerC[-2n,1-c+2n,1/Sqrt[z]]/;
  1481.   ZnakSum[n] && Expand[m-n-1/2]===0 && (!NumberQ[n] || !NumberQ[m]),
  1482.  Literal[Hypergeometric2F1][ m_,n_,c_,z_/;Not[Znak[z]] ] :> (-1)^(-4n) (-2n)! *
  1483.     If[ Expand[c-2 n]===0, 1/(-2 n)!, Gamma[c]/Gamma[c-2n] ] *
  1484.     (z/4)^(-n) GegenbauerC[-2n,1-c+2n,1/Sqrt[z]]/;
  1485.  ZnakSum[n] && Expand[m-n-1/2]===0 && (!NumberQ[n] || !NumberQ[m])
  1486.  }
  1487.  
  1488. (*========================================================================*)
  1489.  
  1490.  Protect[ Sum,SymbolicSum,Product ]
  1491.  
  1492.  End[]   (* Algebra`SymbolicSum`Private` *)
  1493.  
  1494.  SetAttributes[Sum, ReadProtected]
  1495.  
  1496.  SetAttributes[SymbolicSum, ReadProtected]
  1497.  
  1498.  SetAttributes[Product, ReadProtected]
  1499.  
  1500.  EndPackage[]   (* Algebra`SymbolicSum` *)
  1501.  
  1502.  
  1503.