(* pu6.m: S. A. Fulling, Nov. 1995 (first version summer 1994) *) Off[General::spell1] Share[]; orderRules = { x1^(n1_)*x2^(n2_) :> x1^n2*x2^n1 /; n2 > n1, x1^(n1_)*x3^(n3_) :> x1^n3*x3^n1 /; n3 > n1, x2^(n2_)*x3^(n3_) :> x2^n3*x3^n2 /; n3 > n2, x1^(n1_)*x4^(n4_) :> x1^n4*x4^n1 /; n4 > n1, x2^(n2_)*x4^(n4_) :> x2^n4*x4^n2 /; n4 > n2, x3^(n3_)*x4^(n4_) :> x3^n4*x4^n3 /; n4 > n3, x1^(n1_)*x5^(n5_) :> x1^n5*x5^n1 /; n5 > n1, x2^(n2_)*x5^(n5_) :> x2^n5*x5^n2 /; n5 > n2, x3^(n3_)*x5^(n5_) :> x3^n5*x5^n3 /; n5 > n3, x4^(n4_)*x5^(n5_) :> x4^n5*x5^n4 /; n5 > n4, x1^(n1_)*x6^(n6_) :> x1^n6*x6^n1 /; n6 > n1, x2^(n2_)*x6^(n6_) :> x2^n6*x6^n2 /; n6 > n2, x3^(n3_)*x6^(n6_) :> x3^n6*x6^n3 /; n6 > n3, x4^(n4_)*x6^(n6_) :> x4^n6*x6^n4 /; n6 > n4, x5^(n5_)*x6^(n6_) :> x5^n6*x6^n5 /; n6 > n5 }; qmax = 5 max = 2(qmax+1) link12 = Sum[t^(2j) c[j] x1^j x2^j, {j, 0, qmax}] + O[t]^max link13 = link12 /. x2->x3; link23 = link13 /. x1->x2; link14 = link12 /. x2->x4; link24 = link14 /. x1->x2; link34 = link14 /. x1->x3; link15 = link12 /. x2->x5; link25 = link15 /. x1->x2; link35 = link15 /. x1->x3; link45 = link15 /. x1->x4; link16 = link12 /. x2->x6; link26 = link16 /. x1->x2; link36 = link16 /. x1->x3; link46 = link16 /. x1->x4; link56 = link16 /. x1->x5; point1 = Sum[t^(2j) c[j] x1^(2j), {j, 0, qmax}] + O[t]^max point2 = point1 /. x1 -> x2; point3 = point1 /. x1 -> x3; point4 = point1 /. x1 -> x4; point5 = point1 /. x1 -> x5; point6 = point1 /. x1 -> x6; pointpair12 = Sum[t^(4j) c[j]^2 x1^(2j) x2^(2j), {j, 0, Floor[qmax/2]}] + O[t]^max pointpair34 = pointpair12 //. {x1 -> x3, x2 -> x4}; pointpair56 = pointpair12 //. {x1 -> x5, x2 -> x6}; pointpair45 = pointpair34 /. x3 -> x5; angle3 = Sum[t^(4j) c[j]^2 x1^j x2^j x3^(2j), {j, 0, Floor[qmax/2]}] + O[t]^max angle4 = angle3 /. x3 -> x4; angle51 = angle3 /. x3 -> x5; angle53 = angle51 //. {x1 -> x3, x2 -> x4}; angle61 = angle51 /. x5 -> x6; angle63 = angle53 /. x5 -> x6; angle64 = angle61 //. {x1 -> x4, x2 -> x5}; pointtriple = Sum[t^(6j) c[j]^3 x1^(2j) x2^(2j) x3^(2j), {j, 0, Floor[qmax/3]}] + O[t]^max linktriple = pointtriple; newpointtriple = pointtriple //. {x1 -> x4, x2 -> x5, x3 -> x6}; newlinktriple = newpointtriple; biglinktriple = Sum[t^(6j) c[j]^3 x1^j x2^j x3^j x4^j x5^j x6^j, {j, 0, Floor[qmax/3]}] + O[t]^max pyramid4 = Sum[t^(6j) c[j]^3 x1^j x2^j x3^j x4^(3j), {j, 0, Floor[qmax/3]}] + O[t]^max pyramid5 = pyramid4 /. x4 -> x5; pyramid6 = pyramid4 /. x4 -> x6; linkpair13 = Sum[t^(4j) c[j]^2 x1^j x2^j x3^j x4^j, {j, 0, Floor[qmax/2]}] + O[t]^max linkpair15 = linkpair13 //. {x3 -> x5, x4 -> x6}; linkpair35 = linkpair15 //. {x1 -> x3, x2 -> x4}; pointquad = Sum[t^(8j) c[j]^4 x1^(2j) x2^(2j) x3^(2j) x4^(2j), {j, 0, Floor[qmax/4]}] + O[t]^max linkquad = pointquad; quadpyr5 = Sum[t^(8j) c[j]^4 x1^j x2^j x3^j x4^j x5^(4j), {j, 0, Floor[qmax/4]}] + O[t]^max quadpyr6 = quadpyr5 /. x5 -> x6; pyrpair = Sum[t^(12j) c[j]^6 x1^(2j) x2^(2j) x3^(2j) x4^(3j) x5^(3j), {j, 0, Floor[qmax/6]}] + O[t]^max pointquint = Sum[t^(10j) c[j]^5 x1^(2j) x2^(2j) x3^(2j) x4^(2j) x5^(2j), {j, 0, Floor[qmax/5]}] + O[t]^max linkquint = pointquint; quintpyr = Sum[t^(10j) c[j]^5 x1^j x2^j x3^j x4^j x5^j x6^(5j), {j, 0, Floor[qmax/5]}] + O[t]^max quadpyrpair = Sum[t^(8j) c[j]^4 x1^j x2^j x3^j x4^j x5^(2j) x6^(2j), {j, 0, Floor[qmax/4]}] + O[t]^max pointsex = Sum[t^(12j) c[j]^6 x1^(2j) x2^(2j) x3^(2j) x4^(2j) x5^(2j) x6^(2j), {j, 0, Floor[qmax/6]}] + O[t]^max linksex = pointsex; identity = link12*link13*link23*link14*link24*link34*link15*link25*link35* link45*link16*link26*link36*link46*link56* point1*point2*point3*point4*point5*point6; transpos = link12*link34*link35*link45*link36*link46*link56* angle3*angle4*angle51*angle61*pointpair12*point3*point4*point5*point6; threecycles = linktriple*pyramid4*pyramid5*pyramid6*link45*link46*link56* pointtriple*point4*point5*point6; transposprs = link12*link34*linkpair13^2*angle51*angle53*angle61*angle63* link56*pointpair12*pointpair34*point5*point6; fourcycles = linkquad*linkpair13*quadpyr5*quadpyr6*link56* pointquad*point5*point6; transpthreecyc = linktriple*link45*pyrpair*pyramid6*angle64* pointtriple*pointpair45*point6; fivecycles = linkquint^2*pointquint*quintpyr*point6; transpostrip = link12*link34*link56*linkpair13^2*linkpair15^2*linkpair35^2* pointpair12*pointpair34*pointpair56; transpfourcyc = linkquad*linkpair13*quadpyrpair^2*link56* pointquad*pointpair56; threecycprs = linktriple*newlinktriple*biglinktriple^3* pointtriple*newpointtriple; cyclics = linksex^2*biglinktriple*pointsex; pu6series = (1/720)(identity + 15*transpos + 40*threecycles + 45*transposprs + 90*fourcycles + 120*transpthreecyc + 144*fivecycles + 15*transpostrip + 90*transpfourcyc + 40*threecycprs + 120*cyclics); pu6temp = (Expand[Normal[pu6series] * x1^2 x2^2 x3^2 x4^2 x5^2 x6^2] //. orderRules)/(x1^2 x2^2 x3^2 x4^2 x5^2 x6^2); pu6 = Collect[pu6temp, Prepend[Table[c[qmax-i], {i,0,qmax}], t]] pu6point = pu6 //. c[n_] -> 1 pu6line = pu6 //. {x1->1, x2->1, x3->1, x4->1, x5->1, x6->1} pu6total = pu6line //. c[n_] -> 1 Save["pu6.out", pu6, pu6point, pu6line, pu6total] Quit[]