Unprotect[C,D,N]; Clear[C]; Format[C,TeXForm]="C"; Format[D,TeXForm]="D"; Format[N,TeXForm]="N"; If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}] (*Abfrage, ob DOS-Version*) DOSFrage=MemberQ[{"MS-DOS 386","387","DOS 387"},$System]; BeginPackage["Hyp`q`"] hypqAttributes::usage = "\nDescription: Shows the current setup of the session. The setup can be \n changed by the switches \"PQ\", \"phCancel\", \"TeX\", and \"TeXphW\". The \n default-setup is shown in the following Example. \nUsage: hypqAttributes. \nSee also: PQ, phCancel, AmSTeX, AmSLaTeX, LaTeX, TeX, TeXphW." SumRegeln::usage = "\nDescription: Rule that transforms the expressions in a Sum[] into a \n form that could also be expressed in basic hypergeometric notation. \n This is useful, if you want to convert a Sum[] into basic hypergeometric \n notation but without using the ph[]-notation. In particular, expressions \n of the form (-1)^(d*k), where d is an integer and k is the summation \n index, will simplify. \nUsage: Expr/.SumRegeln \nSee also: ph, Sumph, phSum, MinusOne, Ers, PosListe." SumSammle::usage = "\nDescription: Rule that causes all terms of an expression Expr, which involves \na Sum[] to be put into the Sum[]. \nUsage: Expr/.SumSammle. \nSee also: SumRegeln, SumErw1, SumErw2, SumZerl, SumShift, SumTausche, \n pqzus, pqinfzus, Ers, PosListe." Sumph::usage = "\nDescription: Rule that transforms a Sum[] into basic hypergeometric notation, \nif possible. If the upper bound is not \"Infinity\" you have to apply \n\"SumInfinity\" first (if allowed). \nUsage: Expr/.Sumph. \nSee also: SumRegeln, SumInfinity, ph, phSum, Ers, PosListe." Sumps::usage="ja" SumPh::usage="ja" phSum::usage = "\nDescription: Rule that transforms a ph[] into a Sum[]. \nUsage: Expr/.phSum. \nSee also: ph, Sumph, Ers, PosListe." psSum::usage = "\nDescription: Rule that transforms a ps[] into a Sum[]. \nUsage: Expr/.psSum. \nSee also: ps, Sumps, Ers, PosListe." PhSum::usage = "\nDescription: Rule that transforms a Ph[] into a Sum[]. \nUsage: Expr/.PhSum. \nSee also: Ph, SumPh, Ers, PosListe." psph::usage="ja" phps::usage="ja" Phph::usage="ja" phPh::usage="ja" SumInfinity::usage = "\nDescription: Rule that changes the upper bound of a Sum[] into \"Infinity\". \nUsage: Expr/.SumInfinity. \nSee also: Sumph, Ers, PosListe." Gleichung::usage = "\nDescription: Is a variable which stores equations. The equation \"Gleichung\" \n can be manipulated using the functions \"Add\", \"Sub\", \"Mal\", \"Div\", \n \"Hoch\", \"Ers\", and Sum[m_Integer,n_Integer]. The last command causes \n the equation to be summed from m to n. \nUsage: Gleichung. \nSee also: SumListe$gl, TransListe$gl, LS, RS, Mal, Add, Div, Sub, Hoch, \n GlTausche, Ers, Subst, PSort."; LS::usage = "\nDescription: \"LS\" is the left-hand side in \"Gleichung\". \nUsage: LS. \nSee also: Gleichung, SumListe$gl, TransListe$gl, RS, Mal, Add, Div, Sub, \n Hoch, GlTausche, Ers, Subst." RS::usage = "\nDescription: \"RS\" is the right-hand side in \"Gleichung\". \nUsage: RS. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, Mal, Add, Div, Sub, \n Hoch, GlTausche, Ers, Subst." GlTausche::usage = "\nDescription: \"GlTausche\" interchanges right-hand and left-hand sides in \n \"Gleichung\". \nUsage: GlTausche. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, RS, Mal, Add, Div, \n Sub, Hoch, Ers, Subst."; Mal::usage = "\nDescription: Function that multiplies \"Gleichung\" by Expr. \nUsage: Mal[Expr]. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, RS, Add, Div, Sub, \n Hoch, GlTausche, Ers." Add::usage = "\nDescription: Function that adds Expr to \"Gleichung\". \nUsage: Add[Expr]. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, RS, Mal, Div, Sub, \n Hoch, GlTausche, Ers." Div::usage = "\nDescription: Function that divides \"Gleichung\" by Expr. \nUsage: Div[Expr]. \nSee also: Gleichung, SumListe$gl, TransListe$gl LS, RS, Mal, Add, Sub, \n Hoch, GlTausche, Ers." Sub::usage = "\nDescription: Function that subtracts Expr from \"Gleichung\". \nUsage: Sub[Expr]. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, RS, Mal, Add, Div, \n Hoch, GlTausche, Ers." Hoch::usage = "\nDescription: Function that takes \"Gleichung\" to the Expr-th power. \nUsage: Hoch[Expr]. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, RS, Mal, Add, Div, \n Sub, GlTausche, Ers." Subst::usage = "\nDescription: Function that substitutes RS instead of LS at position \n Position in Expr. The parameters LS and RS are optional. If they are \n omitted, the right-hand side \"RS\" of \"Gleichung\" is substituted \n instead of the left-hand side \"LS\" of \"Gleichung\". \nUsage: Subst[Expr,Position,LS,RS]. \nSee also: Gleichung, SumListe$gl, TransListe$gl, LS, RS, GlTausche, Ers, \n PosListe." (*negpos::usage = "\nDescription: \nUsage: Default-Variable \nSee also: " Freek::usage = "\nDescription: \nUsage: Default-Variable \nSee also: " baszerl$aut::usage = "\nDescription: \nUsage: Default-Variable \nSee also: " IntegerTest::usage = "\nDescription: \nUsage: Default-Variable \nSee also: "*) Expandq::usage = "\nDescription: Rule that expands all the exponents in powers. \nUsage: Expr/.Expandq. \nSee also: SimplifyPQ, MinusOne, SumExpand, Ers, PosListe." pq::usage = "\nDescription: pq[x,n,q] is the q-factorial symbol (x;q)_n. \n pq[List1,List2,n,q] is also provided as the usual abbreviation for the \n quotient of q-factorial symbols (see Gasper/Rahman's book). \n In both cases the parameter q is optional. It will be set equal q if it \n is omitted. \nUsage: pq[x,n,q] \n or: pq[x,n] \n or: pq[List1,List2,n,q] \n or: pq[List1,List2,n]. \nSee also: ph, pqinf, Binomialq, Binomialpq, Factorialq, Factorialpq, PQ, \n pqaufl, pqzerl, pqzus, phFormat." Binomialq::usage = "\nDescription: Binomialq[n,k,q] is the q-binomial coefficient, expanded into \n a q-series, if possible. The parameter q is optional. It will be set equal \n q if it is omitted. \nUsage: Binomialq[n,k,q] \n or: Binomialq[n,k]. \nSee also: Binomialpq, Factorialq, Factorialpq." Binomialpq::usage = "\nDescription: Binomialpq[n,k,q] is the q-binomial coefficient, written in terms \n of q-factorial symbols \"pq\". The parameter q is optional. It will be set \n equal q if it is omitted. \nUsage: Binomialpq[n,k,q] \n or: Binomialpq[n,k]. \nSee also: Binomialq, Factorialq, Factorialpq." Factorialq::usage = "\nDescription: Factorialq[n,k,q] is the usual q-factorial, expanded into \n a q-series, if possible. The parameter q is optional. It will be set \n equal q if it is omitted. \nUsage: Factorialq[n,k,q] \n or: Factorialq[n,k]. \nSee also: Binomialq, Binomialpq, Factorialpq." Factorialpq::usage = "\nDescription: Factorialpq[n,k,q] is the usual q-factorial, written in terms \n of q-factorial symbols \"pq\". The parameter q is optional. It will be set \n equal q if it is omitted. \nUsage: Factorialpq[n,k,q] \n or: Factorialpq[n,k]. \nSee also: Binomialq, Binomialpq, Factorialq." pqaufl::usage = "\nDescription: Rule that writes pq[x,n,q] as the defining product \n Product[1-x*q^i,{i,0,n-1}], if n is an integer. \nUsage: Expr/.pqaufl. \nSee also: pqzerl, pqzus, pq, pqinfzerl, pqinfzus, Ers, PosListe." pqzerl::usage = "\nDescription: Rule that splits pq[List1,List2,n,q] into a quotient of \n products of q-factorial symbols. \nUsage: Expr/.pqzerl. \nSee also: pqaufl, pqzus, pq, pqinfzerl, pqinfzus, Ers, PosListe." pqzus::usage = "\nDescription: Rule that collects several q-factorial symbols pq[x_i,n,q] to \n an expression pq[List1,List2,n,q]. The parameter q is optional. It is set \n equal q if it is omitted. \nUsage: Expr/.pqzus[n,q] \n or: Expr/.pqzus[n]. \nSee also: pqaufl, pqzerl, pq, pqinfzus, pqinfzerl, Ers, PosListe." pqinf::usage = "\nDescription: pqinf[x,q] is the infinite q-factorial symbol (x;q)_Infinity. \n pqinf[List1,List2,q] is also provided as the usual abbreviation for the \n quotient of infinite q-factorial symbols (see Gasper/Rahman's book). \n In both cases the parameter q is optional. If it is omitted it is set \n equal q. \nUsage: pqinf[x,q] \n or: pqinf[x] \n or: pqinf[List1,List2,q] \n or: pqinf[List1,List2]. \nSee also: pq, ph, PQ, pqinfzerl, pqinfzus, phFormat." pqinfzerl::usage = "\nDescription: Rule that splits pqinf[List1,List2,q] into a quotient of \n products of infinite q-factorial symbols. \nUsage: Expr/.pqinfzerl. \nSee also: pqaufl, pqzerl, pqzus, pqinf, pqinfzus, Ers, PosListe." pqinfzus::usage = "\nDescription: Rule that collects several infinite q-factorial symbols \n pqinf[x_i,q] to an expression pqinf[List1,List2,q]. The parameter \n q is optional. It is set equal q if it is omitted. \nUsage: Expr/.pqinfzus[q] \n or: Expr/.pqinfzus[]. \nSee also: pqaufl, pqzerl, pqzus, pqinf, pqinfzerl, Ers, PosListe." ph::usage = "\nDescription: ph[List1,List2,q,z] is the basic hypergeometric series with \n upper parameters List1, lower parameters List2, base q, and argument z. \nUsage: ph[List1,List2,q,z]. \nSee also: SListe, TListe, SumRegeln, Sumph, phSum, pq, pqinf, phCancel, \n phOrdne, phPerm, phTausche, PQ, phFormat." W::usage = "\nDescription: W[a,List,q,z] is the very well-poised basic hypergeometric \n series. \nUsage: W[a,List,q,z]. \nSee also: ph, TeXphW, PQ, phFormat." Ph::usage = "\nDescription: Ph[List1A,List1B,q1,List2A,List2B,q2,...,ListkA,ListkB,qk,z] \n is the multibasic basic hypergeometric series with upper parameters \n List1A and lower parameters List1B for base q1,... , with upper \n parameters ListkA and lower parameters ListkB for base qk, and \n argument z. \nUsage: Ph[List1A,List1B,q1,List2A,List2B,q2,...,ListkA,ListkB,qk,z]. \nSee also: SListe, TListe, SumRegeln, Sumph, PhSum, ph, ps, pq, pqinf, \n phCancel, phOrdne, phPerm, phTausche, PQ, phFormat." ps::usage = "\nDescription: ps[List1,List2,q,z] is the bilateral basic hypergeometric \n series with upper parameters List1, lower parameters List2, base q, \n and argument z. \nUsage: ps[List1,List2,q,z]. \nSee also: SListe, TListe, SumRegeln, Sumps, psSum, ph, Ph, pq, pqinf, \n phCancel, phOrdne, phPerm, phTausche, PQ, phFormat." PQ::usage = "\nDescription: Is a switch that activates automatic evaluating of q-factorial \n symbols pq and basic hypergeometric series ph, or makes it inactive, \n respectively. By default automatic evaluating is inactive. \nUsage: PQ. \nSee also: ph, pq, hypqAttributes." TeXphW::usage = "\nDescription: Switch that toggles between writing very well-poised basic \n hypergeometric series in terms of \"W\" and in terms of \"ph\", respectively, \n when written in TeXForm. By default very well-poised hypergeometric series \n are written in terms of \"W\". \nUsage: TeXphW. \nSee also: ph, W, hypqAttributes." phCancel::usage = "\nDescription: Switch that activates automatic cancelling of the upper and \n lower parameters in ph[], or makes it inactive, respectively. By default \n automatic cancelling is active. \nUsage: phCancel. \nSee also: ph, W, hypqAttributes." phFormat::usage = "\nDescription: Switch that activates basic hypergeometric output, or makes \n it inactive, respectively. By default basic hypergeometric output is \n active. \nUsage: phFormat." TeX::usage = "\nDescription: Switch that changes the output of TeXForm to be usable with \n Plain-TeX and LaTeX. By default the output of TeXForm is usable with \n AmS-TeX. \nUsage: TeX. \nSee also: AmSTeX, AmSLaTeX, LaTeX, TeXMat, TeXphW." LaTeX::usage = "\nDescription: Switch that changes the output of TeXForm to be usable with \n Plain-TeX and LaTeX. By default the output of TeXForm is usable with \n AmS-TeX. \nUsage: LaTeX. \nSee also: AmSTeX, AmSLaTeX, TeX, TeXMat, TeXphW." AmSTeX::usage = "\nDescription: Switch that changes the output of TeXForm to be usable with \n AmS-TeX. By default the output of TeXForm is usable with AmS-TeX. \nUsage: AmSTeX. \nSee also: AmSLaTeX, LaTeX, TeX, TeXMat, TeXphW." AmSLaTeX::usage = "\nDescription: Switch that changes the output of TeXForm to be usable with \n AmS-LaTeX. By default the output of TeXForm is usable with AmS-TeX. \nUsage: AmSLaTeX. \nSee also: AmSTeX, LaTeX, TeX, TeXMat, TeXphW." ManipulationsListe::usage = "\nDescription: Gives a list of all available rules for manipulating finite \n and infinite q-factorial symbols. \nUsage: ManipulationsListe." neg1::usage = "\nDescription: (a;q)_n -> 1/(a*q^n;q)_(-n). \nUsage: Expr/.neg1. \nSee also: neg2, Ers, PosListe, ManipulationsListe." neg2::usage = "\nDescription: (a;q)_n -> q^Binomial[n+1,2]/((-q/a)^n*(q/a;q)_(-n)). \nUsage: Expr/.neg2. \nSee also: neg1, Ers, PosListe, ManipulationsListe." trans::usage = "\nDescription: (a;q)_n -> (q^(1-n)/a;q)_n*(-a)^n*q^Binomial[n,2]. \nUsage: Expr/.trans. \nSee also: Ers, PosListe, ManipulationsListe." inv1::usage = "\nDescription: (a;q)_n -> (1/a;1/q)_n*(-a)^n*q^Binomial[n,2]. \nUsage: Expr/.inv1. \nSee also: inv2, Ers, PosListe, ManipulationsListe." inv2::usage = "\nDescription: (a;q)_n -> (a*q^(n-1);1/q)_n. \nUsage: Expr/.inv2. \nSee also: inv1, Ers, PosListe, ManipulationsListe." lina1::usage = "\nDescription: (a;q)_n -> (1-a)*(a*q;q)_(n-1), \n (a;q)_Infinity -> (1-a)*(a*q;q)_Infinity. \nUsage: Expr/.lina1. \nSee also: lina2, linz, Ers, PosListe, ManipulationsListe." lina2::usage = "\nDescription: (a;q)_n -> (1-a*q^(n-1))*(a;q)_(n-1). \nUsage: Expr/.lina2. \nSee also: lina1, linz, Ers, PosListe, ManipulationsListe." linz::usage = "\nDescription: Rule that absorbs linear terms. \nUsage: Expr/.linz. \nSee also: lina1, lina2, Ers, PosListe, ManipulationsListe." zus1::usage = "\nDescription: (a;q)_n*(a*q^n;q)_m -> (a;q)_(n+m), \n (a;q)_n*(a*q^n;q)_Infinity -> (a;q)_Infinity. \nUsage: Expr/.zus1. \nSee also: zus2, zus3, erw1, erw2, Ers, PosListe, ManipulationsListe." zus2::usage = "\nDescription: (a;q)_n/(a;q)_m -> (a*q^m;q)_(n-m), \n (a;q)_Infinity/(a;q)_m -> (a*q^m;q)_Infinity. \nUsage: Expr/.zus2. \nSee also: zus1, zus3, erw1, erw2, Ers, PosListe, ManipulationsListe." zus3::usage = "\nDescription: (a;q)_n/(b;q)_m -> (a;q)_(n-m), \n provided a*q^n=b*q^m, and \n (a;q)_Infinity/(a*q^n;q)_Infinity -> (a;q)_n. \nUsage: Expr/.zus3. \nSee also: zus1, zus2, erw1, erw2, Ers, PosListe, ManipulationsListe." erw1::usage = "\nDescription: (a;q)_n -> (a;q)_(m+n)/(a*q^n;q)_m, \n (a;q)_n -> (a;q)_Infinity/(a*q^n;q)_Infinity. \n The parameter m has to be entered on request. To apply the second rule, \n m has to be \"Infinity\". \nUsage: Expr/.erw1. \nSee also: erw2, zus1, zus2, zus3, Ers, PosListe, ManipulationsListe." erw2::usage = "\nDescription: (a;q)_n -> (a/q^m;q)_(m+n)/(a/q^m;q)_m, \n (a;q)_Infinity -> (a/q^m;q)_Infinity/(a/q^m;q)_m. \n The parameter m has to be entered on request. To apply the second rule, \n m has to be \"Infinity\". \nUsage: Expr/.erw2. \nSee also: erw1, zus1, zus2, zus3, Ers, PosListe, ManipulationsListe." zerl::usage = "\nDescription: (a;q)_n -> (a;q)_m*(a*q^m;q)_(n-m), \n (a;q)_Infinity -> (a;q)_m*(a*q^m;q)_Infinity. \n The parameter m has to be entered on request. \nUsage: Expr/.zerl. \nSee also: Ers, PosListe, ManipulationsListe." baszerl1::usage = "\nDescription: (a;q)_n -> Product[(a*q^k;q^m)_(n/m),{k,0,m-1}], \n (a;q)_Infinity -> Product[(a*q^k;q^m)_Infinity,{k,0,m-1}]. \n The parameter m has to be entered on request. \nUsage: Expr/.baszerl1. \nSee also: baszerl2, baszus1, baszus2, Ers, PosListe, ManipulationsListe." baszus1::usage = "\nDescription: (a;q)_n -> (a;q^(1/m))_(m*n)/ \n Product[(a*q^(k/m);q)_n,{k,1,m-1}], \n (a;q)_Infinity -> (a;q^(1/m))_Infinity/ \n Product[(a*q^(k/m);q)_Infinity,{k,1,m-1}]. \n The parameter m has to be entered on request. \n This operation is basically the inverse of baszerl1. \nUsage: Expr/.baszus1. \nSee also: Ers, PosListe, ManipulationsListe." baszerl2::usage = "\nDescription: \n (a;q)_n -> Product[(E^(2*I*Pi*(k/m))*a^(1/m);q^(1/m))_n,{k,0,m-1}], \n (a;q)_Infinity -> Product[(E^(2*I*Pi*(k/m))*a^(1/m);q^(1/m))_Infinity, \n {k,0,m-1}]. \n The parameter m has to be entered on request. \nUsage: Expr/.baszerl2. \nSee also: Ers, PosListe, ManipulationsListe." baszus2::usage = "\nDescription: \n (a;q)_n -> (a^m;q^m)_n/Product(E^(2*I*Pi*(k/m))*a,q)_n,{k,1,m-1}], \n (a;q)_Infinity -> (a^m;q^m)_Infinity/ \n Product(E^(2*I*Pi*(k/m))*a,q)_Infinity,{k,1,m-1}]. \n The parameter m has to be entered on request. \n This operation is basically the inverse of baszerl2. \nUsage: Expr/.baszus2. \nSee also: Ers, PosListe, ManipulationsListe." Ers::usage = "\nDescription: Function for controlled application of rules and functions. \nUsage: Ers[Expr,Rules,PosList]. \n \"Rules\" can be a rule, a list of rules, or a function. PosList must \n be a list of positions in Expr to which \"Rules\" should be applied. \n For instance, if PosList={{1,2},{4}}, then \"Rules\" is applied to \n Expr[[1,2]] and Expr[[4]] in Expr. If PosList={2,3}, then \"Rules\" is \n applied to Expr[[2]] and Expr[[3]] in Expr. The positions of \n subexpressions can be found by the function \"PosListe\". \nSee also: PosListe, ManipulationsListe, Subst." PosListe::usage = "\nDescription: Function that provides a list of subexpressions of Expr \n together with the respective positions in Expr. This helps to use \n controlled application of rules or functions by means of \"Ers\". \nUsage: PosListe[Expr]. \nSee also: Ers, Subst." SimplifyPQ::usage = "\nDescription: Rule that simplifies arguments in pq, pqinf, ph, Sum, and \n expands exponents in powers. \nUsage: Expr/.SimplifyPQ. \nSee also: Expandq, MinusOne, SumExpand, PQSort." SumExpand::usage = "\nDescription: Rule that expands Sums. \nUsage: Expr/.SumExpand. \nSee also: SimplifyP, Expandq, MinusOne, PSort." PQSort::usage = "\nDescription: Rule that orders the parameters of basic hypergeometric \n series ph[List1,List2,q,z], of \"multiple\" upper q-factorials \n pq[List1,List2,n,q], and of \"multiple\" infinite q-factorials \n pqinf[List1,List2,q] in a standard order. This function should be \n used for a quick test of the validity of an equation. \nUsage: Expr/.PQSort. \nSee also: SimplifyPQ, SumExpand, phEinf, phOrdne, phPerm, phTausche, ph, \n W, pq, pqinf." phEinf::usage = "\nDescription: Rule that inactivates automatic cancelling in ph[] and then \n adds a parameter which has to be entered on request to the upper and \n lower parameters of ph[]. \nUsage: Expr/.phEinf. \nSee also: phOrdne, phPerm, phTausche, PQSort, SumRegeln, SumUmkehr, Ers, \n PosListe." phOrdne::usage = "\nDescription: Rule that tries to order the parameters of a basic \n hypergeometric series in \"well-poised\" order. If there is an \n upper parameter of the form q^(-n_NonnegativeInteger), then it \n is put at the very last place in the upper list. If the parameters \n could be paired such that the product of each pair equals A, however A \n is missing in the upper parameters, then you have to add A to the upper \n and lower parameters by \"phEinf\" before applying \"phOrdne\". \nUsage: Expr/.phOrdne. \nSee also: phEinf, phPerm, phTausche, ph, W, PQSort, Ers, PosListe." psOrdne::usage="ja" psShift::usage="ja" phPerm::usage = "\nDescription: Rule for permuting parameters in basic hypergeometric series. \nUsage: Expr/.phPerm[,x]. \n x can be u,l,b. u causes a permutation of upper parameters, l causes a \n permutation of lower parameters, b causes a simultaneous permutation \n of respective upper and lower parameters. \"Permutation\" must be a \n sequence of positive numbers forming a permutation. The effect is that \n the new parameter at position i is the old parameter from position \n Permutation[i]. \nSee also: phOrdne, ph, W, PQSort, Ers, PosListe, PhPerm, psPerm." psPerm::usage = "\nDescription: Rule for permuting parameters in bilateral basic \n hypergeometric series. \nUsage: Expr/.psPerm[,x]. \n x can be u,l,b. u causes a permutation of upper parameters, l causes a \n permutation of lower parameters, b causes a simultaneous permutation \n of respective upper and lower parameters. \"Permutation\" must be a \n sequence of positive numbers forming a permutation. The effect is that \n the new parameter at position i is the old parameter from position \n Permutation[i]. \nSee also: psOrdne, ps, PQSort, Ers, PosListe, phPerm, PhPerm." phTausche::usage = "\nDescription: Rule for reordering parameters in basic hypergeometric series. \nUsage: Expr/.phTausche[n1,n2,x]. \n x can be u,l,b. u causes a reordering of upper parameters, l causes a \n reordering of lower parameters, b causes a simultaneous reordering \n of respective upper and lower parameters. n1 is the position of the \n parameter to be reordered, n2 is the new position. \nSee also: phPerm, phOrdne, ph, W, PQSort, Ers, PosListe." SumErw1::usage = "\nDescription: Rule that extends a Sum[] at the top. \n Sum[Expr,{k,l,n}] -> Sum[Expr,{k,l,n+m}]-Sum[Expr,{k,n+1,n+m}]. \n The parameter m has to be entered on request. \nUsage: Expr/.SumErw1. \nSee also: SumErw2, SumZerl, SumShift, SumTausche, SumRegeln, SumUmkehr, \n Ers, PosListe." SumErw2::usage = "\nDescription: Rule that extends a Sum[] at the bottom. \n Sum[Expr,{k,l,n}] -> Sum[Expr,{k,l-m,n}]-Sum[Expr,{k,l-m,l-1}]. \n The parameter m has to be entered on request. \nUsage: Expr/.SumErw2. \nSee also: SumErw1, SumZerl, SumShift, SumTausche, SumRegeln, SumUmkehr, \n Ers, PosListe." SumTausche::usage = "\nDescription: Rule that exchanges summations. \n Sum[Sum[Expr,{k1,l1,n1}],{k2,l2,n2}] \n -> Sum[Sum[Expr,{k2,l2,n2}],{k1,l1,n1}]. \nUsage: Expr/.SumTausche. \nSee also: SumErw1, SumErw2, SumSammle, SumShift, SumZerl, SumRegeln, \n SumUmkehr, Ers, PosListe." SumZerl::usage = "\nDescription: Rule that splits a Sum[] into two parts. \n Sum[Expr,{k,l,n}] -> Sum[Expr,{k,l,l+m-1}]+Sum[Expr,{k,l+m,n}]. \n The parameter m has to be entered on request. \nUsage: Expr/.SumZerl. \nSee also: SumErw1, SumErw2, SumShift, SumTausche, SumRegeln, SumUmkehr, \n Ers, PosListe." SumShift::usage = "\nDescription: Rule that shifts the index in a Sum[]. \n Sum[Expr[k],{k,l,n}] -> Sum[Expr[k+m],{k,l-m,n-m}]. \n The parameter m has to be entered on request. \nUsage: Expr/.SumShift. \nSee also: SumErw1, SumErw2, SumTausche, SumZerl, SumRegeln, SumUmkehr, \n Ers, PosListe." SumUmkehr::usage = "\nDescription: Rule that reverses the order of summation. \"SumUmkehr\" \n applies to Sum[] as well as ph[]. \nUsage: Expr/.SumUmkehr. \nSee also: SumErw1, SumErw2, SumZerl, SumShift, SumTausche, SumRegeln, \n Ers, PosListe." phinv::usage = "\nDescription: Rule that transforms a basic hypergeometric series \n ph[List1,List2,q,z] with base q into a basic hypergeometric series \n ph[...,1/q,..] with base 1/q. \nUsage: Expr/.phinv. \nSee also: SumRegeln, Ers, PosListe, Phinv, psinv." Phinv::usage = "\nDescription: Rule that transforms a multibasic hypergeometric series \n Ph[List1A,List1B,q1,List2A,List2B,q2,...,ListkA,ListkB,qk,z] \n with bases q1,..., into a multibasic hypergeometric series \n Ph[...,1/q1,,...,1/q2,...,...,1/qk,z] with bases 1/q1,... \nUsage: Expr/.Phinv. \nSee also: SumRegeln, Ers, PosListe, phinv, psinv." psinv::usage = "\nDescription: Rule that transforms a bilateral basic hypergeometric series \n ps[List1,List2,q,z] with base q into a bilateral basic hypergeometric \n series ps[...,1/q,..] with base 1/q. \nUsage: Expr/.psinv. \nSee also: SumRegeln, Ers, PosListe, phinv, Phinv." TeXMat::usage = "\nDescription: Function that writes (to be precise: appends) an expression \n Expr in InputForm to a file \"[name].m\" and the TeXForm of Expr to the \n file \"[name].tex\". The expressions are numbered automatically. The \n number can be reset by \"SchreibeZahl\". The string \"comment\" is \n optional. It allows to place the comment \"comment\" above the expression \n in each of the two files. \nUsage: TeXMat[Expr,name,comment]. \nSee also: AmSTeX, AmSLaTeX, LaTeX, TeX, TeXphW, SchreibeZahl." SchreibeZahl::usage = "\nDescription: Variable that counts the number of expressions already written \n by using \"TeXMat\". Can be reset by defining a new value. \nUsage: SchreibeZahl=n_Integer. \nSee also: TeXMat." Drucke::usage = "\nDescription: Function that directly sends an expression Expr in the \n Form PrintedForm to the printer. PrintedForm is an optional parameter \n which can be any of the format types (\"InputForm\", \"OutputForm\", \n \"TeXForm\", ...). The default is \"OutputForm\". \nUsage: Drucke[Expr,PrintedForm]. \nSee also: TeXMat, AmSTeX, AmSLaTeX, LaTeX, TeX, TeXphW." Limes::usage = "\nDescription: Function for doing formal limits of basic hypergeometric \n expressions. If required for taking the limit, you will be asked whether \n or not the absolute value of some variable or expression is smaller than \n 1. Your decision is stored for the rest of your MATHEMATICA session. If \n you want to change your decision later, use \"AbsGreater\", \"AbsSmaller\", \n or \"AbsUndetermined\", respectively. \n By default the absolute value of q is defined to be smaller than 1. Also \n this can be changed by \"AbsGreater\", \"AbsSmaller\", or \"AbsUndetermined\", \n respectively. \nWarning: This function uses primitive algebraic techniques to do the \n limit. There is no check if taking the limit is actually allowed. So it \n is left to you to check the validity of a result of \"Limes\". \nUsage: Limes[Expr, x->x0]. \nSee also: AbsGreater, AbsSmaller, AbsUndetermined, MinusOne." AbsGreater::usage = "\nDescription: Function for declaring the absolute value of a variable or \n expression to be greater than 1. This declaration is used by \"Limes\". \n By default the absolute value of q is defined to be smaller than 1. \nUsage: AbsGreater[Expr]. \nSee also: AbsSmaller, AbsUndetermined, Limes." AbsSmaller::usage = "\nDescription: Function for declaring the absolute value of a variable or \n expression to be smaller than 1. This declaration is used by \"Limes\". \n By default the absolute value of q is defined to be smaller than 1. \nUsage: AbsSmaller[Expr]. \nSee also: AbsGreater, AbsUndetermined, Limes." AbsUndetermined::usage = "\nDescription: Function for declaring the absolute value of a variable or \n expression to be neither smaller nor greater than 1. This declaration \n is used by \"Limes\". \nUsage: AbsUndetermined[Expr]. \nSee also: AbsGreater, AbsSmaller, Limes."; MinusOne::usage = "\nDescription: Rule for getting rid of expressions of the form (-1)^N where \n N is an even or odd integer. \nUsage: Expr/.MinusOne. \nSee also: SimplifyPQ, Expandq, SumExpand." Begin["`Private`"] (*Hilfsdefinition fr den Durchschnitt zur Umgehung des Bugs in Version 1.2*) intersection[L1_List,L2_List]:=If[$VersionNumber<2., Select[Intersection[L1,L2],(MemberQ[L1,#]&&MemberQ[L2,#])&], Intersection[L1,L2]] (*Belegen von Module durch Block fr Versionen 1.?*) If[$VersionNumber<2.,Module=Block] (*Definieren der OutputForm und TeXForm von pq, pqinf und ph*) (*Der TeX-Switch ist auf Plain-TeX, LaTeX eingestellt, falls ifTeX=TeXtrue, auf AmS-TeX, falls ifTeX=AmSTeXtrue, auf AmS-LaTeX, falls ifTeX=AmSLaTeXtrue.*) ifTeX=AmSTeXtrue; TeX:=(ifTeX=TeXtrue;); LaTeX:=(ifTeX=TeXtrue;); AmSTeX:=(ifTeX=AmSTeXtrue;); AmSLaTeX:=(ifTeX=AmSLaTeXtrue;); Argument[List[x___]]:=x; Beistrich[B_]:=Sequence[B,", "]; pqOutput[x__]:=Apply[SequenceForm,Drop[Map[Beistrich,{x}],-1]]; pqOutput[]:="-"; pqTeXForm[]:="-"; pqTeXForm[x__]:=(X=Map[ToString[TeXForm[#]]&,{x}]; X=Argument[X]; ToString[StringForm[StringJoin[Argument[Table["``, ",{Length[{x}]-1}]],"``"],X]] ); TeXRules:= (Format[pq[{a__},{},n_,q_:Global`q]]:= SequenceForm["(",pqOutput[a],"; ",q,")",Subscript[n]]; Format[pq[{},{b__},n_,q_:Global`q]]:= 1/SequenceForm["(",pqOutput[b],"; ",q,")",Subscript[n]]; Format[pq[{a__},{b__},n_,q_:Global`q]]:= SequenceForm["(",pqOutput[a],"; ",q,")",Subscript[n]]/ SequenceForm["(",pqOutput[b],"; ",q,")",Subscript[n]]; Format[pq[{a__},{},n_,q_:Global`q],TeXForm]:= StringJoin["({\\let \\over / ",pqTeXForm[a],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[n]],"} "]; Format[pq[{},{b__},n_,q_:Global`q],TeXForm]:= StringJoin["{1 \\over {({\\let \\over / ",pqTeXForm[b],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[n]],"}}} "]; Format[pq[{a__},{b__},n_,q_:Global`q],TeXForm]:= StringJoin["{{({\\let \\over / ",pqTeXForm[a],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[n]],"}} \\over ", "{({\\let \\over / ",pqTeXForm[b],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[n]],"}}} "]; Format[pq[{a__},n_,q_:Global`q]]:=SequenceForm["(",pqOutput[a],"; ",q,")",Subscript[n]]; Format[pq[{a__},n_,q_:Global`q],TeXForm]:= StringJoin["({\\let \\over / ",ToString[pqTeXForm[a]],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[n]],"} "]; Format[pq[a_,n_,q_:Global`q]]:=SequenceForm["(",a,"; ",q,")",Subscript[n]]; Format[pq[a_,n_,q_:Global`q],TeXForm]:= StringJoin["({\\let \\over / ",ToString[TeXForm[a]],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[n]],"} "]; Format[pqinf[{a__},{},q_:Global`q]]:= SequenceForm["(",pqOutput[a],"; ",q,")", Subscript[If[Global`DOSFrage,"","Inf"]]]; Format[pqinf[{},{b__},q_:Global`q]]:= 1/SequenceForm["(",pqOutput[b],"; ",q,")", Subscript[If[Global`DOSFrage,"","Inf"]]]; Format[pqinf[{a__},{b__},q_:Global`q]]:= SequenceForm["(",pqOutput[a],"; ",q,")", Subscript[If[Global`DOSFrage,"","Inf"]]]/ SequenceForm["(",pqOutput[b],"; ",q,")", Subscript[If[Global`DOSFrage,"","Inf"]]]; Format[pqinf[{a__},{},q_:Global`q],TeXForm]:= StringJoin["({\\let \\over / ",pqTeXForm[a],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[Infinity]],"} "]; Format[pqinf[{},{b__},q_:Global`q],TeXForm]:= StringJoin["{1 \\over {({\\let \\over / ",pqTeXForm[b],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[Infinity]],"}}} "]; Format[pqinf[{a__},{b__},q_:Global`q],TeXForm]:= StringJoin["{ {(\\let \\over / ",pqTeXForm[a]," ;", ToString[TeXForm[q]],") _\\infty} \\over {(\\let \\over / ", pqTeXForm[b]," ;",ToString[TeXForm[q]],") _\\infty} }"]; Format[pqinf[a_,q_:Global`q],TeXForm]:= StringJoin["({\\let \\over / ",ToString[TeXForm[a]],"}; ",ToString[TeXForm[q]], ") _{",ToString[TeXForm[Infinity]],"} "]; Format[pqinf[a_,q_:Global`q]]:=StringForm["(`1`;`2`)`3`",a,q, Subscript[If[Global`DOSFrage,"","Inf"]]]; Format[ph[{La___},{Lb___},q_,z_],TeXForm]:=Module[{ErgEx}, If[Switch[ifTeXphW,1,(Length[{La}]>=3&&Length[{Lb}]>=2&& Length[{La}]-Length[{Lb}]===1&& Factor[{La}[[2]]+{La}[[3]]]===0&& Factor[{La}[[1]]-({La}[[2]])^2/q^2]===0&& Factor[Map[(q*{La}[[1]]/#)&,Drop[{La},1]]-{Lb}]===Table[0,{Length[{Lb}]}]), 0,False], Unprotect[Power,Times]; Power[a_*b_,m_]=.; If[$VersionNumber>=2.,a_^m_*b_^m_ :=(a*b)^m/;Head[m]=!=Integer]; ErgEx=StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} W _{", ToString[TeXForm[Length[{Lb}]]],"} ({\\displaystyle ",ToString[TeXForm[{La}[[1]]]],"; ", pqTeXForm[Argument[Drop[{La},3]]],"}; ",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"})"]; If[$VersionNumber>=2.,a_^m_*b_^m_=.]; Power[a_*b_,m_]:=a^m*b^m; Protect[Power,Times]; ErgEx, Unprotect[Power,Times]; Power[a_*b_,m_]=.; If[$VersionNumber>=2.,a_^m_*b_^m_ :=(a*b)^m/;Head[m]=!=Integer]; ErgEx=Switch[ifTeX, TeXtrue,StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} \\phi _{", ToString[TeXForm[Length[{Lb}]]],"} \\! \\left [ \\matrix { \\let \\over / ", pqTeXForm[La],"\\cr \\let \\over / ", pqTeXForm[Lb],"} ;",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"], AmSTeXtrue,StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} \\phi _{", ToString[TeXForm[Length[{Lb}]]],"} \\! \\left [ \\matrix \\let \\over / ", pqTeXForm[La],"\\\\ \\let \\over / ", pqTeXForm[Lb],"\\endmatrix ;",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"], AmSLaTeXtrue,StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} \\phi _{", ToString[TeXForm[Length[{Lb}]]],"} \\! \\left [ \\begin{matrix} \\let \\over / ", pqTeXForm[La],"\\\\ \\let \\over / ", pqTeXForm[Lb],"\\end{matrix} ;",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"] ]; If[$VersionNumber>=2.,a_^m_*b_^m_=.]; Power[a_*b_,m_]:=a^m*b^m; Protect[Power,Times]; ErgEx ]]; Format[ph[{a___},{b___},q_,z_]]:= If[Global`DOSFrage, SequenceForm[Subscript[Length[{a}]],"",Subscript[Length[{b}]], ColumnForm[{" "," "," "," "," "},Center,Center], ColumnForm[{pqOutput[a]," ",pqOutput[b]},Center,Center], "; ",q,", ",z, ColumnForm[{" "," "," "," "," "},Center,Center]], SequenceForm[Subscript[Length[{a}]],"ph",Subscript[Length[{b}]], ColumnForm[{"[ ","| ","| ","| ","[ "},Center,Center], ColumnForm[{pqOutput[a]," ",pqOutput[b]},Center,Center], "; ",q,", ",z, ColumnForm[{" ]"," |"," |"," |"," ]"},Center,Center]]]; (*Definitionen fr mehrbasische hypergeometrische Reihen*) Format[Ph[L___,z_],TeXForm]:=Module[{ErgEx,TopTeX,BottomTeX,BasTeX}, If[IntegerQ[Length[{L}]/3], Unprotect[Power,Times]; Power[a_*b_,m_]=.; If[$VersionNumber>=2.,a_^m_*b_^m_ :=(a*b)^m/;Head[m]=!=Integer]; TopTeX=Table[{L}[[3*ii+1]],{ii,0,(Length[{L}]-1)/3}]; TopTeX=Join[Table[StringJoin[Apply[pqTeXForm,TopTeX[[ii]]],": "], {ii,1,Length[TopTeX]-1}],{Apply[pqTeXForm,TopTeX[[Length[TopTeX]]]]}]; TopTeX=Apply[StringJoin,TopTeX]; BottomTeX=Table[{L}[[3*ii+2]],{ii,0,(Length[{L}]-2)/3}]; BottomTeX=Join[Table[StringJoin[Apply[pqTeXForm,BottomTeX[[ii]]],": "], {ii,1,Length[BottomTeX]-1}],{Apply[pqTeXForm,BottomTeX[[Length[BottomTeX]]]]}]; BottomTeX=Apply[StringJoin,BottomTeX]; BasTeX=Table[{L}[[3*ii+3]],{ii,0,(Length[{L}]-3)/3}]; BasTeX=Join[Table[StringJoin[ToString[TeXForm[BasTeX[[ii]]]],", "], {ii,1,Length[BasTeX]-1}],{ToString[TeXForm[BasTeX[[Length[BasTeX]]]]]}]; BasTeX=Apply[StringJoin,BasTeX]; ErgEx=Switch[ifTeX, TeXtrue,StringJoin["{} \\Phi \\! \\left [ \\matrix { \\let \\over / ", TopTeX,"\\cr \\let \\over / ", BottomTeX,"} ;",BasTeX,"; {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"], AmSTeXtrue,StringJoin["{} \\Phi \\! \\left [ \\matrix \\let \\over / ", TopTeX,"\\\\ \\let \\over / ", BottomTeX,"\\endmatrix ;",BasTeX,"; {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"], AmSLaTeXtrue,StringJoin["{} \\Phi \\! \\left [ \\begin{matrix} \\let \\over / ", TopTeX,"\\\\ \\let \\over / ", BottomTeX,"\\end{matrix} ;",BasTeX,"; {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"] ]; If[$VersionNumber>=2.,a_^m_*b_^m_=.]; Power[a_*b_,m_]:=a^m*b^m; Protect[Power,Times]; ErgEx, TeXForm[Ph[L,z]] ]]; Format[Ph[L___,z_]]:=Module[{TopL,BottomL,BasL}, If[IntegerQ[Length[{L}]/3], TopL=Table[{L}[[3*ii+1]],{ii,0,(Length[{L}]-1)/3}]; TopL=SequenceForm[Apply[SequenceForm, Table[SequenceForm[pqOutput[Argument[TopL[[ii]]]],": "],{ii,1,Length[TopL]-1}]], pqOutput[Argument[TopL[[Length[TopL]]]]]]; BottomL=Table[{L}[[3*ii+2]],{ii,0,(Length[{L}]-2)/3}]; BottomL=SequenceForm[Apply[SequenceForm, Table[SequenceForm[pqOutput[Argument[BottomL[[ii]]]],": "],{ii,1,Length[BottomL]-1}]], pqOutput[Argument[BottomL[[Length[BottomL]]]]]]; BasL=Table[{L}[[3*ii+3]],{ii,0,(Length[{L}]-3)/3}]; If[Global`DOSFrage, SequenceForm["", ColumnForm[{" "," "," "," "," "},Center,Center], ColumnForm[{pqOutput[TopL]," ",pqOutput[BottomL]},Center,Center], "; ",pqOutput[Argument[BasL]],"; ",z, ColumnForm[{" "," "," "," "," "},Center,Center]], SequenceForm["Ph", ColumnForm[{"[ ","| ","| ","| ","[ "},Center,Center], ColumnForm[{pqOutput[TopL]," ",pqOutput[BottomL]},Center,Center], "; ",pqOutput[Argument[BasL]],"; ",z, ColumnForm[{" ]"," |"," |"," |"," ]"},Center,Center]]], Ph[L,z] ]]; (*Definitionen fr bilaterale Reihen*) Format[ps[{La___},{Lb___},q_,z_],TeXForm]:=Module[{ErgEx}, If[Switch[ifTeXphW,1,(Length[{La}]>=3&&Length[{Lb}]>=2&& Length[{La}]-Length[{Lb}]===1&& Factor[{La}[[2]]+{La}[[3]]]===0&& Factor[{La}[[1]]-({La}[[2]])^2/q^2]===0&& Factor[Map[(q*{La}[[1]]/#)&,Drop[{La},1]]-{Lb}]===Table[0,{Length[{Lb}]}]), 0,False], Unprotect[Power,Times]; Power[a_*b_,m_]=.; If[$VersionNumber>=2.,a_^m_*b_^m_ :=(a*b)^m/;Head[m]=!=Integer]; ErgEx=StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} W _{", ToString[TeXForm[Length[{Lb}]]],"} ({\\displaystyle ",ToString[TeXForm[{La}[[1]]]],"; ", pqTeXForm[Argument[Drop[{La},3]]],"}; ",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"})"]; If[$VersionNumber>=2.,a_^m_*b_^m_=.]; Power[a_*b_,m_]:=a^m*b^m; Protect[Power,Times]; ErgEx, Unprotect[Power,Times]; Power[a_*b_,m_]=.; If[$VersionNumber>=2.,a_^m_*b_^m_ :=(a*b)^m/;Head[m]=!=Integer]; ErgEx=Switch[ifTeX, 0,StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} \\psi _{", ToString[TeXForm[Length[{Lb}]]],"} \\! \\left [ \\matrix { \\let \\over / ", pqTeXForm[La],"\\cr \\let \\over / ", pqTeXForm[Lb],"} ;",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"], 1,StringJoin["{} _{",ToString[TeXForm[Length[{La}]]],"} \\psi _{", ToString[TeXForm[Length[{Lb}]]],"} \\! \\left [ \\matrix \\let \\over / ", pqTeXForm[La],"\\\\ \\let \\over / ", pqTeXForm[Lb],"\\endmatrix ;",ToString[TeXForm[q]],", {\\displaystyle ", ToString[TeXForm[z]],"} \\right ]"] ]; If[$VersionNumber>=2.,a_^m_*b_^m_=.]; Power[a_*b_,m_]:=a^m*b^m; Protect[Power,Times]; ErgEx ]]; Format[ps[{a___},{b___},q_,z_]]:= If[Global`DOSFrage, SequenceForm[Subscript[Length[{a}]],"ps",Subscript[Length[{b}]], ColumnForm[{" "," "," "," "," "},Center,Center], ColumnForm[{pqOutput[a]," ",pqOutput[b]},Center,Center], "; ",q,", ",z, ColumnForm[{" "," "," "," "," "},Center,Center]], SequenceForm[Subscript[Length[{a}]],"ps",Subscript[Length[{b}]], ColumnForm[{"[ ","| ","| ","| ","[ "},Center,Center], ColumnForm[{pqOutput[a]," ",pqOutput[b]},Center,Center], "; ",q,", ",z, ColumnForm[{" ]"," |"," |"," |"," ]"},Center,Center]]] ); TeXRules; Format::toobig="Expression too big for output.\nEnter \"phFormat\" and retry."; ifphFormat=1; phFormat:=(Switch[ifphFormat, 0,Unprotect[ph,Ph,ps,pq,pqinf]; Attributes[Format]={Protected,HoldAll}; TeXRules; Attributes[Format]={Protected}; Protect[ph,Ph,ps,pq,pqinf], 1,Unprotect[ph,Ph,ps,pq,pqinf]; Attributes[Format]={Protected,HoldAll}; Format[ph[{a___},{b___},q_,z_]]=.; Format[Ph[L___,z_]]=.; Format[ps[{a___},{b___},q_,z_]]=.; Format[pqinf[a_,q_:Global`q]]=.; Format[pqinf[{a__},{b__},q_:Global`q]]=.; Format[pqinf[{},{b__},q_:Global`q]]=.; Format[pqinf[{a__},{},q_:Global`q]]=.; Format[pq[a_,n_,q_:Global`q]]=.; Format[pq[{a__},n_,q_:Global`q]]=.; Format[pq[{a__},{b__},n_,q_:Global`q]]=.; Format[pq[{},{b__},n_,q_:Global`q]]=.; Format[pq[{a__},{},n_,q_:Global`q]]=.; Attributes[Format]={Protected}; Protect[ph,Ph,ps,pq,pqinf]; ];ifphFormat=1-ifphFormat;) (*Rechenregeln fr pq, ph, W und pqinf*) ListTest[Liste_]:=MemberQ[{Head[Liste]},List]; W[a_,x_List,q_,z_]:=ph[Join[{a,q*Sqrt[a],-q*Sqrt[a]},x], Join[{Sqrt[a],-Sqrt[a]},Map[Cancel[q*a/#]&,x]],q,z]; Rules:= (Unprotect[Times,Power]; pq[x_,n_,0]=1; pq[x_,n_,1]:=(1-x)^n/;Head[n]=!=List; pq[x_,0,q_:Global`q]=1; pq[0,n_,q_:Global`q]=1; pq[1,n_,q_:Global`q]:=0/;n>0; pq[x_,n_]:=pq[x,n,Global`q]; pq[x_List,y_List,0,q_:Global`q]=1; pq[x_List,y_List,n_]:=pq[x,y,n,Global`q]; pq[x_List,y_List,n_,q_]:=Module[{POSX,POSY,Intsec,X=x,Y=y}, While[(Intsec=intersection[X,Y])!={}, Intsec=Intsec[[1]]; POSX=Select[Position[X,Intsec],(Length[#]<=1)&][[1,1]]; POSY=Select[Position[Y,Intsec],(Length[#]<=1)&][[1,1]]; X=Drop[X,{POSX,POSX}]; Y=Drop[Y,{POSY,POSY}]; ]; pq[X,Y,n,q] ] /; intersection[x,y]!={}; pq/: pq[x_List,y_List,n_,q_:Global`q]*pq[z_List,u_List,n_,q_:Global`q]:= pq[Join[x,z],Join[y,u],n,q]; pq/: pq[x_List,y_List,n_,q_:Global`q]^(-1):=pq[y,x,n,q]; pq/: pq[x_List,y_List,n_,q_:Global`q]*pq[z_,n_,q_:Global`q]^(exp_:1):= pq[Join[x,Table[z,{exp}]],y,n,q]/;exp>0; pq/: pq[x_List,y_List,n_,q_:Global`q]*pq[z_,n_,q_:Global`q]^(exp_:1):= pq[x,Join[y,Table[z,{-exp}]],n,q]/;exp<0; pq[{},{},n_,q_:Global`q]:=1; pqinf[x_,0]=1; pqinf[0,q_:Global`q]=1; pqinf[1,q_:Global`q]=0; pqinf[x_]:=pqinf[x,Global`q]; pqinf[List1_List,List2_List]:=pqinf[List1,List2,Global`q]; pqinf[x_List,y_List,q_:Global`q]:=Module[{POSX,POSY,Intsec,X=x,Y=y}, While[(Intsec=intersection[X,Y])!={}, Intsec=Intsec[[1]]; POSX=Select[Position[X,Intsec],(Length[#]<=1)&][[1,1]]; POSY=Select[Position[Y,Intsec],(Length[#]<=1)&][[1,1]]; X=Drop[X,{POSX,POSX}]; Y=Drop[Y,{POSY,POSY}]; ]; pqinf[X,Y,q] ] /; intersection[x,y]!={}; pqinf/: pqinf[x_List,y_List,q_:Global`q]*pqinf[z_List,u_List,q_:Global`q]:= pqinf[Join[x,z],Join[y,u],q]; pqinf/: pqinf[x_List,y_List,q_:Global`q]^(-1):=pqinf[y,x,q]; pqinf/: pqinf[x_List,y_List,q_:Global`q]*pqinf[z_,q_:Global`q]^(exp_:1):= pqinf[Join[x,Table[z,{exp}]],y,q]/;exp>0; pqinf/: pqinf[x_List,y_List,q_:Global`q]*pqinf[z_,q_:Global`q]^(exp_:1):= pqinf[x,Join[y,Table[z,{-exp}]],q]/;exp<0; pqinf[{},{},q_:Global`q]:=1; ph[List1_List,List2_List,q_,0]=1; ph[List1_List,List2_List,q_,z_]:=1/;MemberQ[List1,1]&& !(Apply[Or,Map[(#<=0)&&(IntegerQ[#])&,Map[Log[q,#]&,List2]]]); phRun=False; ph[x_,y_,q_,v_]:=Module[{POSX,POSY,Intsec,X=x,Y=y,POSL}, While[(Intsec=intersection[X,Y])!={}, Intsec=Intsec[[1]]; POSL=Select[Position[X,Intsec],(Length[#]<=1)&]; POSX=POSL[[1,1]]; POSY=Select[Position[Y,Intsec],(Length[#]<=1)&][[1,1]]; If[!phRun, If[Length[POSL]<=1&&IntegerTest[Intsec,q], Print[""]; Print["Warning: The expression"]; Print[""]; phCancel; Print[ph[x,y,q,v]]; phCancel; Print[""]; Print["was obtained, which contains ",Intsec,", a ",q,"-power of a"]; Print["nonpositive integer, as top and bottom argument. The"]; Print["cancellation performed below might be incorrect."]; Print[""]; ] ]; X=Drop[X,{POSX,POSX}]; Y=Drop[Y,{POSY,POSY}]; ]; ph[X,Y,q,v]/.phOrdne ] /; Switch[ifphCancel,1,intersection[x,y]!={},0,False]; Ph[L___,0]=1; Ph[L___,z_]:=ph[{L}[[1]],{L}[[2]],{L}[[3]],z]/;Length[{L}]===3; Ph[L___,z_]:=1/;IntegerQ[Length[{L}]/3]&& MemberQ[Flatten[Table[{L}[[3*kk+1]],{kk,0,Length[{L}]/3-1}]],1]&& !(Apply[Or,Map[(#<=0)&&(IntegerQ[#])&,Flatten[Table[Map[Log[{L}[[3*kk+3]],#]&, {L}[[3*kk+2]]],{kk,0,Length[{L}]/3-1}]]]]); Ph[L___,z_]:=Module[{ArgH,H1,H2,jj}, ArgH={{L}[[1]],{L}[[2]],{L}[[3]]}; For[jj=1,jj<=Length[{L}]/3-1,jj++, H1={L}[[3*jj+1]]; H2={L}[[3*jj+2]]; If[{H1,H2}=!={{},{}}, ArgH=Join[ArgH,{H1,H2,{L}[[3*jj+3]]}] ] ]; Clear[jj]; Ph[Argument[ArgH],z] ]/;IntegerQ[Length[{L}]/3]&& MemberQ[Table[{{L}[[3*iii+1]],{L}[[3*iii+2]]},{iii,1,Length[{L}]/3-1}],{{},{}}]; Ph[L___,z_]:=Module[{ArgH,H1,H2,jj}, Ph[Argument[Table[{L}[[jj]],{jj,4,Length[{L}]}]],z] ]/;IntegerQ[{L}/3]&&{L}[[1]]==={{L}[[3]]}&&{L}[[2]]==={}; Ph[L___,v_]:=Module[{POSX,POSY,Intsec,X,Y,Q,POSL}, For[ii=0,ii<=(Length[{L}]-1)/3,ii++, X[ii]={L}[[3*ii+1]]; ]; For[ii=0,ii<=(Length[{L}]-2)/3,ii++, Y[ii]={L}[[3*ii+2]]; ]; For[ii=0,ii<=(Length[{L}]-3)/3,ii++, Q[ii]={L}[[3*ii+3]]; ]; For[ii=0,ii<=Length[{L}]/3-1,ii++, While[(Intsec=intersection[X[ii],Y[ii]])!={}, Intsec=Intsec[[1]]; POSL=Select[Position[X[ii],Intsec],(Length[#]<=1)&]; POSX=POSL[[1,1]]; POSY=Select[Position[Y[ii],Intsec],(Length[#]<=1)&][[1,1]]; If[!phRun, If[Length[POSL]<=1&&IntegerTest[Intsec,q], Print[""]; Print["Warning: The expression"]; Print[""]; phCancel; Print[Ph[L,v]]; phCancel; Print[""]; Print["was obtained, which contains ",Intsec,", a ",q,"-power of a"]; Print["nonpositive integer, as top and bottom argument. The"]; Print["cancellation performed below might be incorrect."]; Print[""]; ] ]; X[ii]=Drop[X[ii],{POSX,POSX}]; Y[ii]=Drop[Y[ii],{POSY,POSY}]; ] ]; Clear[ii]; Ph[Argument[Apply[Join,Table[{X[ii],Y[ii],Q[ii]},{ii,0,Length[{L}]/3-1}]]],v] ] /; IntegerQ[Length[{L}]/3]&& Switch[ifphCancel, 1,Apply[Or,Table[intersection[{L}[[3*ii+1]],{L}[[3*ii+2]]]!={},{ii,0,Length[{L}]/3-1}]], 0,False]; ps[x_,y_,q_,v_]:=Module[{POSX,POSY,Intsec,X=x,Y=y,POSL}, While[(Intsec=intersection[X,Y])!={}, Intsec=Intsec[[1]]; POSL=Select[Position[X,Intsec],(Length[#]<=1)&]; POSX=POSL[[1,1]]; POSY=Select[Position[Y,Intsec],(Length[#]<=1)&][[1,1]]; If[!phRun, If[Length[POSL]<=1&&IntegerTest[Intsec,q], Print[""]; Print["Warning: The expression"]; Print[""]; phCancel; Print[ps[x,y,q,v]]; phCancel; Print[""]; Print["was obtained, which contains ",Intsec,", a ",q,"-power of a"]; Print["nonpositive integer, as top and bottom argument. The"]; Print["cancellation performed below might be incorrect."]; Print[""]; ] ]; X=Drop[X,{POSX,POSX}]; Y=Drop[Y,{POSY,POSY}]; ]; ps[X,Y,q,v] ] /; Switch[ifphCancel,1,intersection[x,y]!={},0,False]; Protect[Times,Power];); Rules; (*Definition der q-Binomialkoeffizienten und q-Faktoriellen*) Pochhammerq[a_, n_, x_:Global`q]:=Expand[Module[{i},Product[(1-a x^i), {i, 0, n-1}]]]; Format[Binomialq[n_,k_,x_:Global`q],TeXForm]:= Switch[ifTeX, TeXtrue,StringJoin["\\left [ \\matrix { ", ToString[TeXForm[n]]," \\cr ",ToString[TeXForm[k]], " } \\right ] _",ToString[TeXForm[q]]], AmSTeXtrue,StringJoin["\\left [ \\matrix ", ToString[TeXForm[n]]," \\\\ ",ToString[TeXForm[k]], " \\endmatrix \\right ] _",ToString[TeXForm[q]]], AmSLaTeXtrue,StringJoin["\\left [ \\begin{matrix} ", ToString[TeXForm[n]]," \\\\ ",ToString[TeXForm[k]], " \\end{matrix} \\right ] _",ToString[TeXForm[q]]] ]; Format[Binomialq[n_,k_,x_:Global`q]]:=If[Global`DOSFrage, SequenceForm[ColumnForm[{" "," "," "," "," "},Center,Center], ColumnForm[{n," ",k},Center,Center], ColumnForm[{" "," "," "," "," "},Center,Center], ColumnForm[{" "," "," "," "," ",x},Center,Center]], SequenceForm[ColumnForm[{"[ ","| ","| ","| ","[ "},Center,Center], ColumnForm[{n," ",k},Center,Center], ColumnForm[{" ]"," |"," |"," |"," ]"},Center,Center], ColumnForm[{" "," "," "," "," ",x},Center,Center]]]; Binomialq[n_,0,x_:Global`q]:=1; Binomialq[n_,k_,x_:Global`q]:=0/;k<0; Binomialq[n_, m_Integer, x_:Global`q]:=Expand[Factor[Module[{i},Product[1-x^(n-i), {i,0,m-1}]]/Pochhammerq[x,m,x]]] /; m>0; Binomialq/: Binomialq[n_, k_, x_:Global`q]/Binomialq[n_, k1_, x_:Global`q] := (1-x^(n-k+1))/(1-x^k) /; k1 === k-1; Binomialq/: Binomialq[n_, k1_, x_:Global`q]/Binomialq[n_, k_, x_:Global`q] := (1-x^k)/(1-x^(n-k+1)) /; k1 === k-1; Binomialqplus[n_,k_,x_:Global`q]:=0/;k<0||n<0||n0; Binomialqplus/: Binomialqplus[n_, k_, x_:Global`q]/Binomialqplus[n_, k1_, x_:Global`q] := (1-x^(n-k+1))/(1-x^k) /; k1 === k-1; Binomialqplus/: Binomialqplus[n_, k1_, x_:Global`q]/Binomialqplus[n_, k_, x_:Global`q] := (1-x^k)/(1-x^(n-k+1)) /; k1 === k-1; Binomialplus[n_,k_]:=0/;k<0||n<0||n=0; Multinomialq[n_List,q_:Global`q]:=Expand[Factor[Pochhammerq[q,Apply[Plus,n]]/ (Apply[Times,Flatten[Outer[Pochhammerq,{q},n],1]])]]; Binomialpq[n_,k_,x_:Global`q]:=pq[x^(n-k+1),k,x]/pq[x,k,x]; Format[Factorialq[n_,x_:Global`q],TeXForm]:= StringJoin["\\left [ ",ToString[TeXForm[n]], " \\right ] _",ToString[TeXForm[q]],"!"]; Format[Factorialq[n_,x_:Global`q]]:=If[Global`DOSFrage, SequenceForm[ColumnForm[{" "," "," "},Center,Center],n, ColumnForm[{" "," "," "},Center,Center], ColumnForm[{" "," "," ",x},Center,Center],"!"], SequenceForm[ColumnForm[{"[ ","| ","[ "},Center,Center],n, ColumnForm[{" ]"," |"," ]"},Center,Center], ColumnForm[{" "," "," ",x},Center,Center],"!"]]; Factorialq[n_,x_:Global`q]:=Expand[Factor[Module[{i},Product[1-x^(n-i), {i,0,n-1}]]/(1-x)^n]] /; n>=0 Factorialpq[n_,x_:Global`q]:=pq[x,n,x]/(1-x)^n Sq[0,0,x_:Global`q]:=1; Sq[0,k_,x_:Global`q]:=0 /; k>0; Sq[n_,k_,x_:Global`q]:=0 /; k<0 || n<0; Sq[n_,k_,x_:Global`q]:=Sq[n,k,x]=Expand[Sq[n-1,k-1,x]+Simplify[(1-x^k) /(1-x)]*Sq[n-1,k]] /; n>0; sq[0,0,x_:Global`q]:=1; sq[0,k_,x_:Global`q]:=0 /; k>0; sq[n_,k_,x_:Global`q]:=0 /; k<0 || n<0; sq[n_,k_,x_:Global`q]:=sq[n,k,x]=Expand[sq[n-1,k-1,x]+Simplify[(1-x^(n-1)) /(1-x)]*sq[n-1,k]] /; n>0; Unprotect[Product]; Product/: Product[t_, {x_, a_, n_, 1}]/Product[t_, {x_, a_, n1_, 1}] := (t /. x-> n)/; n1 === n-1; Product/: Product[t_, {x_, a_, n1_, 1}]/Product[t_, {x_, a_, n_, 1}] := 1/(t /. x-> n)/; n1 === n-1; Protect[Product]; (*Definition von pqaufl, pqzerl, pqzus, pqinfzerl, pqinfzus, und Expandq*) pqaufl:={pq[{List1___},{List2___},k_,q_:Global`q]^(exp_:1):> Product[Product[1-{List1}[[jj]]*q^ii,{ii,0,k-1}],{jj,1,Length[{List1}]}]^exp/ Product[Product[1-{List2}[[jj]]*q^ii,{ii,0,k-1}],{jj,1,Length[{List2}]}]^exp/; IntegerQ[Factor[k]]&&k>=0, pq[{List1___},{List2___},k_,q_:Global`q]^(exp_:1):> Product[Product[1-{List2}[[jj]]*q^ii,{ii,k,-1}],{jj,1,Length[{List2}]}]^exp/ Product[Product[1-{List1}[[jj]]*q^ii,{ii,k,-1}],{jj,1,Length[{List1}]}]^exp/; IntegerQ[Factor[k]]&&k<0, pq[x_,k_,q_:Global`q]^(exp_:1):>Product[1-x*q^i,{i,0,k-1}]^exp/;IntegerQ[Factor[k]]&&k>=0, pq[x_,k_,q_:Global`q]^(exp_:1):>1/Product[1-x*q^i,{i,k,-1}]^exp/;IntegerQ[Factor[k]]&&k<0 } pqzerl:=(pq[{List1___},{List2___},n_,q_:Global`q]:> Module[{jj},Product[pq[{List1}[[jj]],n,q],{jj,1,Length[{List1}]}]/ Product[pq[{List2}[[jj]],n,q],{jj,1,Length[{List2}]}]]); pqzus[n_,q_:Global`q]:=(Expr_ :>pqzusH[Expr,n,q]); pqzusH[Expr_,n_,q_:Global`q]:=(Expr*pqH[{},{},n,q]/.pqH->pq) pqH/: pqH[x_List,y_List,n_,q_:Global`q]*pq[z_,n_,q_:Global`q]^(exp_:1):= pqH[Join[x,Table[z,{exp}]],y,n,q]/;exp>0; pqH/: pqH[x_List,y_List,n_,q_:Global`q]*pq[z_,n_,q_:Global`q]^(exp_:1):= pqH[x,Join[y,Table[z,{-exp}]],n,q]/;exp<0; pqinfzerl:=(pqinf[{List1___},{List2___},q_:Global`q]:> Module[{jj},Product[pqinf[{List1}[[jj]],q],{jj,1,Length[{List1}]}]/ Product[pqinf[{List2}[[jj]],q],{jj,1,Length[{List2}]}]]); pqinfzus[q_:Global`q]:=(Expr_ :>pqinfzusH[Expr,q]); pqinfzusH[Expr_,q_:Global`q]:=(Expr*pqinfH[{},{},q]/.pqinfH->pqinf) pqinfH/: pqinfH[x_List,y_List,q_:Global`q]*pqinf[z_,q_:Global`q]^(exp_:1):= pqinfH[Join[x,Table[z,{exp}]],y,q]/;exp>0; pqinfH/: pqinfH[x_List,y_List,q_:Global`q]*pqinf[z_,q_:Global`q]^(exp_:1):= pqinfH[x,Join[y,Table[z,{-exp}]],q]/;exp<0; Expandq:=(bas_^exp_ :>bas^Expand[exp]/;Expand[exp]=!=exp); (*Ersetzungsregeln zum Rechnen mit pq und pqinf*) GrenzeO[x_,q_]:=If[IntegerTest[x,q],{-Log[q,Simplify[x]]},{},{}]; GrenzeU[x_,q_]:=If[IntegerTest[1/x,q],{-Log[q,Simplify[x]]},{},{}]; PQ:=(If[ValueQ[pq[PPP,1,q]], Unprotect[pq,ph,Ph,ps,pqinf];Clear[pq,ph,Ph,ps,pqinf];Rules;TeXRules; If[ifphFormat===0,ifphFormat=1;phFormat]; Protect[pq,ph,Ph,ps,pqinf];, Unprotect[pq,ph,Ph,ps,pqinf]; pq[{List1___},{List2___},k_,q_:Global`q]:= Module[{jj},Product[pq[{List1}[[jj]],k,q],{jj,1,Length[{List1}]}]/ Product[pq[{List2}[[jj]],k,q],{jj,1,Length[{List2}]}]]; pq[x_,k_,q_:Global`q]:=Product[1-x*q^i,{i,0,k-1}]/;IntegerQ[k]&&k>=0; pq[x_,k_,q_:Global`q]:=1/Product[1-x*q^i,{i,k,-1}]/;IntegerQ[k]&&k<0; ph[List1_,List2_,q_,z_]:=Module[{SumGrenze,SumVar,SumVars}, SumGrenze=Min[Flatten[Map[GrenzeO[#,q]&,List1]]]; If[!IntegerQ[SumGrenze], SumVar=Input[StringJoin["A basic hypergeometric series is converted into a sum.\n", "Enter a variable for the summation index: "]]; ]; SumVars={SumVar,0,SumGrenze}; Sum[(pq[List1,Join[List2,{q}],SumVar,q]/.pqzerl)* ((-1)^SumVar*q^((SumVar^2-SumVar)/2))^(1+Length[List2]-Length[List1])* z^SumVar, Release[SumVars]]]; Ph[L___,z_]:=Module[{TopA,BottomA,Bas,SumGrenze,SumVar,SumVars}, TopA=Table[{L}[[3*ii+1]],{ii,0,(Length[{L}]-1)/3}]; BottomA=Table[{L}[[3*ii+2]],{ii,0,(Length[{L}]-2)/3}]; Bas=Table[{L}[[3*ii+3]],{ii,0,(Length[{L}]-3)/3}]; SumGrenze=Table[Map[GrenzeO[#,Bas[[ii]]]&,TopA[[ii]]],{ii,1,Length[TopA]}]; SumGrenze=Min[Flatten[SumGrenze]]; If[!IntegerQ[SumGrenze], SumVar=Input[StringJoin["A basic hypergeometric series is converted into a sum.\n", "Enter a variable for the summation index: "]]; ]; SumVars={SumVar,0,SumGrenze}; Sum[(pq[TopA[[1]],Join[BottomA[[1]],{Bas[[1]]}],SumVar,Bas[[1]]]/.pqzerl)* ((-1)^SumVar*Bas[[1]]^((SumVar^2-SumVar)/2))^(1+Length[BottomA[[1]]]-Length[TopA[[1]]])* z^SumVar* Product[(pq[TopA[[ii]],BottomA[[ii]],SumVar,Bas[[ii]]]/.pqzerl)* ((-1)^SumVar*Bas[[ii]]^((SumVar^2-SumVar)/2))^(Length[BottomA[[ii]]]-Length[TopA[[ii]]]), {ii,2,Length[{L}]/3}], Release[SumVars]]]/;IntegerQ[Length[{L}]/3]; ps[List1_,List2_,q_,z_]:=Module[{SumGrenzeO,SumGrenzeU,SumVar,SumVars}, SumGrenzeO=Min[Flatten[Map[GrenzeO[#,q]&,List1]]]; SumGrenzeU=Max[Flatten[Map[GrenzeU[#,q]&,List2]]]; If[!IntegerQ[SumGrenzeO]||!IntegerQ[SumGrenzeU], SumVar=Input[StringJoin["A bilateral basic hypergeometric series is converted into a sum.\n", "Enter a variable for the summation index: "]]; ]; SumVars={SumVar,SumGrenzeU+1,SumGrenzeO}; Sum[(pq[List1,List2,SumVar,q]/.pqzerl)* ((-1)^SumVar*q^((SumVar^2-SumVar)/2))^(Length[List2]-Length[List1])* z^SumVar, Release[SumVars]]]; Protect[pq,ph,Ph,ps,pqinf]; ]); ifTeXphW=1; TeXphW:=(ifTeXphW=1-ifTeXphW;); ifphCancel=1; phCancel:=(ifphCancel=1-ifphCancel;); hypqAttributes:=(Print[""]; If[ValueQ[pq[PPP,1,q]], Print["Automatic evaluation of pq and ph is active."], Print["Automatic evaluation of pq and ph is inactive."]]; Switch[ifphCancel,0,Print["Automatic cancelling in ph is inactive."], 1,Print["Automatic cancelling in ph is active."]]; Switch[ifTeX,TeXtrue,Print["The output of TeXForm can be used with Plain-TeX and LaTeX."], AmSTeXtrue,Print["The output of TeXForm can be used with AmS-TeX."], AmSLaTeXtrue,Print["The output of TeXForm can be used with AmS-LaTeX."]]; Switch[ifTeXphW,0,Print["TeXForm uses ph[] for very well-poised basic hypergeometric series."], 1,Print["TeXForm uses W[] for very well-poised basic hypergeometric series."]]; ) neg1:={pq[a_,n_,q_:Global`q]^(exp_:1):>pq[a*q^n,-n,q]^-exp}; neg2:={pq[a_,n_,q_:Global`q]^(exp_:1):>((-q/a)^(n)*q^((-n^2-n)/2)*pq[q/a,-n,q])^-exp}; trans:={pq[a_,n_,q_:Global`q]^(exp_:1):>pq[q^(1-n)/a,n,q]^exp*(-a)^(n*exp)*q^(-exp*(-n^2+n)/2)}; inv1:={pq[a_,n_,q_:Global`q]^(exp_:1):>pq[1/a,n,1/q]^exp*(-a)^(n*exp)*q^(-exp*(-n^2+n)/2)}; inv2:={pq[a_,n_,q_:Global`q]^(exp_:1):>pq[a*q^(n-1),n,1/q]^exp}; lina1:={pq[a_,n_,q_:Global`q]^(exp_:1):>((1-a)*pq[a*q,n-1,q])^exp, pqinf[a_,q_:Global`q]^(exp_:1):>((1-a)*pqinf[a*q,q])^exp}; lina2:={pq[a_,n_,q_:Global`q]^(exp_:1):>((1-a*q^(n-1))*pq[a,n-1,q])^exp}; linz:={(b_*pq[a_,n_,q_:Global`q])^(exp_:1):>pq[a/q,n+1,q]^exp/;Factor[(1-b)*q-a]===0, (b_*pqinf[a_,q_:Global`q])^(exp_:1):>pqinf[a/q,q]^exp/;Factor[(1-b)*q-a]===0, (b_*pq[a_,n_,q_:Global`q])^(exp_:1):>pq[a,n+1,q]^exp/;Factor[(1-b)-a*q^n]===0, b_^(nexp_:1)*pq[a_,n_,q_:Global`q]^(exp_:1):>pq[a*q,n-1,q]^exp/; Factor[(1-b)-a]===0&&Factor[nexp+exp]===0, b_^(nexp_:1)*pqinf[a_,q_:Global`q]^(exp_:1):>pqinf[a*q,q]^exp/; Factor[(1-b)-a]===0&&Factor[nexp+exp]===0, b_^(nexp_:1)*pq[a_,n_,q_:Global`q]^(exp_:1):>pq[a,n-1,q]^exp/; Factor[(1-b)-a*q^(n-1)]===0&&Factor[nexp+exp]===0, (b_*pq[a_,n_,q_:Global`q])^(exp_:1):>-pq[a/q,n+1,q]^exp/;Factor[(1+b)*q-a]===0, (b_*pqinf[a_,q_:Global`q])^(exp_:1):>-pqinf[a/q,q]^exp/;Factor[(1+b)*q-a]===0, (b_*pq[a_,n_,q_:Global`q])^(exp_:1):>-pq[a,n+1,q]^exp/;Factor[(1+b)-a*q^n]===0, b_^(nexp_:1)*pq[a_,n_,q_:Global`q]^(exp_:1):>-pq[a*q,n-1,q]^exp/; Factor[(1+b)-a]===0&&Factor[nexp+exp]===0, b_^(nexp_:1)*pqinf[a_,q_:Global`q]^(exp_:1):>-pqinf[a*q,q]^exp/; Factor[(1+b)-a]===0&&Factor[nexp+exp]===0, b_^(nexp_:1)*pq[a_,n_,q_:Global`q]^(exp_:1):>-pq[a,n-1,q]^exp/; Factor[(1+b)-a*q^(n-1)]===0&&Factor[nexp+exp]===0}; zus1:={pq[a_,n_,q_:Global`q]^(exp_:1)*pq[b_,m_,q_:Global`q]^(exp_:1):>pq[a,m+n,q]^exp/;Factor[b-a*q^n]===0, pq[a_,n_,q_:Global`q]^(exp_:1)*pqinf[b_,q_:Global`q]^(exp_:1):>pqinf[a,q]^exp/;Factor[b-a*q^n]===0}; zus2:={pq[a_,n_,q_:Global`q]^(exp_:1)*pq[b_,m_,q_:Global`q]^(nexp_:1):>pq[a*q^m,n-m,q]^exp/; Factor[b-a]===0&&Factor[nexp+exp]===0, pqinf[a_,q_:Global`q]^(exp_:1)*pq[b_,m_,q_:Global`q]^(nexp_:1):>pqinf[a*q^m,q]^exp/; Factor[b-a]===0&&Factor[nexp+exp]===0}; Unprotect[Log,Power]; Log[q_^z_]:=z*Log[q]; Log[a_*b_]:=Log[a]+Log[b]; Power[a_*b_,m_]:=a^m*b^m; Power[Power[q_,n_],m_]:=Power[q,Expand[n*m]]; Protect[Log,Power]; zus3:={pq[a_,n_,q_:Global`q]^(exp_:1)*pq[b_,m_,q_:Global`q]^(nexp_:1):>pq[a,n-m,q]^exp/; Factor[b*q^m-a*q^n]===0&&Factor[nexp+exp]===0, pqinf[a_,q_:Global`q]^(exp_:1)*pqinf[b_,q_:Global`q]^(nexp_:1):>pq[a,Log[q,Simplify[b/a]],q]^exp/; FreeQ[Log[q,Simplify[b/a]],Log]&&Factor[nexp+exp]===0}; erw1:=Module[{m},m=Input["top-extend by: "]; If[m===Infinity, {pq[a_,nn_,q_:Global`q]^(exp_:1)->pqinf[a*q^nn,q]^-exp*pqinf[a,q]^exp}, {pq[a_,nn_,q_:Global`q]^(exp_:1)->pq[a*q^nn,m,q]^-exp*pq[a,nn+m,q]^exp}, {pq[a_,nn_,q_:Global`q]^(exp_:1)->pq[a*q^nn,m,q]^-exp*pq[a,nn+m,q]^exp}]]; erw2:=Module[{m},m=Input["bottom-extend by: "]; {pqinf[a_,q_:Global`q]^(exp_:1)->pq[a/q^m,m,q]^-exp*pqinf[a/q^m,q]^exp, pq[a_,nn_,q_:Global`q]^(exp_:1)->pq[a/q^m,m,q]^-exp*pq[a/q^m,nn+m,q]^exp}]; zerl:=Module[{m},m=Input["bottom-split by: "]; {pq[a_,nn_,q_:Global`q]^(exp_:1)->(pq[a,m,q]*pq[a*q^m,nn-m,q])^exp, pqinf[a_,q_:Global`q]^(exp_:1)->(pq[a,m,q]*pqinf[a*q^m,q])^exp}]; baszerl1:=Module[{m,k},m=Input["split into ? terms: "]; {pq[a_,nn_,q_:Global`q]^(exp_:1)->Product[pq[a*q^k,nn/m,q^m],{k,0,m-1}]^exp, pqinf[a_,q_:Global`q]^(exp_:1)->Product[pqinf[a*q^k,q^m],{k,0,m-1}]^exp}]; baszus1:=Module[{m,k},m=Input["put together ? terms: "]; {pq[a_,nn_,q_:Global`q]^(exp_:1)->pq[a,m*nn,q^(1/m)]^exp/ (Product[pq[a*q^(k/m),nn,q],{k,1,m-1}])^exp, pqinf[a_,q_:Global`q]^(exp_:1)->pqinf[a,q^(1/m)]^exp/ (Product[pqinf[a*q^(k/m),q],{k,1,m-1}])^exp} ]; baszerl2:=Module[{m,k},m=Input["split into ? terms: "]; {pq[a_,nn_,q_:Global`q]^(exp_:1)->Product[pq[a^(1/m)*E^(2*Pi*I*k/m),nn,q^(1/m)],{k,0,m-1}]^exp, pqinf[a_,q_:Global`q]^(exp_:1)->Product[pqinf[a^(1/m)*E^(2*Pi*I*k/m),q^(1/m)],{k,0,m-1}]^exp}]; baszus2:=Module[{m,k},m=Input["put together ? terms: "]; {pq[a_,nn_,q_:Global`q]^(exp_:1)->pq[a^m,nn,q^m]^exp/ (Product[pq[a*E^(2*Pi*I*k/m),nn,q],{k,1,m-1}]^exp), pqinf[a_,q_:Global`q]^(exp_:1)->pqinf[a^m,q^m]^exp/ (Product[pqinf[a*E^(2*Pi*I*k/m),q],{k,1,m-1}]^exp)} ]; ManipulationsListe={"neg1","neg2","trans","inv1","inv2","lina1","lina2", "linz","zus1","zus2","zus3","erw1","erw2","zerl","baszerl1","baszus1", "baszerl2","baszus2"} (*Funktionen und Definitionen, die das Manipulieren von Ausdrcken und Gleichungen ermglichen*) Listwrap[L_]:=If[ListTest[L],L,{L}]; (*Attributes[Ers]={HoldAll};*) Ers[Term_,Rules_,Positions_]:=Module[{Erg}, If[MemberQ[{List,Rule,RuleDelayed},Head[Rules]], Erg=MapAt[ReplaceAll[#,Rules]&,Term,Map[Listwrap,Positions]], Erg=MapAt[Rules,Term,Map[Listwrap,Positions]]]; If[Head[Erg]===Equal,LS=Erg[[1]];RS=Erg[[2]];]; Erg ]; Subst[Expr_,Pos_,LiS_:LS,ReS_:RS]:=Ers[Expr,Ausdr_ :>Ausdr*ReS/LiS,{Pos}] PosListe[Expr_]:=PosListe[Expr,1]; PosListe[Expr_,lev_]:=Module[{ZwErg,Var}, If[$VersionNumber==2., ZwErg=R[Cases[Expr,x_->{x,Hold[Select[Position[Expr,x], Function[Var,Length[Var]===lev]]]},{lev}]], ZwErg=Map[{#,Select[Position[Expr,#], Function[Var,Length[Var]===lev]]}&,Level[Expr,{lev}]]; ZwErg=Select[ZwErg,(Length[#[[2,1]]]===lev)&]; Union[ZwErg] ] ]; R:=Release; SimplifyPQ:=(Expr_ :>(Expr//.simplifyPQ/.MinusOne/.phOrdne)); simplifyPQ:={pq[x_,y_,q_]^(exp_:1):>pq[Factor[x],Expand[y],Factor[q]]^exp, pq[x_List,y_List,k_,q_]^(exp_:1):>pq[Factor[x],Factor[y],Expand[k],Factor[q]]^exp, pqinf[x_,q_]^(exp_:1):>pqinf[Factor[x],Factor[q]]^exp, Binomialq[x_,y_,q_:Global`q]^(exp_:1):>Binomialq[Expand[x],Expand[y],Factor[q]]^exp, pqinf[x_List,y_List,q_]^(exp_:1):>pqinf[Factor[x],Factor[y],Factor[q]]^exp, ph[x_List,y_List,q_,z_]^(exp_:1):>(ph[Factor[x],Factor[y],Factor[q],Factor[z]])^exp, Sum[x_,{l1_,l2_,l3_}]^(exp_:1):>Sum[x,{l1,Expand[Factor[l2]],Expand[Factor[l3]]}]^exp/; Expand[Factor[l2]]=!=l2||Expand[Factor[l3]]=!=l3, Expandq}; SumExpand:=(Expr_ :>(Expr//.sumExpand)); sumExpand:={Sum[x_,{l___}]:>Sum[Expand[x],{l}]/;Expand[x]=!=x, Sum[x_-y_,{l___}]:>Sum[x,{l}]-Sum[y,{l}], Sum[x_+y_,{l___}]:>Sum[x,{l}]+Sum[y,{l}], Sum[x_,{l1_,l2_,l3_}]^(exp_:1):>Sum[x,{l1,Expand[Factor[l2]],Expand[Factor[l3]]}]^exp/; Expand[Factor[l2]]=!=l2||Expand[Factor[l3]]=!=l3 } PQSort:={ph[List1_List,List2_List,q_,z_]:>(ph[Sort[List1],Sort[List2],q,z]/.SimplifyPQ), pq[List1_List,List2_List,n_,q_:Global`q]:>(pq[Sort[List1],Sort[List2],n,q]/.SimplifyPQ), pqinf[List1_List,List2_List,q_:Global`q]:> (pqinf[Sort[List1],Sort[List2],q]/.SimplifyPQ)}; phEinf:=(ph[List1_List,List2_List,q_,z_]:> Module[{A},A=Input["Add the parameter: "]; If[ifphCancel===1,phCancel]; ph[Join[{A},List1],Join[{A},List2],q,z]]); phPerm[Perm__,Wahl_]:=(ph[List1_List,List2_List,q_,z_]:> Module[{HPerm1,HPerm2,ii}, If[Sort[{Perm}]===Table[ii,{ii,Length[{Perm}]}], Switch[Wahl, Global`u, If[Length[List1] Module[{HPerm1,ii}, If[Sort[{Perm}]===Table[ii,{ii,Length[{Perm}]}], Switch[Wahl, Global`u, If[Length[List1] Switch[Wahl, Global`u,ph[Insert[Drop[List1,{n1,n1}],List1[[n1]],n2],List2,q,z], Global`l,ph[List1,Insert[Drop[List2,{n1,n1}],List2[[n1]],n2],q,z], Global`b,ph[Insert[Drop[List1,{n1+1,n1+1}],List1[[n1+1]],n2+1], Insert[Drop[List2,{n1,n1}],List2[[n1]],n2],q,z] ]); POS[Liste_List,X_]:=Select[Position[Liste,X],(Length[#]<=1)&][[1,1]]; PoisEliminate[Liste1_List,Liste2_List,Liste3_List,Liste4_List,x_,y_]:= Module[{POSX,LIST1=Liste1,LIST2=Liste2,LIST3=Liste3,LIST4=Liste4,HList1,HList2}, HList1=Map[Factor[#-x]&,Liste1]; HList2=Map[Factor[#-y]&,Liste2]; If[MemberQ[HList1,0]&&MemberQ[HList2,0], POSX=POS[HList1,0]; LIST1=Drop[Liste1,{POSX,POSX}]; LIST3=Join[Liste3,{x}]; POSX=POS[HList2,0]; LIST2=Drop[Liste2,{POSX,POSX}]; LIST4=Join[Liste4,{y}]; ]; {LIST1,LIST2,LIST3,LIST4} ]; phOrdne:=(ph[List1_List,List2_List,q_,z_]:> Module[{Intsec,GesList,ii,Var1,Var2,MaxEl,POSX,NewList1=List1,NewList2=List2, ProvList1,ProvList2,WurzelZahl=0}, GesList=Table[Map[List1[[ii]]*#&,List2],{ii,1,Length[List1]}]; GesList=Apply[Join,GesList]; Intsec=intersection[GesList,q*List1]; Intsec=Complement[Intsec,{0}]; If[Intsec=!={}, WurzelZahl=1; Intsec=Table[Var1=Intsec[[ii]]; {Var1,Count[GesList,Var1]}, {ii,1,Length[Intsec]}]; MaxEl=Max[Table[Intsec[[ii,2]],{ii,1,Length[Intsec]}]]; Intsec=Select[Intsec,(#[[2]]===MaxEl)&][[1,1]]; POSX=POS[List1,Intsec/q]; NewList1={Intsec/q};NewList2={}; ProvList1=Drop[List1,{POSX,POSX}];ProvList2=List2; {ProvList1,ProvList2,NewList1,NewList2}= PoisEliminate[ProvList1,ProvList2,NewList1,NewList2, q*Sqrt[Intsec/q],Sqrt[Intsec/q]]; {ProvList1,ProvList2,NewList1,NewList2}= PoisEliminate[ProvList1,ProvList2,NewList1,NewList2, -q*Sqrt[Intsec/q],-Sqrt[Intsec/q]]; GesList=ProvList1; For[ii=1,ii<=Length[GesList],ii++, {ProvList1,ProvList2,NewList1,NewList2}= PoisEliminate[ProvList1,ProvList2,NewList1,NewList2, GesList[[ii]],Intsec/GesList[[ii]]]]; Clear[ii]; NewList1=Join[NewList1,ProvList1]; NewList2=Join[NewList2,ProvList2]; If[Length[NewList1]>=2, If[NewList1[[2]]===q*Sqrt[Intsec/q]&&NewList1[[2]]===q*NewList2[[1]], WurzelZahl+=1] ]; If[Length[NewList1]>=3&&Length[NewList2]>=2, If[NewList1[[3]]===-q*Sqrt[Intsec/q]&&NewList1[[3]]===q*NewList2[[2]], WurzelZahl+=1] ]; ]; For[ii=1+WurzelZahl,ii Module[{Intsec,GesList,ii,Var1,Var2,MaxEl,POSX,NewList1=List1,NewList2=List2, ProvList1,ProvList2,WurzelZahl=0}, GesList=Table[Map[List1[[ii]]*#&,List2],{ii,1,Length[List1]}]; GesList=Apply[Join,GesList]; Intsec=Complement[GesList,{0}]; If[Intsec=!={}, WurzelZahl=1; Intsec=Table[Var1=Intsec[[ii]]; {Var1,Count[GesList,Var1]}, {ii,1,Length[Intsec]}]; MaxEl=Max[Table[Intsec[[ii,2]],{ii,1,Length[Intsec]}]]; Intsec=Select[Intsec,(#[[2]]===MaxEl)&][[1,1]]; NewList1={};NewList2={}; ProvList1=List1;ProvList2=List2; {ProvList1,ProvList2,NewList1,NewList2}= PoisEliminate[ProvList1,ProvList2,NewList1,NewList2, q*Sqrt[Intsec/q],Sqrt[Intsec/q]]; {ProvList1,ProvList2,NewList1,NewList2}= PoisEliminate[ProvList1,ProvList2,NewList1,NewList2, -q*Sqrt[Intsec/q],-Sqrt[Intsec/q]]; GesList=ProvList1; For[ii=1,ii<=Length[GesList],ii++, {ProvList1,ProvList2,NewList1,NewList2}= PoisEliminate[ProvList1,ProvList2,NewList1,NewList2, GesList[[ii]],Intsec/GesList[[ii]]]]; Clear[ii]; NewList1=Join[NewList1,ProvList1]; NewList2=Join[NewList2,ProvList2]; If[Length[NewList1]>=1, If[NewList1[[1]]===q*Sqrt[Intsec/q]&&NewList1[[1]]===q*NewList2[[1]], WurzelZahl+=1] ]; If[Length[NewList1]>=2&&Length[NewList2]>=2, If[NewList1[[2]]===-q*Sqrt[Intsec/q]&&NewList1[[2]]===q*NewList2[[2]], WurzelZahl+=1] ]; ]; For[ii=WurzelZahl,ii Module[{ListH,El,Var,TopA,BottomA,ArgA,Grenz,Dif}, For[ii=1,ii<=(Grenz=Max[Length[List1],Length[List2]]),ii++, TopA[ii]={};BottomA[ii]={}; ]; (* ListH=(Sort[List1]/.E^exp_ :>If[NumberQ[exp/Pi], E^(Mod[exp/Pi/I,2]*Pi*I),E^exp,E^exp]);*) ListH=Factor[List1]; For[ii=Length[ListH],ii>=1,ii--, For[jj=1,jj<=Length[ListH],jj++, El=ListH[[jj]]; If[Length[Intersection[ListH,Var=Factor[Table[El*E^(2*Pi*I*kk/ii),{kk,0,ii-1}]]]]===ii, TopA[ii]=Join[TopA[ii],{El^ii}]; ListH=MComplement[ListH,Var]; jj--; ] ] ]; (* ListH=(Sort[List2]/.E^exp_ :>If[NumberQ[exp/Pi], E^(Mod[exp/Pi/I,2]*Pi*I),E^exp,E^exp]);*) ListH=Factor[List2]; For[ii=Length[ListH],ii>=1,ii--, For[jj=1,jj<=Length[ListH],jj++, El=ListH[[jj]]; If[Length[Intersection[ListH,Var=Factor[Table[El*E^(2*Pi*I*kk/ii),{kk,0,ii-1}]]]]===ii, BottomA[ii]=Join[BottomA[ii],{El^ii}]; ListH=MComplement[ListH,Var]; jj--; ] ] ]; Clear[ii,jj]; ArgA=z*(-1)^(Length[List2]-Length[List1]- Sum[Length[BottomA[ii]]-Length[TopA[ii]],{ii,1,Grenz}]); Dif=(Length[List2]-Length[List1]- Sum[ii*(Length[BottomA[ii]]-Length[TopA[ii]]),{ii,1,Grenz}]); For[ii=Grenz,ii>=1,ii--, If[IntegerQ[Dif/ii], Dif=Dif/ii; ArgA=ArgA*(-1)^Dif; If[Dif>=0, BottomA[ii]=Join[BottomA[ii],Table[0,{Dif}]], TopA[ii]=Join[TopA[ii],Table[0,{Dif}]] ]; Break[] ] ]; Clear[ii]; Ph[Argument[Apply[Join,Table[{TopA[ii],BottomA[ii],q^ii},{ii,1,Grenz}]]],ArgA] ]) Phph:=(Ph[L___,z_]:>Module[{TopA,BottomA,ArgA,Bas,BasH,Var,Dif}, TopA=Table[{L}[[3*ii+1]],{ii,0,(Length[{L}]-1)/3}]; BottomA=Table[{L}[[3*ii+2]],{ii,0,(Length[{L}]-2)/3}]; Bas=Table[{L}[[3*ii+3]],{ii,0,(Length[{L}]-3)/3}]; ArgA=z; BasH=Map[Log[Bas[[1]],#]&,Bas]; If[Apply[And,Map[(#===Integer||#===Rational)&,Map[Head,BasH]]], BasH=Apply[GCD,Map[Numerator,BasH]]/Apply[LCM,Map[Denominator,BasH]]; If[(Log[basextr[Bas[[1]]],Bas[[1]]])<0, BasH=Bas[[1]]^-BasH, BasH=Bas[[1]]^BasH, BasH=Bas[[1]]^BasH ]; If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}]; ArgA=ArgA*(-1)^Sum[Length[BottomA[[hh]]]-Length[TopA[[hh]]],{hh,1,Length[TopA]}]; Dif=1+Sum[If[(Dif=Log[BasH,Bas[[hh]]])>0,Dif,0]* (Length[BottomA[[hh]]]-Length[TopA[[hh]]]),{hh,1,Length[TopA]}]; If[$VersionNumber>=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; TopA=Flatten[Table[Var=Log[BasH,Bas[[ii]]]; If[Var<0, ArgA=ArgA*Product[-TopA[[ii]][[hh]],{hh,1,Length[TopA[[ii]]]}]; ]; Table[Table[If[Var>0, TopA[[ii]][[jj]]^(1/Var)*E^(2*Pi*I*kk/Var), 1/TopA[[ii]][[jj]]^(1/Var)*E^(-2*Pi*I*kk/Var)], {kk,0,Abs[Var]-1}],{jj,1,Length[TopA[[ii]]]}],{ii,1,Length[TopA]}]]; BottomA[[1]]=Join[BottomA[[1]],{Bas[[1]]}]; BottomA=Flatten[Table[Var=Log[BasH,Bas[[ii]]]; If[Var<0, ArgA=ArgA/Product[-BottomA[[ii]][[hh]],{hh,1,Length[BottomA[[ii]]]}]; ]; Table[Table[If[Var>0, BottomA[[ii]][[jj]]^(1/Var)*E^(2*Pi*I*kk/Var), 1/BottomA[[ii]][[jj]]^(1/Var)*E^(-2*Pi*I*kk/Var)], {kk,0,Abs[Var]-1}],{jj,1,Length[BottomA[[ii]]]}],{ii,1,Length[BottomA]}]]; Dif=Dif-Length[BottomA]+Length[TopA]; If[Dif>0, BottomA=Join[BottomA,Table[0,{Dif}]], TopA=Join[TopA,Table[0,{Dif}]] ]; ArgA=ArgA*(-1)^(-Length[BottomA]+Length[TopA]+1); ph[Join[TopA,{BasH}],BottomA,BasH,ArgA], Ph[L,z] ] ]/;IntegerQ[Length[{L}]/3]); psph:=(ps[List1_List,List2_List,q_,z_]:>Module[{m,TopL,BottomL,L0,L1}, m=Input["Split at: "]; L0=Length[List2]-Length[List1]; L1=Count[List1,0]-Count[List2,0]; pq[List1,List2,m]*z^m*((-1)^m*q^Binomial[m,2])^L0* ph[Join[List1*q^m,{q}],List2*q^m,q,z*q^(m*L0)]+ pq[List1,List2,m-1]*z^(m-1)*((-1)^(m-1)*q^(Binomial[m-1,2]))^L0* (TopL=Select[List1,(#=!=0)&]; BottomL=Select[List2,(#=!=0)&]; If[L0<0, ph[Join[1/BottomL/q^(m-2),{q},Table[0,{-L0}]], 1/TopL/q^(m-2),q, Apply[Times,BottomL]/Apply[Times,TopL]/z*(-q^(m-2))^L1], ph[Join[1/BottomL/q^(m-2),{q}], Join[1/TopL/q^(m-2),Table[0,{L0}]],q, Apply[Times,BottomL]/Apply[Times,TopL]/z*(-q^(m-2))^L1] ]) ]); phps:=(ph[List1_List,List2_List,q_,z_]:>Module[{m,TopL,BottomL,L0,L1}, TopL=List1; BottomL=Join[List2,{q}]; L0=Length[BottomL]-Length[TopL]; L1=Count[List1,0]-Count[List2,0]; ps[TopL,BottomL,q,z]- pq[BottomL/q,TopL/q,1]*z^(-1)*((-1)^(-1)*q^(Binomial[-1,2]))^L0* (TopL=Select[TopL,(#=!=0)&]; BottomL=Select[BottomL,(#=!=0)&]; If[L0<0, ph[Join[1/BottomL/q^(-2),{q},Table[0,{-L0}]], 1/TopL/q^(-2),q, Apply[Times,BottomL]/Apply[Times,TopL]/z*(-q^(-2))^L1], ph[Join[1/BottomL/q^(-2),{q}], Join[1/TopL/q^(-2),Table[0,{L0}]],q, Apply[Times,BottomL]/Apply[Times,TopL]/z*(-q^(-2))^L1] ]) ]); psShift:=(ps[List1_List,List2_List,q_,z_]:>Module[{m,L0}, m=Input["shift by: "]; L0=Length[List2]-Length[List1]; pq[List1,List2,m]*z^m*((-1)^m*q^Binomial[m,2])^L0* ps[List1*q^m,List2*q^m,q,z*q^(m*L0)] ]); Gleichung:=(LS==RS); GlTausche:=Module[{ZwExpr},ZwExpr=LS;LS=RS;RS=ZwExpr;Gleichung]; Mal[expr_]:=(LS=LS*expr;RS=RS*expr;Gleichung); Add[expr_]:=(LS=LS+expr;RS=RS+expr;Gleichung); Div[expr_]:=(LS=LS/expr;RS=RS/expr;Gleichung); Sub[expr_]:=(LS=LS-expr;RS=RS-expr;Gleichung); Hoch[expr_]:=(LS=LS^expr;RS=RS^expr;Gleichung); Ers[Regel_]:=(LS=(LS/.Regel);RS=(RS/.Regel);Gleichung); Unprotect[Sum]; SumDef:= ( Sum[x__,y_]:=Module[{SumVar,SumVars,bottom}, If[Length[{x}]<=1, Switch[{FreeQ[LS==RS,Global`kk],FreeQ[LS==RS,Global`ii], FreeQ[LS==RS,Global`jj],FreeQ[LS==RS,Global`ll], FreeQ[LS==RS,Global`mm]}, {True,___},SumVar=Global`kk, {False,True,___},SumVar=Global`ii, {False,False,True,___},SumVar=Global`jj, {False,False,False,True,___},SumVar=Global`ll, {False,False,False,False,True,___},SumVar=Global`mm, _,SumVar=Global`nn ]; bottom={x}[[1]], SumVar={x}[[1]]; bottom={x}[[2]] ]; SumVars={SumVar,bottom,y}; LS=Sum[LS,Release[SumVars]]; RS=Sum[RS,Release[SumVars]]; Gleichung/.SumRegeln ]/;If[Length[{x}]>=2,!ListTest[{x}[[2]]],!ListTest[y]]; Protect[Sum]; ); SumDef; Exprtoph[Expr_^(exp_:1),k_,SumphSumR_]:=Module[{Expo,d0,d1,d2,basexp}, Expo=Expand[Factor[exp]]; If[Head[Expo]===Integer, Switch[Expr,pq[a___],pqtoph[Expr^Expo,k], pqinf[a___],pqinftoph[Expr^Expo,k], Dummy,Null, Sum[a_,{l1_,l2_,l3_}],Sumtoph[Expr^Expo,k,SumphSumR], _,factoph[Expr^Expo,k]], If[FreeQ[Expr,k]&&PolynomialQ[Expo,k]&&Exponent[Expo,k]<=2, If[(d2=Coefficient[Expo,k,2])=!=0, basexp=qbest[Expr][[2]] ]; ArgDif=ArgDif+basexp*2*d2; Termph=Termph*Expr^(d2*2*Binomial[k,2]); Constph=Constph*Expr^(Expo/.k->0); Argph=Argph*Expr^(Coefficient[Expo,k,1]+d2), Termph=Termph*Expr^Expo; Topph=Join[Topph,{pqtophfail}] ] ]; ] Sumtoph[Expr_^(exp_:1),k_,SumphSumR_]:=Module[{ConstH,TopH,BottomH,ArgH,TermH}, ConstH=Constph; TopH=Topph; BottomH=Bottomph; ArgH=Argph; TermH=Termph; TermH=TermH*(Expr/.If[SumphSumR===SUMPH,Sumph,SumRegeln])^exp; Constph=ConstH; Topph=TopH; Bottomph=BottomH; Argph=ArgH; Termph=TermH; Topph=Join[Topph,{pqtophfail}] ] basextr[Expr_^exp_:1]:=Expr expextr[Expr_^exp_:1]:=exp qbest[Q_]:=Module[{BasListH,Qpos,Qph,Qexp,QexpH,RatQ}, If[BasListph==={}, If[(Log[basextr[Q],Q])<0, BasListph={1/Q}, BasListph={Q}, BasListph={Q} ]; ]; BasListH=Map[Log[#,Q]&,BasListph]; Qpos=Map[Head,BasListH]; If[(RatQ= !MemberQ[Qpos,Rational])&&(!MemberQ[Qpos,Integer]), Topph=Join[Topph,{pqtophfail}]; If[(Log[basextr[Q],Q])<0, Qph=1/Q; Qexp=-1, Qph=Q; Qexp=1, Qph=Q; Qexp=1; ]; BasListph=Join[BasListph,{Qph}], Qpos=If[RatQ,POS[Qpos,Integer],POS[Qpos,Rational]]; Qexp=BasListH[[Qpos]]; QexpH=Denominator[Qexp]; Qexp=Numerator[Qexp]; Qph=Q^(1/Qexp); ArgDif=ArgDif*QexpH; BasListph=Drop[BasListph,{Qpos}]; BasListph=Join[{Qph},BasListph]; Topph=Flatten[Table[Table[Topph[[ii]]^(1/QexpH)*E^(2*Pi*I*jj/QexpH),{jj,1,QexpH}],{ii,1,Length[Topph]}]]; Bottomph=Flatten[Table[Table[Bottomph[[ii]]^(1/QexpH)*E^(2*Pi*I*jj/QexpH),{jj,1,QexpH}],{ii,1,Length[Bottomph]}]]; Termph=(Termph/.pq[a_,nn_,Qph^QexpH]^(hoch_:1)-> Product[pq[a^(1/QexpH)*E^(2*Pi*I*KK/QexpH),nn,Qph],{KK,0,QexpH-1}]^hoch); ]; {Qph,Qexp} ] pqtoph[pq[x_,y_,qF_]^(exp_:1),k_]:=Module[{COEFFx,Constphx,COEFFy,Constphy, basph,basexp,aplusc}, {basph,basexp}=qbest[qF]; Constphx=(x/.k->0); Constphy=(y/.k->0); COEFFx=Expand[Cancel[Log[basph,x/(Constphx)]/basexp]]; COEFFy=Expand[Cancel[y-Constphy]]; If[PolynomialQ[COEFFx,k]&&Exponent[COEFFx,k]<=1&& PolynomialQ[COEFFy,k]&&Exponent[COEFFy,k]<=1, COEFFx=Coefficient[COEFFx,k,1]; COEFFy=Coefficient[COEFFy,k,1]; Constph=Constph*pq[Constphx,Constphy,qF]^exp; aplusc=Expand[COEFFx+COEFFy]; If[IntegerQ[aplusc], If[aplusc=!=0, If[aplusc>0, If[basexp>0, Termph=Termph*Product[Product[pq[Constphx^(1/(aplusc*basexp))* E^((2*I*Pi*ll)/(aplusc*basexp))*basph^(Constphy/aplusc+l/aplusc),k, basph],{ll,0,-1+aplusc*basexp}],{l,0,-1+aplusc}]^exp; If[exp>0, (*Print["aplusc>0, basexp>0, exp>0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((2*I*Pi*ll)/(aplusc*basexp))*basph^(Constphy/aplusc+l/aplusc),{exp}], {ll,0,-1+aplusc*basexp}],{l,0,-1+aplusc}]]], (*Print["aplusc>0, basexp>0, exp<0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((2*I*Pi*ll)/(aplusc*basexp))*basph^(Constphy/aplusc+l/aplusc),{-exp}], {ll,0,-1+aplusc*basexp}],{l,0,-1+aplusc}]]]; ], Argph=Argph*((-1)^(aplusc)*(Constphx)^aplusc* basph^(Constphy*basexp*aplusc+basexp*Binomial[aplusc,2]))^exp; Termph=Termph*Product[Product[pq[Constphx^(1/(aplusc*basexp))* E^((-2*I*Pi*ll)/(aplusc*basexp))*basph^(Constphy/aplusc+l/aplusc),k, basph],{ll,0,-1-aplusc*basexp}],{l,0,-1+aplusc}]^exp* (basph^(-(aplusc^2*basexp*k)/2+(aplusc^2*basexp*k^2)/2))^exp; ArgDif=ArgDif+aplusc^2*basexp*exp; If[exp>0, (*Print["aplusc>0, basexp<0, exp>0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((-2*I*Pi*ll)/(aplusc*basexp))*basph^(Constphy/aplusc+l/aplusc),{exp}], {ll,0,-1-aplusc*basexp}],{l,0,-1+aplusc}]]], (*Print["aplusc>0, basexp<0, exp<0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((-2*I*Pi*ll)/(aplusc*basexp))*basph^(Constphy/aplusc+l/aplusc),{-exp}], {ll,0,-1-aplusc*basexp}],{l,0,-1+aplusc}]]]; ] ], If[basexp>0, Argph=Argph*((-1)^(aplusc)*Constphx^(aplusc)*basph^(Constphy*aplusc*basexp- (aplusc*basexp)/2+(aplusc^2*basexp)/2))^exp; Termph=Termph/Product[Product[pq[Constphx^(1/(aplusc*basexp))* E^((-2*I*Pi*ll)/(aplusc*basexp))* basph^(-aplusc^(-1)+Constphy/aplusc-l/aplusc),k,basph], {ll,0,-1-aplusc*basexp}],{l,0,-1-aplusc}]^exp* (basph^(-(aplusc^2*basexp*k)/2+(aplusc^2*basexp*k^2)/2))^exp; ArgDif=ArgDif+aplusc^2*basexp*exp; If[exp>0, (*Print["aplusc<0, basexp>0, exp>0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((-2*I*Pi*ll)/(aplusc*basexp))* basph^(-aplusc^(-1)+Constphy/aplusc-l/aplusc),{exp}], {ll,0,-1-aplusc*basexp}],{l,0,-1-aplusc}]]], (*Print["aplusc<0, basexp>0, exp<0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((-2*I*Pi*ll)/(aplusc*basexp))* basph^(-aplusc^(-1)+Constphy/aplusc-l/aplusc),{-exp}], {ll,0,-1-aplusc*basexp}],{l,0,-1-aplusc}]]]; ], Argph=Argph*(basph^ ((aplusc*basexp)/2+(aplusc^2*basexp)/2-basexp*Binomial[aplusc+1,2]))^exp; Termph=Termph/Product[Product[pq[Constphx^(1/(aplusc*basexp))* E^((2*I*Pi*ll)/(aplusc*basexp))* basph^(-aplusc^(-1)+Constphy/aplusc-l/aplusc),k,basph], {ll,0,-1+aplusc*basexp}],{l,0,-1-aplusc}]^exp; If[exp>0, (*Print["aplusc<0, basexp<0, exp>0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((2*I*Pi*ll)/(aplusc*basexp))* basph^(-aplusc^(-1)+Constphy/aplusc-l/aplusc),{exp}], {ll,0,-1+aplusc*basexp}],{l,0,-1-aplusc}]]], (*Print["aplusc<0, basexp<0, exp<0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(aplusc*basexp))* E^((2*I*Pi*ll)/(aplusc*basexp))* basph^(-aplusc^(-1)+Constphy/aplusc-l/aplusc),{-exp}], {ll,0,-1+aplusc*basexp}],{l,0,-1-aplusc}]]] ] ] ] ], Topph=Join[Topph,{pqtophfail}]; Termph=Termph*Product[pq[basph^Constphy*Constphx^basexp^(-1)*E^((2*I*KK*Pi)/basexp), aplusc*k,basph],{KK,0,-1+basexp}]^exp; ]; If[IntegerQ[COEFFx], If[COEFFx=!=0, If[COEFFx>0, If[basexp>0, Termph=Termph/Product[Product[pq[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(l/COEFFx),k,basph], {ll,0,-1+COEFFx*basexp}],{l,0,-1+COEFFx}]^exp; If[exp>0, (*Print["COEFFx>0, basexp>0, exp>0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(l/COEFFx),{exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1+COEFFx}]]], (*Print["COEFFx>0, basexp>0, exp<0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(l/COEFFx),{-exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1+COEFFx}]]] ], Argph=Argph*((-1)^(COEFFx)*Constphx^-COEFFx*basph^ (-basexp*Binomial[COEFFx,2]))^exp; Termph=Termph*(basph^((COEFFx^2*basexp*k)/2-(COEFFx^2*basexp*k^2)/2))^exp/ Product[Product[pq[Constphx^(1/(COEFFx*basexp))*E^((-2*I*Pi*ll)/(COEFFx*basexp))* basph^(l/COEFFx),k,basph],{ll,0,-1-COEFFx*basexp}], {l,0,-1+COEFFx}]^exp; ArgDif=ArgDif-COEFFx^2*basexp*exp; If[exp>0, (*Print["COEFFx>0, basexp<0, exp>0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))*E^((-2*I*Pi*ll)/(COEFFx*basexp))* basph^(l/COEFFx),{exp}],{ll,0,-1-COEFFx*basexp}], {l,0,-1+COEFFx}]]], (*Print["COEFFx>0, basexp<0, exp<0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))*E^((-2*I*Pi*ll)/(COEFFx*basexp))* basph^(l/COEFFx),{-exp}],{ll,0,-1-COEFFx*basexp}], {l,0,-1+COEFFx}]]] ] ], If[basexp>0, Argph=Argph*((-1)^(COEFFx)*basph^ ((COEFFx*basexp)/2-(COEFFx^2*basexp)/2)/Constphx^(COEFFx))^exp; Termph=Termph*(basph^((COEFFx^2*basexp*k)/2-(COEFFx^2*basexp*k^2)/2))^exp* Product[Product[pq[Constphx^(1/(COEFFx*basexp))* E^((-2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),k, basph],{ll,0,-1-COEFFx*basexp}],{l,0,-1-COEFFx}]^exp; ArgDif=ArgDif-COEFFx^2*basexp*exp; If[exp>0, (*Print["COEFFx<0, basexp>0, exp>0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((-2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{exp}], {ll,0,-1-COEFFx*basexp}],{l,0,-1-COEFFx}]]], (*Print["COEFFx<0, basexp>0, exp<0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((-2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{-exp}], {ll,0,-1-COEFFx*basexp}],{l,0,-1-COEFFx}]]]; ], Argph=Argph*(basph^(-(COEFFx*basexp)/2- (COEFFx^2*basexp)/2+basexp*Binomial[COEFFx+1,2]))^exp; Termph=Termph*Product[Product[pq[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx), k,basph],{ll,0,-1+COEFFx*basexp}],{l,0,-1-COEFFx}]^exp; If[exp>0, (*Print["COEFFx<0, basexp<0, exp>0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1-COEFFx}]]], (*Print["COEFFx<0, basexp<0, exp<0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{-exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1-COEFFx}]]]; ] ] ] ], Bottomph=Join[Bottomph,{pqtophfail}]; Termph=Termph/Product[pq[Constphx^basexp^(-1)*E^((2*I*KK*Pi)/basexp),COEFFx*k,basph], {KK,0,-1+basexp}]^exp; ], Termph=Termph*pq[x,y,qF]^exp; Topph=Join[Topph,{pqtophfail}]; ]; ] pqinftoph[pqinf[x_,qF_]^(exp_:1),k_]:=Module[{COEFFx,Constphx, BasListH,baspos,basph,basexp,basexpH,RatQ,IntQ}, {basph,basexp}=qbest[qF]; Constphx=(x/.k->0); COEFFx=Expand[Cancel[Log[basph,x/(Constphx)]/basexp]]; If[PolynomialQ[COEFFx,k]&&Exponent[COEFFx,k]<=1, COEFFx=Coefficient[COEFFx,k,1]; Constph=Constph*pqinf[Constphx,qF]^exp; If[IntegerQ[COEFFx], If[COEFFx=!=0, If[COEFFx>0, If[basexp>0, Termph=Termph/Product[Product[pq[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(l/COEFFx),k,basph], {ll,0,-1+COEFFx*basexp}],{l,0,-1+COEFFx}]^exp; If[exp>0, (*Print["COEFFx>0, basexp>0, exp>0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(l/COEFFx),{exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1+COEFFx}]]], (*Print["COEFFx>0, basexp>0, exp<0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(l/COEFFx),{-exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1+COEFFx}]]] ], Argph=Argph*((-1)^(COEFFx)*Constphx^-COEFFx*basph^ (-basexp*Binomial[COEFFx,2]))^exp; Termph=Termph*(basph^((COEFFx^2*basexp*k)/2-(COEFFx^2*basexp*k^2)/2))^exp/ Product[Product[pq[Constphx^(1/(COEFFx*basexp))*E^((-2*I*Pi*ll)/(COEFFx*basexp))* basph^(l/COEFFx),k,basph],{ll,0,-1-COEFFx*basexp}], {l,0,-1+COEFFx}]^exp; ArgDif=ArgDif-COEFFx^2*basexp*exp; If[exp>0, (*Print["COEFFx>0, basexp<0, exp>0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))*E^((-2*I*Pi*ll)/(COEFFx*basexp))* basph^(l/COEFFx),{exp}],{ll,0,-1-COEFFx*basexp}], {l,0,-1+COEFFx}]]], (*Print["COEFFx>0, basexp<0, exp<0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))*E^((-2*I*Pi*ll)/(COEFFx*basexp))* basph^(l/COEFFx),{-exp}],{ll,0,-1-COEFFx*basexp}], {l,0,-1+COEFFx}]]] ] ], If[basexp>0, Argph=Argph*((-1)^(COEFFx)*basph^ ((COEFFx*basexp)/2-(COEFFx^2*basexp)/2)/Constphx^(COEFFx))^exp; Termph=Termph*(basph^((COEFFx^2*basexp*k)/2-(COEFFx^2*basexp*k^2)/2))^exp* Product[Product[pq[Constphx^(1/(COEFFx*basexp))* E^((-2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),k, basph],{ll,0,-1-COEFFx*basexp}],{l,0,-1-COEFFx}]^exp; ArgDif=ArgDif-COEFFx^2*basexp*exp; If[exp>0, (*Print["COEFFx<0, basexp>0, exp>0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((-2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{exp}], {ll,0,-1-COEFFx*basexp}],{l,0,-1-COEFFx}]]], (*Print["COEFFx<0, basexp>0, exp<0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((-2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{-exp}], {ll,0,-1-COEFFx*basexp}],{l,0,-1-COEFFx}]]]; ], Argph=Argph*(basph^(-(COEFFx*basexp)/2- (COEFFx^2*basexp)/2+basexp*Binomial[COEFFx+1,2]))^exp; Termph=Termph*Product[Product[pq[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx), k,basph],{ll,0,-1+COEFFx*basexp}],{l,0,-1-COEFFx}]^exp; If[exp>0, (*Print["COEFFx<0, basexp<0, exp>0"];*) Topph=Join[Topph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1-COEFFx}]]], (*Print["COEFFx<0, basexp<0, exp<0"];*) Bottomph=Join[Bottomph,Flatten[Table[Table[Table[Constphx^(1/(COEFFx*basexp))* E^((2*I*Pi*ll)/(COEFFx*basexp))*basph^(-COEFFx^(-1)-l/COEFFx),{-exp}], {ll,0,-1+COEFFx*basexp}],{l,0,-1-COEFFx}]]]; ] ] ] ], Bottomph=Join[Bottomph,{pqtophfail}]; Termph=Termph/Product[pq[Constphx^basexp^(-1)*E^((2*I*KK*Pi)/basexp),COEFFx*k,basph], {KK,0,-1+basexp}]^exp; ], Termph=Termph*pqinf[x,qF]^exp; Topph=Join[Topph,{pqtophfail}]; ]; ] factoph[Expr_^(exp_:1),k_]:=Module[{ZwExpr,ZwExpr1,ZwExpr2,c0List,c1List, ConstH,TopH,BottomH,ArgH,TermH,BasList,HochList,BasListH, baspos,basexp,basph,RatQ,IntQ}, If[FreeQ[Expr,k], Constph=Constph*Expr^exp, ZwExpr=Expand[Dummy+Expr]; ZwExpr1=Select[ZwExpr,(FreeQ[#,k]&&FreeQ[#,Dummy])&]; If[ZwExpr1===0, Termph=Termph*Expr^exp; Topph=Join[Topph,{pqtophfail}]; Return[]; ]; ZwExpr2=Select[ZwExpr,!FreeQ[#,k]&]; ZwExpr2=Factor[ZwExpr2]*Dummy; ZwExpr2=Table[ZwExpr2[[ii]],{ii,1,Length[ZwExpr2]}]; ZwExpr2=Select[ZwExpr2,FreeQ[#,Dummy]&]; BasList=Map[basextr,ZwExpr2]; HochList=Map[expextr,ZwExpr2]; If[FreeQ[BasList,k]&&Apply[And,Map[PolynomialQ[#,k]&,HochList]]&& Apply[And,Map[(Exponent[#,k]<=1)&,HochList]], Constph=Constph*ZwExpr1^exp; c0List=Map[Coefficient[#,k,0]&,HochList]; c1List=Map[Coefficient[#,k,1]&,HochList]; ConstH=Product[BasList[[ii]]^c0List[[ii]],{ii,1,Length[BasList]}]; ConstH=-ConstH/ZwExpr1; ArgH=Product[BasList[[ii]]^c1List[[ii]],{ii,1,Length[BasList]}]; {basph,basexp}=qbest[ArgH]; Constph=Constph*(1-ConstH)^exp; Termph=Termph*Product[pq[ConstH^(1/basexp)*E^(2*Pi*I*l/basexp)*basph,k,basph]/ pq[ConstH^(1/basexp)*E^(2*Pi*I*l/basexp),k,basph],{l,1,basexp}]^exp; If[exp>0, Topph=Join[Topph,Flatten[Table[Table[ConstH^(1/basexp)*E^(2*Pi*I*l/basexp)*basph,{exp}],{l,1,basexp}]]]; Bottomph=Join[Bottomph,Flatten[Table[Table[ConstH^(1/basexp)*E^(2*Pi*I*l/basexp),{exp}],{l,1,basexp}]]], Topph=Join[Topph,Flatten[Table[Table[ConstH^(1/basexp)*E^(2*Pi*I*l/basexp),{-exp}],{l,1,basexp}]]]; Bottomph=Join[Bottomph,Flatten[Table[Table[ConstH^(1/basexp)*E^(2*Pi*I*l/basexp)*basph,{-exp}],{l,1,basexp}]]] ], Termph=Termph*Expr^exp; Topph=Join[Topph,{pqtophfail}]; ] ] ] sumRegeln:={ Sum[an_+bn_,{var_,n0_,n1_}]:> Sum[an,{var,n0,n1}]+Sum[bn,{var,n0,n1}] }; sumph:=(Sum[Expr_,{var_,n0_,n1_}]:>Module[{ZwList,SExpr,Fe,F1,F2,Laenge,Pos,E1}, If[n1=!=Infinity, Print[" \nThe upper bound is not Infinity. Apply \"SumInfinity\" if possible."]; Sum[Expr,{var,n0,n1}], If[n0===-Infinity, Print[" \nThe lower bound is -Infinity. Specify a terminating lower bound \nif possible."]; Sum[Expr,{var,n0,n1}], SExpr=Factor[Expr]; SExpr=Dummy*(SExpr/.Binomialq->Binomialpq/.Factorialq->Factorialpq/.pqinfzerl/.pqzerl/.Expandq); SExpr=Table[SExpr[[ii]],{ii,1,Length[SExpr]}]; Constph=1; Topph={}; Bottomph={}; Argph=1; ArgDif=0; Termph=1; BasListph={}; ZwList=Map[basextr,SExpr]; E1=Map[expextr,SExpr]; Laenge=Length[SExpr]; For[ss=1,ss<=Laenge,ss++, Fe=ZwList[[ss]]; If[Head[Fe]===Plus&&!FreeQ[Fe,k]&& Length[F1=Expand[Fe*(F2=(Fe[[1]]-Fe[[2]]))]]<=2&& MemberQ[ZwList,F2], Pos=POS[ZwList,F2]; SExpr=Ers[SExpr,ReplaceAll[#,Fe^ex_:1:>F1^ex]&,{ss}]; SExpr=Ers[SExpr,Factor[#/F2^E1[[ss]]]&,{Pos}]; ZwList=Map[basextr,SExpr]; ] ]; Clear[ss]; Map[Exprtoph[#,var,SUMPH]&,SExpr]; If[BasListph==={}, BasListph={Global`q} ]; E1=BasListph[[1]]; If[MemberQ[Topph,1], Print[""]; Print["Warning: ",ExpandAll[pq[1,var,E1]]," was obtained in the numerator."]; Print[" The result might be incorrect. Maybe you should change"]; Print[" the lower boundary of the summation index and only then"]; Print[" apply \"Sumph\"."]; ]; If[MemberQ[Bottomph,1], Print[""]; Print["Warning: ",ExpandAll[pq[1,var,E1]]," was obtained in the denominator."]; Print[" The result might be incorrect. Maybe you should change"]; Print[" the lower boundary of the summation index and only then"]; Print[" apply \"Sumph\"."]; ]; If[FreeQ[Topph,pqtophfail]&&FreeQ[Bottomph,pqtophfail], If[(Laenge=ArgDif+Length[Topph]-Length[Bottomph])<0, Factor[Constph]*ph[Join[Topph,{E1},Table[0,{-Laenge}]],Bottomph,E1,Argph*(-1)^ArgDif]/.phOrdne, Factor[Constph]*ph[Join[Topph,{E1}],Join[Bottomph,Table[0,{Laenge}]],E1,Argph*(-1)^ArgDif]/.SimplifyPQ/.phOrdne ], Factor[Constph]*Sum[Termph*Argph^var,{var,n0,n1}]/.SimplifyPQ ] ] ] ]); sumR:=(Sum[Expr_,{var_,n0_,n1_}]:>Module[{ZwList,SExpr,Fe,F1,F2,Laenge,Pos,E1}, SExpr=Factor[Expr]; SExpr=Dummy*(SExpr/.Binomialq->Binomialpq/.Factorialq->Factorialpq/.pqinfzerl/.pqzerl/.Expandq); SExpr=Table[SExpr[[ii]],{ii,1,Length[SExpr]}]; Constph=1; Topph={}; Bottomph={}; Argph=1; ArgDif=0; Termph=1; BasListph={}; ZwList=Map[basextr,SExpr]; E1=Map[expextr,SExpr]; Laenge=Length[SExpr]; For[ss=1,ss<=Laenge,ss++, Fe=ZwList[[ss]]; If[Head[Fe]===Plus&&!FreeQ[Fe,k]&& Length[F1=Expand[Fe*(F2=(Fe[[1]]-Fe[[2]]))]]<=2&& MemberQ[ZwList,F2], Pos=POS[ZwList,F2]; SExpr=Ers[SExpr,ReplaceAll[#,Fe^ex_:1:>F1^ex]&,{ss}]; SExpr=Ers[SExpr,Factor[#/F2^E1[[ss]]]&,{Pos}]; ZwList=Map[basextr,SExpr]; ] ]; Clear[ss]; Map[Exprtoph[#,var,SUMREGELN]&,SExpr]; If[BasListph==={}, BasListph={Global`q} ]; E1=BasListph[[1]]; If[MemberQ[Bottomph,1], Print[""]; Print["Warning: ",ExpandAll[pq[1,var,E1]]," was obtained in the denominator."]; Print[" The result might be incorrect. Maybe you should apply"]; Print[" \"SumShift\" before applying \"SumRegeln\"."]; ]; Factor[Constph]*Sum[Termph*Argph^var,{var,n0,n1}]/.SimplifyPQ ]) sumshift:=(Sum[Expr_,{var_,n0_,n1_}]:>Sum[Expr/.var->var+n0,{var,0,n1-n0}]/; n0=!=0&&n0=!=-Infinity) Sumph:=(Sum[Args___]:>(If[ValueQ[pq[PPP,1,q]],PQ]; Sum[Args]/.sumshift//.sumRegeln/.sumph)); SumRegeln:=(Sum[Args___]:>(Sum[Args]//.sumRegeln/.sumR)); SumPh:=(Sum[Args___]:>(Sum[Args]/.Sumph/.phPh)); sumps:=(Sum[Expr_,{var_,n0_,n1_}]:>Module[{ZwList,SExpr,Fe,F1,F2,Laenge,Pos,E1}, If[n1=!=Infinity, Print[" \nThe upper bound is not Infinity. Apply \"SumInfinity\" if possible."]; Sum[Expr,{var,n0,n1}], If[n0=!=-Infinity, Print[" \nThe lower bound is not -Infinity. The sum is converted into "]; Print["a basic hypergeometric series."]; Sum[Expr,{var,n0,n1}]/.Sumph, SExpr=Factor[Expr]; SExpr=Dummy*(SExpr/.Binomialq->Binomialpq/.Factorialq->Factorialpq/.pqinfzerl/.pqzerl/.Expandq); SExpr=Table[SExpr[[ii]],{ii,1,Length[SExpr]}]; Constph=1; Topph={}; Bottomph={}; Argph=1; ArgDif=0; Termph=1; BasListph={}; ZwList=Map[basextr,SExpr]; E1=Map[expextr,SExpr]; Laenge=Length[SExpr]; For[ss=1,ss<=Laenge,ss++, Fe=ZwList[[ss]]; If[Head[Fe]===Plus&&!FreeQ[Fe,k]&& Length[F1=Expand[Fe*(F2=(Fe[[1]]-Fe[[2]]))]]<=2&& MemberQ[ZwList,F2], Pos=POS[ZwList,F2]; SExpr=Ers[SExpr,ReplaceAll[#,Fe^ex_:1:>F1^ex]&,{ss}]; SExpr=Ers[SExpr,Factor[#/F2^E1[[ss]]]&,{Pos}]; ZwList=Map[basextr,SExpr]; ] ]; Map[Exprtoph[#,var,SUMPH]&,SExpr]; If[BasListph==={}, BasListph={Global`q} ]; E1=BasListph[[1]]; (* If[MemberQ[Bottomph,1], Print[""]; Print["Warning: ",ExpandAll[pq[1,var,E1]]," was obtained in the denominator."]; Print[" The result might be incorrect. Maybe you should change"]; Print[" the lower boundary of the summation index and only then"]; Print[" apply \"Sumps\"."]; ];*) If[FreeQ[Topph,pqtophfail]&&FreeQ[Bottomph,pqtophfail], If[(Laenge=ArgDif+Length[Topph]-Length[Bottomph])<0, Factor[Constph]*ps[Join[Topph,Table[0,{-Laenge}]],Bottomph,E1,Argph*(-1)^(ArgDif)]/.SimplifyPQ/.psOrdne, Factor[Constph]*ps[Topph,Join[Bottomph,Table[0,{Laenge}]],E1,Argph*(-1)^(ArgDif)]/.SimplifyPQ/.psOrdne ], Factor[Constph]*Sum[Termph*Argph^var,{var,n0,n1}]/.SimplifyPQ ] ] ] ]) Sumps:=(Sum[Args___]:>(If[ValueQ[pq[PPP,1,q]],PQ]; Sum[Args]//.Join[sumRegeln,{sumps}])); SumSammle:=(c_*Sum[Expr_,{var_,n0_,n1_}]:>Sum[c*Expr,{var,n0,n1}]); SumInfinity:=(Sum[Expr_,{var_,n0_,n1_}]:>Sum[Expr,{var,n0,Infinity}]/; n1=!=Infinity); phSum:=(ph[List1_List,List2_List,q_,z_]:>Module[{SumGrenze,SumVar,SumVars}, SumGrenze=Min[Flatten[Map[GrenzeO[#,q]&,List1]]]; If[!IntegerQ[SumGrenze], SumVar=Input[StringJoin["A basic hypergeometric series is converted into a sum.\n", "Enter a variable for the summation index: "]]; ]; SumVars={SumVar,0,SumGrenze}; Sum[(pq[List1,Join[List2,{q}],SumVar,q]/.pqzerl)* ((-1)^SumVar*q^((SumVar^2-SumVar)/2))^(1+Length[List2]-Length[List1])* z^SumVar, Release[SumVars]]]); psSum:=(ps[List1_List,List2_List,q_,z_]:>Module[{SumGrenzeO,SumGrenzeU,SumVar,SumVars}, SumGrenzeO=Min[Flatten[Map[GrenzeO[#,q]&,List1]]]; SumGrenzeU=Max[Flatten[Map[GrenzeU[#,q]&,List2]]]; If[!IntegerQ[SumGrenzeO]||!IntegerQ[SumGrenzeU], SumVar=Input[StringJoin["A basic hypergeometric series is converted into a sum.\n", "Enter a variable for the summation index: "]]; ]; SumVars={SumVar,SumGrenzeU+1,SumGrenzeO}; Sum[(pq[List1,List2,SumVar,q]/.pqzerl)* ((-1)^SumVar*q^((SumVar^2-SumVar)/2))^(Length[List2]-Length[List1])* z^SumVar, Release[SumVars]]]); PhSum:=(Ph[L___,z_]:>Module[{TopA,BottomA,Bas,SumGrenze,SumVar,SumVars}, TopA=Table[{L}[[3*ii+1]],{ii,0,(Length[{L}]-1)/3}]; BottomA=Table[{L}[[3*ii+2]],{ii,0,(Length[{L}]-2)/3}]; Bas=Table[{L}[[3*ii+3]],{ii,0,(Length[{L}]-3)/3}]; SumGrenze=Table[Map[GrenzeO[#,Bas[[ii]]]&,TopA[[ii]]],{ii,1,Length[TopA]}]; SumGrenze=Min[Flatten[SumGrenze]]; If[!IntegerQ[SumGrenze], SumVar=Input[StringJoin["A basic hypergeometric series is converted into a sum.\n", "Enter a variable for the summation index: "]]; ]; SumVars={SumVar,0,SumGrenze}; Sum[(pq[TopA[[1]],Join[BottomA[[1]],{Bas[[1]]}],SumVar,Bas[[1]]]/.pqzerl)* ((-1)^SumVar*Bas[[1]]^((SumVar^2-SumVar)/2))^(1+Length[BottomA[[1]]]-Length[TopA[[1]]])* z^SumVar* Product[(pq[TopA[[ii]],BottomA[[ii]],SumVar,Bas[[ii]]]/.pqzerl)* ((-1)^SumVar*Bas[[ii]]^((SumVar^2-SumVar)/2))^(Length[BottomA[[ii]]]-Length[TopA[[ii]]]), {ii,2,Length[{L}]/3}], Release[SumVars]]]/;IntegerQ[Length[{L}]/3]); MComplement[x__]:=Module[{ZwErg={},i,j}, For[i=1,i<=Length[{x}[[1]]],i++, If[!MemberQ[ZwErg,{x}[[1,i]]], ZwErg=Join[ZwErg,Table[{x}[[1,i]], {Count[{x}[[1]],{x}[[1,i]]]- Max[Table[Count[{x}[[j]],{x}[[1,i]]],{j,2,Length[{x}]}]]}]] ] ]; ZwErg ] SumErw1:=Sum[Expr_,{var_,unt_,ob_}]:> Module[{m},m=Input["top-extend by: "]; Sum[Expr,{var,unt,ob+m}]-Sum[Expr,{var,ob+1,ob+m}] ] SumErw2:=Sum[Expr_,{var_,unt_,ob_}]:> Module[{m},m=Input["bottom-extend by: "]; Sum[Expr,{var,unt-m,ob}]-Sum[Expr,{var,unt-m,unt-1}] ] Idem[x_]:=x; SumTausche:=Sum[Sum[Expr_,{var2_,unt2_,ob2_}],{var1_,unt1_,ob1_}]:> Module[{jcd,jab,AA,BB,aa,bb,cc,dd,Var1,Var2,VarH,Iu,Io,Erg}, If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}]; Var1=Expand[unt2]; Var2=Expand[ob2]; If[PolynomialQ[Var1,var1]&&PolynomialQ[Var2,var1]&& Exponent[Var1,var1]<=1&&Exponent[Var2,var1]<=1, aa=Coefficient[Var1,var1,1]; bb=Coefficient[Var1,var1,0]; cc=Coefficient[Var2,var1,1]; dd=Coefficient[Var2,var1,0]; AA=unt1; BB=ob1; jcd=If[cc===0, Dummy, (var2-dd)/cc ]; jab=If[aa===0, Dummy, (var2-bb)/aa ]; VarH=(aa*dd-cc*bb)/(aa-cc); Switch[{aa>=0,cc>=0}, {True,True}, If[cc=!=0, If[unt1<=If[aa===0,(bb-dd)/cc,(aa*unt1+bb-dd)/cc], AA=Dummy; ]; ]; If[aa=!=0, If[ob1>=If[cc===0,(dd-bb)/aa,(cc*ob1+dd-bb)/aa], BB=Dummy; ]; ]; Iu=Select[{AA,If[cc=!=0&&IntegerQ[1/cc],Idem,Ceiling][jcd]},FreeQ[#,Dummy]&]; Io=Select[{BB,If[aa=!=0&&IntegerQ[1/aa],Idem,Floor][jab]},FreeQ[#,Dummy]&]; Erg=Sum[Sum[Expr,{var1,Max[Iu],Min[Io]}], {var2,If[aa===0,bb,aa*unt1+bb],If[cc===0,dd,cc*ob1+dd]}], {True,False}, If[If[aa===0,bb,aa*AA+bb]>=VarH, jab=Dummy ]; If[cc*AA+dd<=VarH, jcd=Dummy ]; If[((aa=!=0)&&(BB>=If[cc===0,(dd-bb)/aa,(cc*AA+dd-bb)/aa]))||BB>=(aa*AA+bb-dd)/cc, BB=Dummy ]; Iu=AA; Io=Select[{BB,If[aa=!=0&&IntegerQ[1/aa],Idem,Floor][jab], If[IntegerQ[1/cc],Idem,Floor][jcd]},FreeQ[#,Dummy]&]; Erg=Sum[Sum[Expr,{var1,Iu,Min[Io]}], {var2,If[aa===0,bb,aa*unt1+bb],If[cc===0,dd,cc*unt1+dd]}], {False,True}, If[aa*BB+bb>=VarH, jab=Dummy ]; If[If[cc===0,dd,cc*BB+dd]<=VarH, jcd=Dummy ]; If[AA<=If[cc===0,(dd-bb)/aa,(cc*BB+dd-bb)/aa]||((cc=!=0)&&(AA<=(aa*BB+bb-dd)/cc)), AA=Dummy ]; Iu=Select[{AA,If[IntegerQ[1/aa],Idem,Ceiling][jab], If[cc=!=0&&IntegerQ[1/cc],Idem,Ceiling][jcd]},FreeQ[#,Dummy]&]; Io=BB; Erg=Sum[Sum[Expr,{var1,Max[Iu],Io}], {var2,If[aa===0,bb,aa*ob1+bb],If[cc===0,dd,cc*ob1+dd]}], {False,False}, If[unt1<=(cc*unt1+dd-bb)/aa, AA=Dummy; ]; If[ob1>=(aa*ob1+bb-dd)/cc, BB=Dummy; ]; Iu=Select[{AA,If[IntegerQ[1/aa],Idem,Ceiling][jab]},FreeQ[#,Dummy]&]; Io=Select[{BB,If[IntegerQ[1/cc],Idem,Floor][jcd]},FreeQ[#,Dummy]&]; Erg=Sum[Sum[Expr,{var1,Max[Iu],Min[Io]}], {var2,If[aa===0,bb,aa*ob1+bb],If[cc===0,dd,cc*unt1+dd]}], _,Erg=Sum[Sum[Expr,{var1,unt1,ob1}],{var2,unt2,ob2}] ], Erg=Sum[Sum[Expr,{var1,unt1,ob1}],{var2,unt2,ob2}], Erg=Sum[Sum[Expr,{var1,unt1,ob1}],{var2,unt2,ob2}] ]; If[$VersionNumber>=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; Erg ] Summe[Expr_,{var_,low_,upp_}]:=If[Factor[upp-low]>=0,Sum[Expr,{var,low,upp}], -Sum[Expr,{var,upp+1,low-1}],Sum[Expr,{var,low,upp}]] SumZerl:=Sum[Expr_,{var_,unt_,ob_}]:> Module[{m},m=Input["bottom-split by: "]; Summe[Expr,{var,unt,unt+m-1}]+Summe[Expr,{var,unt+m,ob}] ] SumShift:=Sum[Expr_,{var_,unt_,ob_}]:> Module[{m},m=Input["shift summation index by: "]; Sum[Expr/.var->var+m,{var,unt-m,ob-m}] ] SumUmkehr:=(If[ValueQ[pq[PPP,1,q]], Print[""]; Print["For your information:"]; Print["Automatic evaluation of pq and ph is active!"]; Print[""]; If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}]; ]; {ph[List1_List,List2_List,q_,z_]:>Module[{SumGrenze,LIST1,LIST2}, SumGrenze=Min[Union[Flatten[Map[GrenzeO[#,q]&,List1]]]]; If[$VersionNumber>=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; If[SumGrenze===Infinity||!FreeQ[SumGrenze,Min], ph[List1,List2,q,z], LIST1=Select[List1,(!(#===0))&]; LIST1=MComplement[LIST1,{q^(-SumGrenze)}]; LIST2=Select[List2,(!(#===0))&]; ((-1)^SumGrenze*q^(SumGrenze*(SumGrenze-1)/2))^(1+Length[List2]-Length[List1])* pq[LIST1,LIST2,SumGrenze,q]* (z)^SumGrenze*(-1)^SumGrenze*q^(-SumGrenze(SumGrenze+1)/2)* ph[Join[{q^(-SumGrenze)},Map[(q^(1-SumGrenze)/#)&,LIST2],Table[0,{Length[List1]}]], Join[Map[(q^(1-SumGrenze)/#)&,LIST1],Table[0,{Length[List2]+1}]],q, q*Apply[Times,LIST2]*q^SumGrenze* q^((1-SumGrenze)*(Length[List2]-Length[List1]+1+Length[LIST1]-Length[LIST2]))/ (z*Apply[Times,LIST1])] ] ], Sum[Expr_,{var_,unt_,ob_}]:>Module[{SumGrenze,ExList}, If[$VersionNumber>=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; ExList=Join[Cases[Dummy*Expr/.pqzerl,pq[vars__]]/.pq[x_,y_,q_:Global`q]->{x,q}, Cases[Dummy*Expr/.pqzerl,pq[vars__]^y_?Positive]/. pq[x_,y_,q_:Global`q]^z_->{x,q}]; SumGrenze=Min[Union[Flatten[Map[Apply[GrenzeO,#]&,ExList]]]]; SumGrenze=Min[Union[{SumGrenze,ob}]]; If[SumGrenze===Infinity||!FreeQ[SumGrenze,Min], Sum[Expr,{var,unt,ob}], Sum[ExpandAll[Expr/.var->(SumGrenze-var)], {var,0,SumGrenze-unt}]/.SumRegeln ] ]}); IntegerTest[0,q_]=False; IntegerTest[x_,q_]:=Module[{Var}, If[FreeQ[Var=Log[q,Simplify[x]],Log]&& !MemberQ[{Rational,Real,Complex},Head[Var]], If[Head[Var]===Integer, If[Var<=0,True,False,False], Switch[ Input[StringJoin["Is ",ToString[InputForm[Expand[-Var]]], " a nonnegative integer?\n[y|n]: "]], Global`y,True,Global`n,False]], False ]]; (*Funktionen fr die Limes-Bildung*) Unprotect[DirectedInfinity] DirectedInfinity/: (-1)^DirectedInfinity[x___]:=Indeterminate; DirectedInfinity/: q_^DirectedInfinity[1]:=Module[{m}, Switch[AbsLimes[q], Global`n,ComplexInfinity, Global`y,0, Global`u,AbsLimes[q]=.; Switch[AbsLimes[q], Global`n,ComplexInfinity, Global`y,0, _,Indeterminate], _,Indeterminate] ]; DirectedInfinity/: q_^DirectedInfinity[-1]:=Module[{m}, Switch[AbsLimes[q], Global`n,0, Global`y,ComplexInfinity, Global`u,AbsLimes[q]=.; Switch[AbsLimes[q], Global`n,0, Global`y,ComplexInfinity, _,Indeterminate], _,Indeterminate] ]; Protect[DirectedInfinity]; pq[Indeterminate,n_,q_:Global`q]=Indeterminate pq[a_,Indeterminate,q_:Global`q]=Indeterminate (*pqinf[Indeterminate,n_,q_:Global`q]=Indeterminate pqinf[a_,Indeterminate,q_:Global`q]=Indeterminate*) ph[Indeterminate,List2_List,q_,z_]=Indeterminate ph[List1_List,Indeterminate,q_,z_]=Indeterminate ph[List1_List,List2_list,q_,Indeterminate]=Indeterminate pq[DirectedInfinity[x___],n_,q_:Global`q]=Indeterminate pq[a_,DirectedInfinity[x___],q_:Global`q]=Indeterminate pqinf[DirectedInfinity[x___],n_,q_:Global`q]=Indeterminate pqinf[a_,DirectedInfinity[x___],q_:Global`q]=Indeterminate ph[DirectedInfinity[x___],List2_List,q_,z_]=Indeterminate ph[List1_List,DirectedInfinity[x___],q_,z_]=Indeterminate ph[List1_List,List2_List,q_,DirectedInfinity[x___]]=Indeterminate AbsSmaller[x_]:=Module[{AbsDiff}, AbsDiff=Select[AbsList,!FreeQ[#,x]&]; Map[(AbsLimes[#]=.)&,AbsDiff]; AbsList=Complement[AbsList,AbsDiff]; AbsLimes[x]=Global`y; AbsList=Union[AbsList,{x}];]; AbsGreater[x_]:=Module[{AbsDiff}, AbsDiff=Select[AbsList,!FreeQ[#,x]&]; Map[(AbsLimes[#]=.)&,AbsDiff]; AbsList=Complement[AbsList,AbsDiff]; AbsLimes[x]=Global`n; AbsList=Union[AbsList,{x}];]; AbsUndetermined[x_]:=Module[{AbsDiff}, AbsDiff=Select[AbsList,!FreeQ[#,x]&]; Map[(AbsLimes[#]=.)&,AbsDiff]; AbsList=Complement[AbsList,AbsDiff]; AbsLimes[x]=Global`u;]; AbsLimes[Global`q]=Global`y; AbsList={Global`q}; AbsLimes[q_]:=Module[{Bas,Expo}, Bas=(q/.x_^exp_ :>x); If[NumberQ[Expo=Log[Bas,q]], If[MemberQ[AbsList,Bas], Switch[AbsLimes[Bas], Global`y,If[Expo>0,AbsSmaller[q],AbsGreater[q]], Global`n,If[Expo>0,AbsGreater[q],AbsSmaller[q]], Global`u,AbsUndetermined[q], _,Print["Error: AbsLimes[",Bas,"] is neither y, n nor u"] ], If[Global`DOSFrage, Print["Is ",Bas," smaller than 1?"], Print["Is |",Bas,"| smaller than 1?"]]; AbsLimes[Bas]=Input["[y|n|u]: "]; AbsList=Union[AbsList,{Bas}]; Switch[AbsLimes[Bas], Global`y,If[Expo>0,AbsSmaller[q],AbsGreater[q]], Global`n,If[Expo>0,AbsGreater[q],AbsSmaller[q]], Global`u,AbsUndetermined[q], _,Print["Warning: Erroneous input. Only y, n, or u is allowed."] ] ], If[Global`DOSFrage, Print["Is ",q," smaller than 1?"], Print["Is |",q,"| smaller than 1?"]]; AbsLimes[q]=Input["[y|n|u]: "]; ]; AbsLimes[q] ] pqLimes[pq[A_,N_,Q_:Global`q],Regel_Rule]:=Module[{pqExpr,ZwExpr}, Switch[Q^Infinity,0,pqExpr=pq[A,N,Q], ComplexInfinity,pqExpr=pq[A,N,Q]/.inv1, _,Return[Indeterminate]]; If[Limit[Q,Regel]===1, ZwExpr=pqExpr; If[Limit[A,Regel]===1, If[!ValueQ[Hyp`m`p[PPP,0]], < (Hyp`m`p[Limit[Log[qq,aa],Regel],nn/.Regel]*(1-qq)^nn)^(exp), ZwExpr/.pq[aa_,nn_,qq_:Global`q]^(exp_:1):> (1-Limit[aa,Regel])^(nn*exp) ], ZwExpr=(pqExpr/.pq[aa_,nn_,qq_:Global`q]^(exp_:1):> pq[aa/.Regel,nn/.Regel,qq/.Regel]^exp); If[FreeQ[ZwExpr,Indeterminate]&& FreeQ[ZwExpr,DirectedInfinity], Return[ZwExpr], ZwExpr=(Cases[Dummy*pqExpr,pq[aa_,nn_,qq_:Global`q]^(exp_:1)][[1]]/. pq[aa_,nn_,qq_:Global`q]^(exp_:1):>nn/.Regel); If[FreeQ[ZwExpr,Indeterminate]&&FreeQ[ZwExpr,DirectedInfinity], Return[pqExpr/.pq[aa_,nn_,qq_:Global`q]^(exp_:1):> ((-1)^nn*qq^(nn*(nn-1)/2)*aa^nn)^exp], Switch[ZwExpr, -Infinity,pqExpr=(pqExpr/.neg1), Infinity,1, _,Return[Indeterminate] ]; ZwExpr=(Cases[Dummy*pqExpr,pq[aa_,nn_,qq_:Global`q]^(exp_:1)][[1]]/. pq[aa_,nn_,qq_:Global`q]^(exp_:1):>aa/.Regel); If[!FreeQ[ZwExpr,Indeterminate]||!FreeQ[ZwExpr,DirectedInfinity], pqExpr=(pqExpr/.trans); ]; pqExpr=(pqExpr/.pq[aa_,nn_,qq_:Global`q]^(exp_:1):>pqinf[aa/.Regel,qq/.Regel]^exp); If[FreeQ[pqExpr,Indeterminate]&&FreeQ[pqExpr,DirectedInfinity], Return[pqExpr], Return[Indeterminate]] ] ] ] ]; GDummy[1]=0; pqinfLimes[pqinf[A_,Q_:Global`q],Regel_Rule]:=Module[{pqinfExpr,ZwExpr}, If[Limit[Q,Regel]===1, If[Limit[A,Regel]===1, ZwExpr=Limit[Log[Q,A],Regel]; If[!ValueQ[Hyp`m`p[PPP,0]], <Module[{LIST1,LIST2}, LIST1=Select[List1,(!(#===0))&]; LIST2=Select[List2,(!(#===0))&]; ph[Join[1/LIST1, Table[0,{Length[List2]+1}]], Join[1/LIST2, Table[0,{Length[List1]}]], 1/q,z*Apply[Times,LIST1]/Apply[Times,LIST2]/q]/.phOrdne ]); Phinv:=(Ph[L___,z_]:>Module[{TopA,BottomA,Bas,ArgA}, TopA=Table[{L}[[3*ii+1]],{ii,0,(Length[{L}]-1)/3}]; BottomA=Table[{L}[[3*ii+2]],{ii,0,(Length[{L}]-2)/3}]; Bas=Table[{L}[[3*ii+3]],{ii,0,(Length[{L}]-3)/3}]; TopA=Table[Select[TopA[[ii]],(!(#===0))&],{ii,1,Length[TopA]}]; BottomA=Table[Select[BottomA[[ii]],(!(#===0))&],{ii,1,Length[BottomA]}]; ArgA=z*Product[Apply[Times,TopA[[ii]]]/Apply[Times,BottomA[[ii]]],{ii,1,Length[TopA]}]/Bas[[1]]; Ph[Argument[ Join[{Join[1/TopA[[1]],Table[0,{Length[{L}[[2]]]+1}]], Join[1/BottomA[[1]],Table[0,{Length[{L}[[1]]]}]],1/Bas[[1]]}, Apply[Join, Table[{Join[1/TopA[[ii]],Table[0,{Length[{L}[[3*ii-1]]]}]], Join[1/BottomA[[ii]],Table[0,{Length[{L}[[3*ii-2]]]}]],1/Bas[[ii]]},{ii,2,Length[TopA]}]]]],ArgA](*/.PhOrdne*) ]); psinv:=(ps[List1_List,List2_List,q_,z_]:>Module[{LIST1,LIST2}, LIST1=Select[List1,(!(#===0))&]; LIST2=Select[List2,(!(#===0))&]; ps[Join[1/LIST1, Table[0,{Length[List2]}]], Join[1/LIST2, Table[0,{Length[List1]}]], 1/q,z*Apply[Times,LIST1]/Apply[Times,LIST2]]/.psOrdne ]); phLimes[ph[List1_,List2_,q_,z_],Regel_Rule]:= Module[{phErg,Liste1,Liste2,phArgu}, Switch[q^Infinity,0,phErg=ph[List1,List2,q,z], ComplexInfinity,phErg=ph[List1,List2,q,z], _,Return[Indeterminate]]; phArgu=phErg[[4]]; If[Limit[q,Regel]===1, parLimesoben[par_,Regel1_Rule]:= If[Limit[par,Regel1]===1, phArgu*=(1-q);Limit[Log[q,par],Regel1], phArgu*=(Limit[-1+par,Regel1]);Empty]; parLimesunten[par_,Regel2_Rule]:= If[Limit[par,Regel2]===1, phArgu/=(1-q);Limit[Log[q,par],Regel2], phArgu/=(Limit[-1+par,Regel2]);Empty]; Liste1=Map[parLimesoben[#,Regel]&,phErg[[1]]]; Liste1=Select[Liste1,(#=!=Empty)&]; Liste2=Map[parLimesunten[#,Regel]&,phErg[[2]]]; Liste2=Select[Liste2,(#=!=Empty)&]; If[!ValueQ[Hyp`m`p[PPP,0]], <Module[{even}, If[!NumberQ[exp], Print["Is ",Factor[exp]," even, odd, or neither of both?"]; even=Input["[e|o|n]: "]; Switch[even,Global`e,1,Global`o,-1,Global`n,(-1)^exp, _,Print["Warning: Erroneous input. Only e, o or n is allowed."]], (-1)^exp ] ]); MinusOneLim[var_]:=((-1)^exp_ :>Module[{even}, Print["Is ",Factor[exp]," even, odd, or neither of both?"]; even=Input["[e|o|n]: "]; Switch[even,Global`e,1,Global`o,-1,Global`n,(-1)^exp, _,Print["Warning: Erroneous input. Only e, o or n is allowed."]]]/; !FreeQ[exp,var]); Limes[Expr_,Regel_Rule]:=Module[{Eingabe,ZwAusgabe,Ausgabe,even,BasListe, ZerlListe,Nenner,ii}, If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}]; Eingabe=Expr/.DirectedInfinity->SInfinity; ZwAusgabe=Expr/.pqinfzerl; ZwAusgabe=(ZwAusgabe/.(pqinf[a_,q_:Global`q]:>(pqinf[a^2,q^2]/pqinf[-a,q])/;Limit[a,Regel]===-1)); BasListe=Position[Expr,pqinf[x__,q_]]; BasListe=Table[Expr[[Argument[BasListe[[ii]]]]],{ii,1,Length[BasListe]}]; BasListe=BasListe/.{pqinf[y__,qq_]^(ex_:1):>qq}; BasListe=Union[BasListe]; If[Length[BasListe]>1, baszerl[arg_]:= pqinf[a_,q_:Global`q]^(exp_:1)->Product[pqinf[a*q^k,q^arg],{k,0,arg-1}]^exp; ZerlListe=Map[Log[#,BasListe[[1]]]&,BasListe]; If[Complement[Union[Map[Head,ZerlListe]],{Integer,Rational}]==={}, Nenner=Apply[LCM,Map[Denominator,ZerlListe]]; ZerlListe=ZerlListe*Nenner; For[ii=1,ii<=Length[ZerlListe],ii++, ZwAusgabe=(ZwAusgabe//.(pqinf[x_,BasListe[[ii]]]:> (pqinf[x,BasListe[[ii]]]/.baszerl[ZerlListe[[ii]]]))); ] ] ]; BasListe=Position[ZwAusgabe,pq[x_,n_,q_]]; BasListe=Table[ZwAusgabe[[Argument[BasListe[[ii]]]]],{ii,1,Length[BasListe]}]; BasListe=BasListe/.{pq[y_,m_,qq_]^(ex_:1):>qq}; BasListe=Union[BasListe]; ZwAusgabe=ZwAusgabe/.pqzerl; If[Length[BasListe]>1, baszerl[arg_]:= pq[a_,nn_,q_:Global`q]^(exp_:1)->Product[pq[a*q^k,nn/arg,q^arg],{k,0,arg-1}]^exp; ZerlListe=Map[Log[#,BasListe[[1]]]&,BasListe]; If[Complement[Union[Map[Head,ZerlListe]],{Integer,Rational}]==={}, Nenner=Apply[LCM,Map[Denominator,ZerlListe]]; ZerlListe=ZerlListe*Nenner; For[ii=1,ii<=Length[ZerlListe],ii++, ZwAusgabe=(ZwAusgabe//.(pq[x_,nn_,BasListe[[ii]]]:> (pq[x,nn,BasListe[[ii]]]/.baszerl[ZerlListe[[ii]]]))); ] ] ]; ZwAusgabe=(ZwAusgabe//.Expandq/.pqzerl /.(Binomialq->Binomialpq)/.(Factorialq->Factorialpq) /.(pq[a_,n_,q_:Global`q]^(exp_:1):>pqLimes[pq[a,n,q],Regel]^exp) /.(pqinf[a_,q_:Global`q]^(exp_:1):>pqinfLimes[pqinf[a,q],Regel]^exp) /.(ph[List1_,List2_,q_,z_]^(exp_:1):>phLimes[ph[List1,List2,q,z],Regel]^exp) /.(Sum[SExpr_,{Grenzen__}]^(exp_:1):>Sum[Limit[SExpr//.Expandq,Regel], {Limit[{Grenzen}[[1]],Regel],Limit[{Grenzen}[[2]]//.Expandq,Regel], Limit[{Grenzen}[[3]]//.Expandq/.DirectedInfinity->SInfinity,Regel]}]^exp) //.Expandq/.MinusOneLim[Regel[[1]]]); Ausgabe=Limit[ZwAusgabe,Regel]; If[!FreeQ[Ausgabe,Limit],Ausgabe=Ausgabe[[1]]/.Regel]; If[!FreeQ[Ausgabe,DirectedInfinity],Ausgabe=ZwAusgabe/.Regel]; If[$VersionNumber>=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; If[FreeQ[Ausgabe,DirectedInfinity]&&FreeQ[Ausgabe,Indeterminate]&& FreeQ[Ausgabe,GDummy](*&&FreeQ[Ausgabe,Limit]*), If[Head[Expr]===Equal,LS=Ausgabe[[1]];RS=Ausgabe[[2]];]; Ausgabe/.SInfinity->DirectedInfinity, Print[""];Print["The expression"];Print[""]; Print[ZwAusgabe/.SInfinity->DirectedInfinity];Print[""];Print["was obtained."]; Print[""];Print["Therefore the limit ", Regel, " could not be determined."]; Print["Here is your expression:"];Expr] ] (*Funktionen fr das Schreiben in Dateien und zum Ausdrucken*) SchreibeZahl=0; TeXMat[Expr_,Datei_,Komment_:0]:=Module[{TeXExpr,MatDat,TeXDat}, SchreibeZahl+=1;TeXExpr=TeXForm[Expr]; MatDat=StringJoin[ToString[Datei],".m"]; TeXDat=StringJoin[ToString[Datei],".tex"]; If[Komment=!=0, PutAppend[Komment,MatDat]; ]; OpenAppend[MatDat]; Write[MatDat,OutputForm[StringJoin["A[",ToString[SchreibeZahl],"]:="]]]; Close[MatDat]; PutAppend[Expr,MatDat]; If[Komment=!=0, PutAppend[Komment,TeXDat]; ]; OpenAppend[TeXDat]; Write[TeXDat,OutputForm[StringJoin["A[",ToString[SchreibeZahl],"]:="]]]; Close[TeXDat]; PutAppend[TeXExpr,TeXDat]; ]; Drucke[x_,y_:OutputForm]:=Module[{}, OpenWrite["druck", FormatType -> y]; Write["druck",x]; Close["druck"]; Run["copy druck prn"]; Run["del druck"]; ]; End[]; Protect[ hypqAttributes, SumRegeln, SumSammle, Sumph, phSum, SumInfinity, Gleichung, GlTausche, Mal, Add, Div, Sub, Hoch, negpos, Freek, IntegerTest, Expandq, pq, Binomialq, Binomialpq, Factorialq, Factorialpq, pqaufl, pqzerl, pqzus, pqinf, pqinfzerl, pqinfzus, ph, W, Ph, ps, PQ, TeXphW, phCancel, phFormat, TeX, LaTeX, AmSTeX, AmSLaTeX, ManipulationsListe, neg1, neg2, trans, inv1, inv2, lina1, lina2, linz, zus1, zus2, zus3, erw1, erw2, zerl, baszerl1, baszus1, baszerl2, baszus2, Ers, Subst, PQSort, phEinf, phinv, Phinv, psinv, phOrdne, phPerm, PhPerm, psPerm, phTausche, PosListe, SumErw1, SumErw2, SumShift, SumTausche, SumZerl, SumUmkehr, Limes, AbsGreater, AbsSmaller, AbsUndetermined, MinusOne, TeXMat, Drucke ] EndPackage[]; (*Vorausdefinieren von summatio.q*) BeginPackage["Summatio`q`"] SListe::usage = "\nDescription: Rule that gives for a basic hypergeometric series a list of \n applicable summation formulas. Each entry of this list has the format \n {ArgumentPermutations,S}, where \"ArgumentPermutations\" is a \n sequence of reorderings of the parameters of the basic hypergeometric \n series (given in terms of \"phPerm\" and \"phTausche\") and \"S\" \n is the name of the summation in form of a rule which can be applied \n subsequently. You should be aware that \"SListe\" automatically applies \n \"phOrdne\" before checking which summation could be applied. \nUsage: Expr/.SListe. \nSee also: TListe, phPerm, phTausche, SumListe." Srs01::usage = "\nSummation formula (Gasper, (7)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe."; Srs02::usage = "\nSummation formula (Gasper, (14)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe."; Srs03::usage = "\nSummation formula (Gasper, (8,9,10,16)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe."; Srs04::usage = "\nSummation formula (Gasper, (15)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe."; Srs05::usage = "\nSummation formula (Gasper, (11)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe."; Srs06::usage = "\nSummation formula (Gasper, (12,13)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe."; S1001::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.3)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S1101::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.5)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2101::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.6)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2102::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.7)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2103::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.8)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2104::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.9)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2105::usage = "\nSummation formula (Gasper/Rahman, Ex. 1.6(i)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2106::usage = "\nSummation formula (Gasper/Rahman, Ex. 1.7) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2107::usage = "\nSummation formula (Gasper/Rahman, Ex. 1.8) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2201::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.10)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2202::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.11)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S3201::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.12)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S3203::usage = "\nSummation formula (Gasper/Rahman, Ex. 2.1) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S3204::usage = "\nSummation formula (Gasper/Rahman, Ex. 3.9) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4301::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.13)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4302::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.14)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S3202::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.15)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S8702::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.16)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4303::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.17)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S8703::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.18)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4304::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.19)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4305::usage = "\nSummation formula (Gasper/Rahman, Ex. 2.6) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4306::usage = "\nSummation formula (Gasper/Rahman, Ex. 2.14(i)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4307::usage = "\nSummation formula (Gasper/Rahman, (2.7.2)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4308::usage = "\nSummation formula (Gasper/Rahman, (2.8.3), c->Sqrt[a*q], d->-q*Sqrt[a], \n sum the 8phi7 by Gasper/Rahman Appendix (II.22)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S5401::usage = "\nSummation formula (Gasper/Rahman, (2.7.1), d->-Sqrt[a*q]) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S5402::usage = "\nSummation formula (Gasper/Rahman, (2.8.3), c->q*Sqrt[a], d->-q*Sqrt[a], \n sum the 8phi7 by Gasper/Rahman Appendix (II.22)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S5501::usage = "\nSummation formula (Gasper/Rahman, (2.7.1), d->Infinity) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S6501::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.20)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S6502::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.21)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S8701::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.22)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S8704::usage = "\nSummation formula (Gasper/Rahman, Ex. 3.10) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S2161::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.23)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S3261::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.24)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S4361::usage = "\nSummation formula (Gasper/Rahman, Ex. 2.9) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S8761::usage = "\nSummation formula (Gasper/Rahman, Appendix (II.25)) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." S10901::usage = "\nSummation formula (Gasper/Rahman, Ex. 2.12) in form of a rule. \nSee also: SListe, SumListe, Ers, PosListe." SumListe::usage = "\nList of all summation formulas. \nSee also: SumListe$gl, SListe." SListe:=(<\" \n is the name of the transformation in form of a rule which can be applied \n subsequently. You should be aware that \"TListe\" automatically applies \n \"phOrdne\" before checking which transformation could be applied. \nUsage: Expr/.TListe. \nSee also: SListe, phPerm, phTausche, TransListe." Trs01::usage = "\nSummation formula (Gasper, (19,20), also reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe."; T2101::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.1)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2102::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.2)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2103::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.3)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2104::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.4)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2105::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.5)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2201::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.4), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3201::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.5), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2106::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.6)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2107::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.7)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2108::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.8)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3202::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.6), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3203::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.7), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3101::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.8), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3204::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.9)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3205::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.10)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3206::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.11)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3207::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.12)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3208::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.13)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3209::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.14)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4301::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.15)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4302::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.16)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8701::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.17)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8702::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.18)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4303::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.19)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4304::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.20)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8703::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.20), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4305::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.21)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4306::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.21), reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4307::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.22)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8704::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.23)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8705::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.24)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5401::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.25)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121101::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.25), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5402::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.26)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121102::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.26), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T7601::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.27)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121103::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.27), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10901::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.28)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2161::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.31)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2162::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.32)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3261::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.33)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3262::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.34)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3263::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.33), reversed) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3264::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.34), reversed) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3265::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.35)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8761::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.36)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8762::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.37)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8763::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.37), reversed) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10961::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.39)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4308::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.2) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2109::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.2, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4309::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.13(i)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10902::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.13(i), reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4310::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.13(ii)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8706::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.13(ii), reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T6501::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.14(ii)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121104::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.14(ii), reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8764::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.15) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10903::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.19) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3210::usage = "\nTransformation formula (Gasper/Rahman, (3.2.6)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5461::usage = "\nTransformation formula (Gasper/Rahman, (3.4.4)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5462::usage = "\nTransformation formula (Gasper/Rahman, (3.4.4), reversed, first form)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5463::usage = "\nTransformation formula (Gasper/Rahman, (3.4.4), reversed, second form)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2110::usage = "\nTransformation formula (Gasper/Rahman, (3.4.7)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8707::usage = "\nTransformation formula (Gasper/Rahman, (3.4.7), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4311::usage = "\nTransformation formula (Gasper/Rahman, (3.4.8)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8708::usage = "\nTransformation formula (Gasper/Rahman, (3.4.8), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3266::usage = "\nTransformation formula (Gasper/Rahman, (3.5.2)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5464::usage = "\nTransformation formula (Gasper/Rahman, (3.5.2), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2111::usage = "\nTransformation formula (Gasper/Rahman, (3.5.4)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8709::usage = "\nTransformation formula (Gasper/Rahman, (3.5.4), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10962::usage = "\nTransformation formula (Gasper/Rahman, (3.5.7)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5465::usage = "\nTransformation formula (Gasper/Rahman, (3.5.7), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8710::usage = "\nTransformation formula (Gasper/Rahman, (3.5.10)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T8711::usage = "\nTransformation formula (Gasper/Rahman, (3.5.10), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10904::usage = "\nTransformation formula (Gasper/Rahman, (3.10.4)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5403::usage = "\nTransformation formula (Gasper/Rahman, (3.10.4), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5404::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.14), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5405::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.22), reversed)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3211::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.1) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3212::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.1, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3213::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.2(i)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2112::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.2(i), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3214::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.2(ii)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2202::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.2(ii), reversed) in form \n of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3215::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.3) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3216::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.3, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3217::usage = "\nTransformation formula (Gasper/Rahman, (3.2.11)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe."; T4312::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.4) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4201::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.4, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3267::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.6) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3268::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.6, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T2163::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.8) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T3269::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.8, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4361::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.16) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T4362::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.36), reversed) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5466::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.16, reversed, first form) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5467::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.16, reversed, second form) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T7701::usage = "\nTransformation formula (Gasper/Rahman, (3.2.11), reversed) in form of \n a rule. \nSee also: TListe, TransListe, Ers, PosListe."; T10905::usage = "\nTransformation formula (Gasper/Rahman, Ex. 3.21(iii)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121105::usage = "\nTransformation formula (Rahman/Verma, (7.7)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10906::usage = "\nTransformation formula (Rahman/Verma, (7.7), reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121106::usage = "\nTransformation formula (Rahman/Verma, (7.8)) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10907::usage = "\nTransformation formula (Rahman/Verma, (7.8), reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5468::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.25) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T5469::usage = "\nTransformation formula (Gasper/Rahman, Appendix (III.35), reversed) in \n form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T121161::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.25, reversed) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." T10963::usage = "\nTransformation formula (Gasper/Rahman, Ex. 2.30) in form of a rule. \nSee also: TListe, TransListe, Ers, PosListe." TransListe::usage = "\nList of all transformation formulas. \nSee also: TransListe$gl, TListe." TListe:=(< \nSee also: ZB, RunMode." Prove::usage = "\nDescription: Entering \"Prove\" at the prompt creates a proof of the \n last example solved by ZB. \nUsage: Prove. \nSee also: ZB, RunMode, FileName." ZBq[recvar_,order_]:=Module[{Zw1},Expr_ :> ( If[ValueQ[Hyp`q`pq[PPP,1,q]], Zw1=(Expr/.Hyp`q`SumSammle/.Hyp`q`pqzerl/.Hyp`q`pqinfzerl/. Hyp`q`pq[xx_,nn_,qq_]:>Global`qfac[xx,qq,nn]/.Hyp`q`Binomialq[nn_,kk_,qq_:Global`q]->Global`qBinomial[nn,kk,qq]); Unprotect[Sum]; Sum[Hyp`q`Private`x__,Hyp`q`Private`y_]=.; Zw1=(Zw1/.Sum[Summand_,{svar_,do_,up_}]:> fastZeil`qZeil[Summand,{svar,If[Position[Denominator[Summand],Expand[svar-do]!]=!={},-Infinity,do],up},recvar,order]); Hyp`q`Private`SumDef; Zw1, Hyp`q`Private`GrenzeO[-recvar]={Infinity}; Hyp`q`PQ; Zw1=(Expr/.Hyp`q`SumSammle/.Hyp`q`pqzerl/.Hyp`q`pqinfzerl/. Hyp`q`pq[xx_,nn_,qq_]:>Global`qfac[xx,qq,nn]/.Hyp`q`Binomialq[nn_,kk_,qq_:Global`q]->Global`qBinomial[nn,kk,qq]); Unprotect[Sum]; Sum[Hyp`q`Private`x__,Hyp`q`Private`y_]=.; Zw1=(Zw1/.Sum[Summand_,{svar_,do_,up_}]:> fastZeil`qZeil[Summand,{svar,If[Position[Denominator[Summand],Expand[svar-do]!]=!={},-Infinity,do],up},recvar,order]); Hyp`q`Private`GrenzeO[-recvar]=.; Hyp`q`PQ; Hyp`q`Private`SumDef; Zw1 ])] Fnk:=fastZeil`Fnk; GoRat:=fastZeil`GoRat; GoSol:=fastZeil`GoSol; Cert:=fastZeil`Cert; DegBound:=fastZeil`DegBound; System:=fastZeil`System; SystemDimension:=fastZeil`SystemDimension; Prove:=fastZeil`Prove; RunMode:=fastZeil`RunMode; SolAmount:=fastZeil`SolAmount; FileName:=fastZeil`FileName; Protect[ ZB, GOSPER ] EndPackage[] BeginPackage["fastZeil`"] qZeil[X___]:=(Clear[qZeil]; If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}]; <=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; qZeil[X]); Gosper[X___]:=(Clear[Gosper]; If[$VersionNumber>=2.,$Messages=OutputStream["",1],$Messages={}]; <=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}]; Gosper[X]); EndPackage[] $ContextPath=Join[Drop[$ContextPath,1],{$ContextPath[[1]]}] <=2.,$Messages=OutputStream["stdout",1],$Messages={"stdout"}];