(* pu5.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
   };

qmax = 6  
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;
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;
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};
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};
pointtriple = Sum[t^(6j) c[j]^3 x1^(2j) x2^(2j) x3^(2j), 
                                      {j, 0, Floor[qmax/3]}] + O[t]^max
linktriple = pointtriple;
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;
linkpair = Sum[t^(4j) c[j]^2 x1^j x2^j x3^j x4^j, 
                                      {j, 0, Floor[qmax/2]}] + O[t]^max
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;
quadpyr = Sum[t^(8j) c[j]^4 x1^j x2^j x3^j x4^j x5^(4j), 
                                      {j, 0, Floor[qmax/4]}] + O[t]^max
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; 

identity =  link12*link13*link23*link14*link24*link34*link15*link25*
                      link35*link45*point1*point2*point3*point4*point5;
transpos = link12*link34*link35*link45*angle3*angle4*angle51*
                      pointpair12*point3*point4*point5;
threecycles = linktriple*pyramid4*pyramid5*link45*pointtriple*point4*point5;
transposprs = link12*link34*linkpair^2*angle51*angle53*
                      pointpair12*pointpair34*point5;
fourcycles = linkquad*linkpair*quadpyr*pointquad*point5;
transpthreecyc = linktriple*link45*pyrpair*pointtriple*pointpair45;
cyclics = linkquint^2*pointquint;

pu5series = (1/120)(identity + 10*transpos + 20*threecycles + 
          15*transposprs + 30*fourcycles + 20*transpthreecyc + 24*cyclics);
pu5temp = (Expand[Normal[pu5series] * x1^2 x2^2 x3^2 x4^2 x5^2] //.  
                              orderRules) /(x1^2 x2^2 x3^2 x4^2 x5^2);
pu5 = Collect[pu5temp, Prepend[Table[c[qmax-i], {i,0,qmax}], t]]

pu5point = pu5 //. c[n_] -> 1
pu5line = pu5 //. {x1->1, x2->1, x3->1, x4->1, x5->1}
pu5total = pu5line //. c[n_] -> 1

Save["pu5.out", pu5, pu5point, pu5line, pu5total]
Quit[]