


BeginPackage["HYPERDIRE`"]

Print["*-*-*-*-*-* HYPERDIRE1.0 *-*-*-*-*-*\n"]

Print["*-*-*-*-*-*Version 1.0;  Last Edition: 30.11.2008*-*-*-*-*-*\n"]
Print["*-*-*-*-*-*Author: V. Bytev\n"]
Print["Email: bvv@jinr.ru"] 
Print["*-*-*-*-*-*Desription: V.Bytev, M.Yu.Kalmykov,B.Kniehl: arxiv:0904.0214"] 


simplifyPFQMultiple::usage=" moving the indexes of PFQ function up and down. First argument is parameters of PFQ, second is the 
vector of movig the parameters, last one fo the case not equal zero uses equation of motion foe high derivation removing"
explicitForm::usage=" put the answer for Mathematica calcualble way "
theta::usage=" the designation for operator variable times derivative"

Begin["`Private`"]



simplifyPFQAiUp[vector_List, (index_)?NumberQ] := Module[{excludeAi = Hold[vector[[1,index]]], listOfAi = vector[[1]], listOfBi = vector[[2]], 
     variable = vector[[3]]}, {funcP = Times @@ MapIndexed[If[#2 != {index}, theta + #1, 1] & , listOfAi]; 
      funcCi = (-excludeAi)*Times @@ (#1 - excludeAi - 1 & ) /@ listOfBi; functTiAdditional = Times @@ (#1 + theta - 1 & ) /@ listOfBi; 
      funcTi = (functTiAdditional*theta - funcCi)/(theta + excludeAi); funcTi = Apart[funcTi, theta]; operatorBm = (-(excludeAi/funcCi))*(funcTi - funcP*variable); 
      Expand[ReleaseHold[Numerator[operatorBm]]], ReplacePart[vector, ReleaseHold[excludeAi] + 1, {1, index}], Denominator[ReleaseHold[operatorBm]]}]; 
simplifyPFQBiDown[vector_List, (index_)?NumberQ] := Module[{excludeBi = Hold[vector[[2,index]]], listOfAi = vector[[1]], listOfBi = vector[[2]], 
     variable = vector[[3]]}, {funcP = Times @@ MapIndexed[If[#2 != {index}, theta + #1 - 1, 1] & , listOfBi]; funcDi = Times @@ (1 + #1 - excludeBi & ) /@ listOfAi; 
      functSiAdditional = Times @@ (#1 + theta & ) /@ listOfAi; funcSi = (functSiAdditional - funcDi)/(theta + excludeBi - 1); funcSi = Apart[funcSi, theta]; 
      operatorHp = ((excludeBi - 1)/funcDi)*(funcP*(theta/variable) - funcSi); Expand[ReleaseHold[Numerator[operatorHp]]], 
     ReplacePart[vector, ReleaseHold[excludeBi] - 1, {2, index}], Denominator[ReleaseHold[operatorHp]]}]; 
permutation[permvar1_, permvar2_, variable_] := Module[{}, {exch[(x_)?NumberQ, y_] := x*y; exch[x_, (y_)?NumberQ] := x*y; 
      exch[(x_)?NumberQ*(y_), z_] := x*exch[y, z]; exch[x_, (y_)?NumberQ*(z_)] := y*exch[x, z]; exch[x_Plus, y_] := (exch[#1, y] & ) /@ x; 
      exch[x_, y_Plus] := (exch[x, #1] & ) /@ y; exch[(x_)?(FreeQ[#1, theta] & )*(y_), k_] := x*exch[y, k]; exch[(x_)?(FreeQ[#1, theta] & ), k_] := x*k; 
      exch[x_, (y_)?(FreeQ[#1, variable] & )] := x*y; exch[x_, (y_)?(FreeQ[#1, variable] & )*(k_)] := y*exch[x, k]; 
      exch[theta, variable] := variable + variable*theta; exch[theta^(n_Integer), variable] := variable*(1 + theta)^n; 
      exch[theta, variable^(l_Integer)] := l*variable^l + variable^l*theta; exch[theta^(n_Integer), variable^(l_Integer)] := variable^l*(l + theta)^n; 
      exch[permvar1, permvar2]}]; 
Df[a_, x_, (depth_)?(#1 > 1 & )] := x*D[Df[a, x, depth - 1], x]; 
Df[a_, x_, (depth_)?(#1 == 1 & )] := x*D[a, x]; 
explicitForm[list_] := Module[{funct = HypergeometricPFQ[list[[2,1]], list[[2,2]], list[[2,3]]]}, 
    {koeftheta = CoefficientList[list[[1]], theta]; Plus @@ MapIndexed[If[#2 != {1}, #1*Df[funct, list[[2,3]], #2[[1]] - 1], #1*funct] & , koeftheta]/list[[3]]}]; 
DerivativeForPFQ[list_List, (l_)?NumberQ] := Module[{lengthFunc = Length[list[[1]]], variable = list[[3]], tempai = list[[3]]*(1 + theta)^(l - Length[list[[1]]]), 
     tempbi = theta^(l + 1 - Length[list[[1]]])}, {If[lengthFunc > l, answer = theta^l, {tempai = tempai*Times @@ (#1 + theta & ) /@ list[[1]], 
        tempbi = tempbi*Times @@ (#1 + theta - 1 & ) /@ list[[2]], If[lengthFunc == l, answer = Expand[tempai - tempbi - (variable - 1)*theta^l]/(1 - variable)], 
        If[lengthFunc < l, {answerList = CoefficientList[tempai - tempbi - (variable - 1)*theta^l, theta], 
          answer = (Plus @@ MapIndexed[#1*DerivativeForPFQ[list, #2[[1]] - 1] & , answerList])[[1]]/(1 - variable)}]}]; answer}]; 
thetaPowerRemover[equat_, vector_] := Module[{listOfTheta = CoefficientList[equat, theta]}, 
    {(Plus @@ MapIndexed[#1*DerivativeForPFQ[vector, #2[[1]] - 1] & , listOfTheta])[[1]]}]; 
simplifyPFQAiDownMultiple[vector_List, (index_)?NumberQ, (level_)?NumberQ, (maxPowerRemove_)?NumberQ] := 
   Module[{numerator = 1, denumerator = 1}, {Do[{numerator = numerator*(theta + vector[[1,index]] - i), denumerator = denumerator*(vector[[1,index]] - i), Null}, 
       {i, 1, level}]; newvector = ReplacePart[vector, vector[[1,index]] - level, {1, index}]; If[maxPowerRemove != 0, 
       numerator = thetaPowerRemover[numerator, newvector][[1]]]; numerator, newvector, denumerator}]; 
simplifyPFQAiUpMultiple[vector_List, (index_)?NumberQ, (level_)?NumberQ, (maxPowerRemove_)?NumberQ] := 
   Module[{result = {1}, vectorInWork = {1, vector, 1}, denominator = 1}, 
    {Do[{vectorInWork = simplifyPFQAiUp[vectorInWork[[2]], index], result = Expand[permutation[result[[1]], vectorInWork[[1]], vector[[3]]]], 
        denominator = denominator*vectorInWork[[3]], If[maxPowerRemove != 0, result = thetaPowerRemover[result[[1]], vectorInWork[[2]]]]}, {i, 1, level}]; 
      Expand[Apart[result[[1]], vectorInWork[[2,3]]]], vectorInWork[[2]], denominator}]; 
simplifyPFQBiUpMultiple[vector_List, (index_)?NumberQ, (level_)?NumberQ, (maxPowerRemove_)?NumberQ] := 
   Module[{numerator = 1, denumerator = 1}, {Do[{numerator = numerator*(theta + vector[[2,index]] + i - 1), denumerator = denumerator*(vector[[2,index]] + i - 1), 
        Null}, {i, 1, level}]; newvector = ReplacePart[vector, vector[[2,index]] + level, {2, index}]; 
      If[maxPowerRemove != 0, numerator = thetaPowerRemover[numerator, newvector][[1]]]; numerator, newvector, denumerator}]; 
simplifyPFQBiDownMultiple[vector_List, (index_)?NumberQ, (level_)?NumberQ, (maxPowerRemove_)?NumberQ] := 
   Module[{result = {1}, vectorInWork = {1, vector, 1}, denominator = 1}, 
    {Do[{vectorInWork = simplifyPFQBiDown[vectorInWork[[2]], index], result = Expand[permutation[result[[1]], vectorInWork[[1]], vector[[3]]]], 
        denominator = denominator*vectorInWork[[3]], If[maxPowerRemove != 0, result = thetaPowerRemover[result[[1]], vectorInWork[[2]]]]}, {i, 1, level}]; 
      Expand[Apart[result[[1]], vectorInWork[[2,3]]]], vectorInWork[[2]], denominator}]; 
simplifyPFQMultiple[vector_List, index_List, (maxPowerRemove_)?NumberQ] := Module[{result = {1}, vectorInWork = {1, vector, 1}, denominator = 1, 
     lengthOfAi = Length[vector[[1]]], lengthOfBi = Length[vector[[2]]]}, 
    {Do[{If[index[[lengthOfAi + i]] < 0, {vectorInWork = simplifyPFQBiDownMultiple[vectorInWork[[2]], i, -index[[lengthOfAi + i]], 0], 
          result = Expand[permutation[result[[1]], vectorInWork[[1]], vector[[3]]]], denominator = denominator*vectorInWork[[3]]}]}, {i, 1, lengthOfBi}]; 
      Do[{If[index[[lengthOfAi + i]] > 0, {vectorInWork = simplifyPFQBiUpMultiple[vectorInWork[[2]], i, index[[lengthOfAi + i]], 0], 
          result = Expand[permutation[result[[1]], vectorInWork[[1]], vector[[3]]]], denominator = denominator*vectorInWork[[3]]}]}, {i, 1, lengthOfBi}]; 
      Do[{If[index[[i]] < 0, {vectorInWork = simplifyPFQAiDownMultiple[vectorInWork[[2]], i, -index[[i]], 0], 
          result = Expand[permutation[result[[1]], vectorInWork[[1]], vector[[3]]]], denominator = denominator*vectorInWork[[3]]}]}, {i, 1, lengthOfAi}]; 
      If[maxPowerRemove != 0, result = Apart[thetaPowerRemover[result[[1]], vectorInWork[[2]]]], vector[[3]]]; 
      Do[{If[index[[i]] > 0, {vectorInWork = simplifyPFQAiUpMultiple[vectorInWork[[2]], i, index[[i]], maxPowerRemove], 
          result = Expand[permutation[result[[1]], vectorInWork[[1]], vector[[3]]]], denominator = denominator*vectorInWork[[3]]}]}, {i, 1, lengthOfAi}]; 
      If[maxPowerRemove != 0, result = Apart[thetaPowerRemover[result[[1]], vectorInWork[[2]]]], vector[[3]]]; result[[1]], vectorInWork[[2]], denominator}]; 
End[]
EndPackage[]
