ResetDirectory[];
SetDirectory["/home/carrington/RULES"]

rule collection

enter vertex names

qvec={u,v,k,nk,v1,v2,k1,k2,nk1,nk2,p,p1,p2,BB0k1,BB0k2,EE0k1,EE0k2};

namee2={del,Df,Gk1,Gk2,Df2,Df3,Df4,Df5,Df6,D0,delDf,Din,Gc,Gin,Gct,Gct1,Gct2,Gct3,Gct3,Dtp,Dss,D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,Dfin,DFIN,Dtp2,Dtp3,PP1,PP2};
namee3={U,U0,U1,U2,U3,eps};
namee4={Vc,Vr,Vrr,V,V0,V00,Vct,LAM,LAM4,VcT1,VcT2,VcT3,VcT4,Vct1,Vct2,Vct3,Vct4,Vct11,Vct22,Vct33,Vct44,Vct111,Vct222,Vct333,Vct444,M4,M4tilde,VCT1,VCT2,VCT3,VCT4,GdR2};
namee5={V5,V50};
namee6={V6,V60,V6c,V6r,LAM6,LAM6a,V6a,M6,M6tilde,M6rot,V6rot,GdR4,VdR2,VadR2};
namee8={V8,V8c,V8r,V8a,LAM8,LAM8a,M8,M8tilde,VdR4,LAM8tilde};
contractUV={};
Do[AppendTo[contractUV,namee3[[ii]][X_,X_,X_]->namee3[[ii]][X]],{ii,1,Length[namee3]}];
Do[AppendTo[contractUV,namee4[[ii]][X_,X_,X_,X_]->namee4[[ii]][X]],{ii,1,Length[namee4]}];
Do[AppendTo[contractUV,namee5[[ii]][X_,X_,X_,X_,X_]->namee5[[ii]][X]],{ii,1,Length[namee5]}];
Do[AppendTo[contractUV,namee6[[ii]][X_,X_,X_,X_,X_,X_]->namee6[[ii]][X]],{ii,1,Length[namee6]}];
Do[AppendTo[contractUV,namee8[[ii]][X_,X_,X_,X_,X_,X_,X_,X_]->namee8[[ii]][X]],{ii,1,Length[namee8]}];
headUV={};
Do[AppendTo[headUV,namee3[[ii]][X_,X_,X_]->namee3[[ii]]],{ii,1,Length[namee3]}];
Do[AppendTo[headUV,namee4[[ii]][X_,X_,X_,X_]->namee4[[ii]]],{ii,1,Length[namee4]}];
Do[AppendTo[headUV,namee5[[ii]][X_,X_,X_,X_,X_]->namee5[[ii]]],{ii,1,Length[namee5]}];
Do[AppendTo[headUV,namee6[[ii]][X_,X_,X_,X_,X_,X_]->namee6[[ii]]],{ii,1,Length[namee6]}];

nameOne=Flatten[{qvec,namee3,namee4,namee5,namee6,namee8}];
nameTwo=namee2;
nameTwoPartner1={delX,DfX,Gk1X,Gk2X,Df2X,Df3X,Df4X,Df5X,Df6X,D0X,delDfX,DinX,GcX,GinX,GctX,Gct1X,Gct2X,Gct3X,Gct3X,DtpX,DssX,D1X,D2X,D3X,D4X,D5X,D6X,D7X,D8X,D9X,D10X,D11X,D12X,D13X,D14X,D15X,DfinX,DFINX,Dtp2X,Dtp3X};
nameTwoPartner2={delY,DfY,Gk1Y,Gk2Y,Df2Y,Df3Y,Df4Y,Df5Y,Df6Y,D0Y,delDfY,DinY,GcY,GinY,GctY,Gct1Y,Gct2Y,Gct3Y,Gct3Y,DtpY,DssY,D1Y,D2Y,D3Y,D4Y,D5Y,D6Y,D7Y,D8Y,D9Y,D10Y,D11Y,D12Y,D13Y,D14Y,D15Y,DfinY,DFINY,Dtp2Y,Dtp3Y};
nameTwoPartner3={delZ,DfZ,Gk1Z,Gk2Z,Df2Z,Df3Z,Df4Z,Df5Z,Df6Z,D0Z,delDfZ,DinZ,GcZ,GinZ,GctZ,Gct1Z,Gct2Z,Gct3Z,Gct3Z,DtpZ,DssZ,D1Z,D2Z,D3Z,D4Z,D5Z,D6Z,D7Z,D8Z,D9Z,D10Z,D11Z,D12Z,D13Z,D14Z,D15Z,DfinZ,DFINZ,Dtp2Z,Dtp3Z};
nameTwoPartner4={delW,DfW,Gk1W,Gk2W,Df2W,Df3W,Df4W,Df5W,Df6W,D0W,delDfW,DinW,GcW,GinW,GctW,Gct1W,Gct2W,Gct3W,Gct3W,DtpW,DssW,D1W,D2W,D3W,D4W,D5W,D6W,D7W,D8W,D9W,D10W,D11W,D12W,D13W,D14W,D15W,DfinW,DFINW,Dtp2W,Dtp3W};
nameThree=namee3;
nameFour=namee4;
nameFive=namee5;
nameSix=namee6;
nameEight=namee8;
remove1={};remove2={};remove3={};remove4={};remove5={};remove6={};remove8={};
Do[AppendTo[remove1,nameOne[[ii]][X_]->1],{ii,1,Length[nameOne]}];
Do[AppendTo[remove2,nameTwo[[ii]][X_,Y_]->1],{ii,1,Length[nameTwo]}];
Do[AppendTo[remove3,nameThree[[ii]][X_,Y_,Z_]->1],{ii,1,Length[nameThree]}];
Do[AppendTo[remove4,nameFour[[ii]][X_,Y_,Z_,Z2_]->1],{ii,1,Length[nameFour]}];
Do[AppendTo[remove5,nameFive[[ii]][X_,Y_,Z_,Z2_,Z3_]->1],{ii,1,Length[nameFive]}];
Do[AppendTo[remove6,nameSix[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_]->1],{ii,1,Length[nameSix]}];
Do[AppendTo[remove8,nameEight[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->1],{ii,1,Length[nameEight]}];
removeAll=Flatten[{remove1,remove2,remove3,remove4,remove5,remove6,remove8}];
drop1={};drop2={};drop3={};drop4={};drop5={};drop6={};drop8={};
Do[AppendTo[drop1,nameOne[[ii]][X_]->0],{ii,1,Length[nameOne]}];
Do[AppendTo[drop2,nameTwo[[ii]][X_,Y_]->0],{ii,1,Length[nameTwo]}];
Do[AppendTo[drop3,nameThree[[ii]][X_,Y_,Z_]->0],{ii,1,Length[nameThree]}];
Do[AppendTo[drop4,nameFour[[ii]][X_,Y_,Z_,Z2_]->0],{ii,1,Length[nameFour]}];
Do[AppendTo[drop5,nameFive[[ii]][X_,Y_,Z_,Z2_,Z3_]->0],{ii,1,Length[nameFive]}];
Do[AppendTo[drop6,nameSix[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_]->0],{ii,1,Length[nameSix]}];
Do[AppendTo[drop8,nameEight[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->0],{ii,1,Length[nameEight]}];
dropAll=Flatten[{drop1,drop2,drop3,drop4,drop5,drop6,drop8}];
generic1={};generic2={};generic3={};generic4={};generic5={};generic6={};generic8={};
Do[AppendTo[generic1,nameOne[[ii]][X_]->nameOne[[ii]][xx]],{ii,1,Length[nameOne]}];
Do[AppendTo[generic2,nameTwo[[ii]][X_,Y_]->nameTwo[[ii]][xx,xx]],{ii,1,Length[nameTwo]}];
Do[AppendTo[generic3,nameThree[[ii]][X_,Y_,Z_]->nameThree[[ii]][xx,xx,xx]],{ii,1,Length[nameThree]}];
Do[AppendTo[generic4,nameFour[[ii]][X_,Y_,Z_,Z2_]->nameFour[[ii]][xx,xx,xx,xx]],{ii,1,Length[nameFour]}];
Do[AppendTo[generic5,nameFive[[ii]][X_,Y_,Z_,Z2_,Z3_]->nameFive[[ii]][xx,xx,xx,xx,xx]],{ii,1,Length[nameFive]}];
Do[AppendTo[generic6,nameSix[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_]->nameSix[[ii]][xx,xx,xx,xx,xx,xx]],{ii,1,Length[nameSix]}];
Do[AppendTo[generic8,nameEight[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->nameEight[[ii]][xx,xx,xx,xx,xx,xx,xx,xx]],{ii,1,Length[nameEight]}];
genericAll=Flatten[{generic1,generic2,generic3,generic4,generic5,generic6,generic8}];
removeVertices=Flatten[{remove1,remove3,remove4,remove5,remove6,remove8}];
removeExtVars={a->1,b->1,c->1,d->1,e->1,f->1,g->1,h->1,i->1,j->1,k->1,l->1,m->1,n->1,o->1,p->1};

nameAll=Flatten[{nameTwo,nameThree,nameFour,nameFive,nameSix,nameEight}]

additional rules

du[1]=zum1;du[2]=zum2;du[3]=zum3;du[4]=zum4;du[5]=zum5;du[6]=zum6;du[7]=zum7;du[8]=zum8;du[9]=zum9;du[10]=zum10;du[11]=zum11;du[12]=zum12;du[13]=zum13;du[14]=zum14;du[15]=zum15;du[16]=zum16;du[17]=zum17;du[18]=zum18;du[19]=zum19;du[20]=zum20;du[21]=zum21;du[22]=zum22;du[23]=zum23;du[24]=zum24;du[25]=zum25;du[26]=zum26;du[27]=zum27;du[28]=zum28;du[29]=zum29;du[30]=zum30;du[31]=zum31;du[32]=zum32;du[33]=zum33;du[34]=zum34;du[35]=zum35;du[36]=zum36;du[37]=zum37;du[38]=zum38;du[39]=zum39;du[40]=zum40;du[41]=zum41;du[42]=zum42;du[43]=zum43;du[44]=zum44;du[45]=zum45;du[46]=zum46;du[47]=zum47;du[48]=zum48;du[49]=zum49;du[50]=zum50;du[51]=zum51;du[52]=zum52;du[53]=zum53;du[54]=zum54;du[55]=zum55;du[56]=zum56;du[57]=zum57;du[58]=zum58;du[59]=zum59;du[60]=zum60;du[61]=zum61;du[62]=zum62;du[63]=zum63;du[64]=zum64;du[65]=zum65;du[66]=zum66;du[67]=zum67;du[68]=zum68;du[69]=zum69;du[94]=zum94;du[95]=zum95;du[96]=zum96;du[97]=zum97;du[98]=zum98;du[99]=zum99;

(* dum1=zum1;dum2=zum2;dum3=zum3;dum4=zum4;dum5=zum5;dum6=zum6;dum7=zum7;dum8=zum8;dum9=zum9;dum10=zum10;dum11=zum11;dum12=zum12;dum13=zum13;dum14=zum14;dum15=zum15;dum16=zum16;dum17=zum17;dum18=zum18;dum19=zum19;dum20=zum20;dum21=zum21;dum22=zum22;dum23=zum23;dum24=zum24;dum25=zum25;dum26=zum26;dum27=zum27;dum28=zum28;dum29=zum29;dum96=zum96;dum97=zum97;dum98=zum98;dum99=zum99; *)

fum1=zum1;fum2=zum2;fum3=zum3;fum4=zum4;fum5=zum5;fum6=zum6;fum7=zum7;fum8=zum8;fum9=zum9;fum10=zum10;fum11=zum11;fum12=zum12;fum13=zum13;fum14=zum14;fum15=zum15;fum16=zum16;fum17=zum17;fum18=zum18;fum19=zum19;fum20=zum20;fum21=zum21;fum22=zum22;fum23=zum23;fum24=zum24;fum25=zum25;fum26=zum26;fum27=zum27;fum28=zum28;fum29=zum29;fum96=zum96;fum97=zum97;fum98=zum98;fum99=zum99;

delwork={del[x_,y_]Y___ X_[w___,y_,z___]-> X[w,x,z] Y,del[y_,x_]Y___ X_[w___,y_,z___]-> X[w,x,z] Y} ;

extVAR={a,b,c,d,e,f,g,h,i,j,k,l,m};
shiftExt={a->zum94,b->zum95,c->zum96,d->zum97,e->zum98,f->zum99};
(* bigVAR={zum99,zum98,zum97,zum96,zum95,zum94}; *)

dumVEC={};
Do[AppendTo[dumVEC,du[ii]],{ii,1,69}];
allVARs=Flatten[{extVAR,dumVEC,bigVAR}];

xVec={x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40};

yVec={y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12,y13,y14,y15,y16,y17,y18,y19,y20,y21,y22,y23,y24,y25,y26,y27,y28,y29,y30,y31,y32,y33,y34,y35,y36,y37,y38,y39,y40};

uVec={u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15,u16,u17,u18,u19,u20,u21,u22,u23,u24,u25,u26,u27,u28,u29,u30,u31,u32,u33,u34,u35,u36,u37,u38,u39,u40};

vVec={v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19,v20,v21,v22,v23,v24,v25,v26,v27,v28,v29,v30,v31,v32,v33,v34,v35,v36,v37,v38,v39,v40};

wVec={w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14,w15,w16,w17,w18,w19,w20,w21,w22,w23,w24,w25,w26,w27,w28,w29,w30,w31,w32,w33,w34,w35,w36,w37,w38,w39,w40};

zVec={z1,z2,z3,z4,z5,z6,z7,z8,z9,z10,z11,z12,z13,z14,z15,z16,z17,z18,z19,z20,z21,z22,z23,z24,z25,z26,z27,z28,z29,z30,z31,z32,z33,z34,z35,z36,z37,z38,z39,z40};

Do[Df[allVARs[[ii]]^2]=Df[allVARs[[ii]],allVARs[[ii]]],{ii,1,Length[allVARs]}];

perms2=Permutations[{a,b}];
PERMS2={};
Do[AppendTo[PERMS2,{perms2[[ii,1]]->perms2[[1,1]],perms2[[ii,2]]->perms2[[1,2]]}],{ii,1,Length[perms2]}];
perms3=Permutations[{a,b,c}];
PERMS3={};
Do[AppendTo[PERMS3,{perms3[[ii,1]]->perms3[[1,1]],perms3[[ii,2]]->perms3[[1,2]],perms3[[ii,3]]->perms3[[1,3]]}],{ii,1,Length[perms3]}];
perms4=Permutations[{a,b,c,d}];
PERMS4={};
Do[AppendTo[PERMS4,{perms4[[ii,1]]->perms4[[1,1]],perms4[[ii,2]]->perms4[[1,2]],perms4[[ii,3]]->perms4[[1,3]],perms4[[ii,4]]->perms4[[1,4]]}],{ii,1,Length[perms4]}];
perms5=Permutations[{a,b,c,d,e}];
PERMS5={};
Do[AppendTo[PERMS5,{perms5[[ii,1]]->perms5[[1,1]],perms5[[ii,2]]->perms5[[1,2]],perms5[[ii,3]]->perms5[[1,3]],perms5[[ii,4]]->perms5[[1,4]],perms5[[ii,5]]->perms5[[1,5]]}],{ii,1,Length[perms5]}];
perms6=Permutations[{a,b,c,d,e,f}];
PERMS6={};
Do[AppendTo[PERMS6,{perms6[[ii,1]]->perms6[[1,1]],perms6[[ii,2]]->perms6[[1,2]],perms6[[ii,3]]->perms6[[1,3]],perms6[[ii,4]]->perms6[[1,4]],perms6[[ii,5]]->perms6[[1,5]],perms6[[ii,6]]->perms6[[1,6]]}],{ii,1,Length[perms6]}];

truncate={};
Do[AppendTo[truncate,Df[extVAR[[ii]],X_]->del[extVAR[[ii]],X]],{ii,1,Length[extVAR]}];
Do[AppendTo[truncate,Df[X_,extVAR[[ii]]]->del[X,extVAR[[ii]]]],{ii,1,Length[extVAR]}];

dropLegsx={};
Do[AppendTo[dropLegsx,{Din[X_,extVAR[[ii]]]Df[X_,Y_]->del[extVAR[[ii]],Y],Din[X_,extVAR[[ii]]]Df[Y_,X_]->del[extVAR[[ii]],Y]}],{ii,1,Length[extVAR]}];
dropLegs=Flatten[dropLegsx];

removeMark={Amark[x_]->1,Bmark[x_]->1,Cmark[x_]->1,Dmark[x_]->1,Umark[x_]->1,Vmark[x_]->1,Pmark[x_]->1,Wmark[x_]->1,UBmark[x_]->1,VBmark[x_]->1,WBmark[x_]->1,A1mark[x_]->1,B1mark[x_]->1,C1mark[x_]->1,D1mark[x_]->1,U1mark[x_]->1,V1mark[x_]->1,P1mark[x_]->1,W1mark[x_]->1,UB1mark[x_]->1,VB1mark[x_]->1,WB1mark[x_]->1,A2mark[x_]->1,B2mark[x_]->1,C2mark[x_]->1,D2mark[x_]->1,U2mark[x_]->1,V2mark[x_]->1,P2mark[x_]->1,W2mark[x_]->1,UB2mark[x_]->1,VB2mark[x_]->1,WB2mark[x_]->1,A3mark[x_]->1,B3mark[x_]->1,C3mark[x_]->1,D3mark[x_]->1,U3mark[x_]->1,V3mark[x_]->1,P3mark[x_]->1,W3mark[x_]->1,UB3mark[x_]->1,VB3mark[x_]->1,WB3mark[x_]->1};

Amarker[fcn_]:=Complement[Variables[fcn],Variables[fcn]//.removeMark];

varLook[fcn_]:=Union[Variables[fcn]//.removeMark//.genericAll];

switch[X_,Y_]={X->Y,Y->X};

simper[fcn_]:=Sum[Simplify[fcn[[ii]]],{ii,1,Length[fcn]}];

find[fcn_,marke_]:=fcn-(fcn//.Amark[marke]->0);

shift2z={};shift2w={};shift2v={};shift2u={};shift2x={};shift2y={};z2dum={};w2dum={};
Do[AppendTo[shift2z,dumVEC[[ii]]->zVec[[ii]]],{ii,1,Length[zVec]}];
Do[AppendTo[shift2w,dumVEC[[ii]]->wVec[[ii]]],{ii,1,Length[wVec]}];
Do[AppendTo[shift2v,dumVEC[[ii]]->vVec[[ii]]],{ii,1,Length[vVec]}];
Do[AppendTo[shift2u,dumVEC[[ii]]->uVec[[ii]]],{ii,1,Length[uVec]}];
Do[AppendTo[shift2x,dumVEC[[ii]]->xVec[[ii]]],{ii,1,Length[xVec]}];
Do[AppendTo[shift2y,dumVEC[[ii]]->yVec[[ii]]],{ii,1,Length[yVec]}];
Do[AppendTo[z2dum,zVec[[ii]]->dumVEC[[ii]]],{ii,1,Length[zVec]}];
Do[AppendTo[w2dum,wVec[[ii]]->dumVEC[[ii]]],{ii,1,Length[wVec]}];

Do[triple[dumVEC[[ii]]]={dumVEC[[ii]],dumVEC[[ii]]/.shift2z,dumVEC[[ii]]/.shift2w},{ii,1,Length[dumVEC]}];
Do[quad[dumVEC[[ii]]]={dumVEC[[ii]],dumVEC[[ii]]/.shift2z,dumVEC[[ii]]/.shift2w,dumVEC[[ii]]/.shift2v},{ii,1,Length[dumVEC]}];
Do[quint[dumVEC[[ii]]]={dumVEC[[ii]],dumVEC[[ii]]/.shift2z,dumVEC[[ii]]/.shift2w,dumVEC[[ii]]/.shift2v,dumVEC[[ii]]/.shift2u},{ii,1,Length[dumVEC]}];
Do[sext[dumVEC[[ii]]]={dumVEC[[ii]],dumVEC[[ii]]/.shift2z,dumVEC[[ii]]/.shift2w,dumVEC[[ii]]/.shift2v,dumVEC[[ii]]/.shift2u,dumVEC[[ii]]/.shift2y},{ii,1,Length[dumVEC]}];

unOrderDf={Df[X_,Y_]->Df[X Y],Df2[X_,Y_]->Df2[X Y],Df3[X_,Y_]->Df3[X Y],Df4[X_,Y_]->Df4[X Y],Df5[X_,Y_]->Df5[X Y],Df6[X_,Y_]->Df6[X Y]};
reOrderDf={Df[a_* b_]->Df[a,b],Df2[a_* b_]->Df2[a,b],Df3[a_* b_]->Df3[a,b],Df4[a_* b_]->Df4[a,b],Df5[a_* b_]->Df5[a,b],Df6[a_* b_]->Df6[a,b],Df[a_^2]->Df[a,a],Df2[a_^2]->Df2[a,a],Df3[a_^2]->Df3[a,a],Df4[a_^2]->Df4[a,a],Df5[a_^2]->Df5[a,a],Df6[a_^2]->Df6[a,a]};

truncate={};
Do[AppendTo[truncate,Df[extVAR[[ii]],X_]->del[extVAR[[ii]],X]],{ii,1,Length[extVAR]}];
Do[AppendTo[truncate,Df[X_,extVAR[[ii]]]->del[X,extVAR[[ii]]]],{ii,1,Length[extVAR]}];

functionMaker={};
Do[AppendTo[functionMaker,nameOne[[ii]][xx]->nameOne[[ii]][Xf]],{ii,1,Length[nameOne]}];
Do[AppendTo[functionMaker,nameTwo[[ii]][xx,xx]->nameTwo[[ii]][Xf,Yf]],{ii,1,Length[nameTwo]}];

unOrder={};
Do[AppendTo[unOrder,nameTwo[[ii]][X_,Y_]->nameTwo[[ii]][X*Y]],{ii,1,Length[nameTwo]}];
Do[AppendTo[unOrder,nameThree[[ii]][X_,Y_,Z_]->nameThree[[ii]][X*Y*Z]],{ii,1,Length[nameThree]}];
Do[AppendTo[unOrder,nameFour[[ii]][X_,Y_,Z_,Z2_]->nameFour[[ii]][X*Y*Z*Z2]],{ii,1,Length[nameFour]}];
Do[AppendTo[unOrder,nameFive[[ii]][X_,Y_,Z_,Z2_,Z3_]->nameFive[[ii]][X*Y*Z*Z2*Z3]],{ii,1,Length[nameFive]}];
Do[AppendTo[unOrder,nameSix[[ii]][X_,Y_,Z_,Z2_,Z3_,Z4_]->nameSix[[ii]][X*Y*Z*Z2*Z3*Z4]],{ii,1,Length[nameSix]}];
reOrder={};
Do[AppendTo[reOrder,nameTwo[[ii]][X_*Y_]->nameTwo[[ii]][X,Y]],{ii,1,Length[nameTwo]}];
Do[AppendTo[reOrder,nameTwo[[ii]][X_^2]->nameTwo[[ii]][X,X]],{ii,1,Length[nameTwo]}];
Do[AppendTo[reOrder,nameThree[[ii]][X_*Y_*Z_]->nameThree[[ii]][X,Y,Z]],{ii,1,Length[nameThree]}];
Do[AppendTo[reOrder,nameThree[[ii]][X_^2*Z_]->nameThree[[ii]][X,X,Z]],{ii,1,Length[nameThree]}];
Do[AppendTo[reOrder,nameThree[[ii]][X_^3]->nameThree[[ii]][X,X,X]],{ii,1,Length[nameThree]}];
Do[AppendTo[reOrder,nameFour[[ii]][X_*Y_*Z_*Z2_]->nameFour[[ii]][X,Y,Z,Z2]],{ii,1,Length[nameFour]}];
Do[AppendTo[reOrder,nameFour[[ii]][X_*Y_*Z_^2]->nameFour[[ii]][X,Y,Z,Z]],{ii,1,Length[nameFour]}];
Do[AppendTo[reOrder,nameFour[[ii]][X_*Y_^3]->nameFour[[ii]][X,Y,Y,Y]],{ii,1,Length[nameFour]}];
Do[AppendTo[reOrder,nameFour[[ii]][X_^4]->nameFour[[ii]][X,X,X,X]],{ii,1,Length[nameFour]}];
Do[AppendTo[reOrder,nameFive[[ii]][X_*Y_*Z_*Z2_*Z3_]->nameFive[[ii]][X,Y,Z,Z2,Z3]],{ii,1,Length[nameFive]}];
Do[AppendTo[reOrder,nameSix[[ii]][X_*Y_*Z_*Z2_*Z3_*Z4_]->nameSix[[ii]][X,Y,Z,Z2,Z3,Z4]],{ii,1,Length[nameSix]}];

Dfvec={Df[X_,Y_],Df[X_,Y_]Df[X2_,Y2_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_]Df[X4_,Y4_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_]Df[X4_,Y4_]Df[X5_,Y5_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_]Df[X4_,Y4_]Df[X5_,Y5_]Df[X6_,Y6_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_]Df[X4_,Y4_]Df[X5_,Y5_]Df[X6_,Y6_]Df[X7_,Y7_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_]Df[X4_,Y4_]Df[X5_,Y5_]Df[X6_,Y6_]Df[X7_,Y7_]Df[X8_,Y8_],Df[X_,Y_]Df[X2_,Y2_]Df[X3_,Y3_]Df[X4_,Y4_]Df[X5_,Y5_]Df[X6_,Y6_]Df[X7_,Y7_]Df[X8_,Y8_]Df[X9_,Y9_]};
Dfsqvec={Df[aX_,aY_]^2,Df[aX_,aY_]^2Df[aX2_,aY2_]^2,Df[aX_,aY_]^2Df[aX2_,aY2_]^2Df[aX3_,aY3_]^2,Df[aX_,aY_]^2Df[aX2_,aY2_]^2Df[aX3_,aY3_]^2Df[aX4_,aY4_]^2};
delvec={Df[hX_,hY_],Df[hX_,hY_]Df[hX2_,hY2_]};

spreader1={Df[x_,y_]^2->Df[x,y]Df2[x,y],Df[x_,y_]^3->Df[x,y]Df2[x,y]Df3[x,y],Df[x_,y_]^4->Df[x,y]Df2[x,y]Df3[x,y]Df4[x,y],Df[x_,y_]^5->Df[x,y]Df2[x,y]Df3[x,y]Df4[x,y]Df5[x,y],Df[x_,y_]^6->Df[x,y]Df2[x,y]Df3[x,y]Df4[x,y]Df5[x,y]Df6[x,y]};
spreader2=spreader1/.{Df->Gc,Df2->Gc2,Df3->Gc3,Df4->Gc4,Df5->Gc5,Df6->Gc6};
spreader3=spreader1/.{Df->D0,Df2->D02,Df3->D03,Df4->D04,Df5->D05,Df6->D06};
spreader=Flatten[{spreader1,spreader2,spreader3}];

Length[nameTwo]

Length[nameTwoPartner1]

powerspreader={};
Do[AppendTo[powerspreader,nameTwo[[ii]][x_,y_]^2->nameTwo[[ii]][x,y]nameTwoPartner1[[ii]][x,y]],{ii,1,Length[nameTwo]}];
Do[AppendTo[powerspreader,nameTwo[[ii]][x_,y_]^3->nameTwo[[ii]][x,y]nameTwoPartner1[[ii]][x,y]nameTwoPartner2[[ii]][x,y]],{ii,1,Length[nameTwo]}];
Do[AppendTo[powerspreader,nameTwo[[ii]][x_,y_]^4->nameTwo[[ii]][x,y]nameTwoPartner1[[ii]][x,y]nameTwoPartner2[[ii]][x,y]nameTwoPartner3[[ii]][x,y]],{ii,1,Length[nameTwo]}];
Do[AppendTo[powerspreader,nameTwo[[ii]][x_,y_]^5->nameTwo[[ii]][x,y]nameTwoPartner1[[ii]][x,y]nameTwoPartner2[[ii]][x,y]nameTwoPartner3[[ii]][x,y]nameTwoPartner4[[ii]][x,y]],{ii,1,Length[nameTwo]}];

removeSpread={Df2[x_,y_]->Df[x,y],Df3[x_,y_]->Df[x,y],Df4[x_,y_]->Df[x,y],Df5[x_,y_]->Df[x,y],Df6[x_,y_]->Df[x,y]};
spread2one={Df[x_,y_]->1,Df2[x_,y_]->1,Df3[x_,y_]->1,Df4[x_,y_]->1,Df5[x_,y_]->1,Df6[x_,y_]->1};

noIndex={Df[xx,xx]->Df,U0[xx,xx,xx]->U0,U[xx,xx,xx]->U,V[xx,xx,xx,xx]->V,V0[xx,xx,xx,xx]->V0,V5[xx,xx,xx,xx,xx]->V5,U[xx]->U,V[xx]->V,V5[xx]->V5};
restoreIndex={};
Do[AppendTo[restoreIndex,noIndex[[ii,2]]->noIndex[[ii,1]]],{ii,1,Length[noIndex]}];

threeIndex={i,j,l,m,r,s,t,d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,d11,d12,d13,d14,d15,d16,zum1,zum2,zum3,zum4,zum5,zum6,zum7,zum8};
allIndex=Sort[Flatten[{extVAR,threeIndex}]];

order the del' s

Do[Do[If[ii>jj,del[allIndex[[ii]],allIndex[[jj]]]=del[allIndex[[jj]],allIndex[[ii]]]],{ii,1,Length[allIndex]}],{jj,1,Length[allIndex]}];

rule to set : del[a, a] = 1, del[i, i] = 3, del[i,j]del[j,i]->3  and also to protect the external del's

delRule={};
Do[AppendTo[delRule,del[extVAR[[ii]],extVAR[[ii]]]->1],{ii,1,Length[extVAR]}];
Do[AppendTo[delRule,del[threeIndex[[ii]],threeIndex[[ii]]]->3],{ii,1,Length[threeIndex]}];
Do[Do[If[ii≠jj,AppendTo[delRule,del[threeIndex[[ii]],threeIndex[[jj]]]del[threeIndex[[ii]],threeIndex[[jj]]]->3]],{ii,1,Length[threeIndex]}],{jj,1,Length[threeIndex]}];
Do[Do[If[ii≠jj,AppendTo[delRule,del[extVAR[[ii]],extVAR[[jj]]]->dell[extVAR[[ii]],extVAR[[jj]]]]],{ii,1,Length[extVAR]}],{jj,1,Length[extVAR]}];

unProtect the external del's

extDel={};
Do[Do[If[ii≠jj,AppendTo[extDel,dell[extVAR[[ii]],extVAR[[jj]]]->del[extVAR[[ii]],extVAR[[jj]]]]],{ii,1,Length[extVAR]}],{jj,1,Length[extVAR]}];

the three vectors

Do[dot[qvec[[ii]],qvec[[ii]]]=qvec[[ii]]^2,{ii,1,Length[qvec]}];

Do[Do[If[ii>jj,dot[qvec[[ii]],qvec[[jj]]]=dot[qvec[[jj]],qvec[[ii]]]],{ii,1,Length[qvec]}],{jj,1,Length[qvec]}];

getDot3={};
Do[Do[AppendTo[getDot3,qvec[[ii]][x_]qvec[[jj]][x_]->dot[qvec[[ii]],qvec[[jj]]]],{ii,1,Length[qvec]}],{jj,1,Length[qvec]}];

legger={Vc[X_,Y_,Z_,Z2_]->Gc[X,z1]Gc[Y,z2]Gc[Z,z3]Gc[Z2,z4]Vr[z1,z2,z3,z4],VDc[X_,Y_,Z_,Z2_]->Gc[X,z1]Gc[Y,z2]Gc[Z,z3]Gc[Z2,z4]VDr[z1,z2,z3,z4],V6c[X_,Y_,Z_,Z2_,Z3_,Z4_]->Gc[X,z1]Gc[Y,z2]Gc[Z,z3]Gc[Z2,z4]Gc[Z3,z5]Gc[Z4,z6]V6r[z1,z2,z3,z4,z5,z6],V8c[X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->Gc[X,z1]Gc[Y,z2]Gc[Z,z3]Gc[Z2,z4]Gc[Z3,z5]Gc[Z4,z6]Gc[Z5,z7]Gc[Z6,z8]V8r[z1,z2,z3,z4,z5,z6,z7,z8],LAM8[X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->Gc[X,z1]Gc[Y,z2]Gc[Z,z3]Gc[Z2,z4]Gc[Z3,z5]Gc[Z4,z6]Gc[Z5,z7]Gc[Z6,z8]LAM8a[z1,z2,z3,z4,z5,z6,z7,z8]};
legger2={Vc[X_,Y_,Z_,Z2_]->Gc[X,z1] Gc[Y,z2] Gc[Z,z3] Gc[Z2,z4] V[z1,z2,z3,z4],V6c[X_,Y_,Z_,Z2_,Z3_,Z4_]->Gc[X,z1] Gc[Y,z2] Gc[Z,z3] Gc[Z2,z4] Gc[Z3,z5] Gc[Z4,z6] V6a[z1,z2,z3,z4,z5,z6],V8c[X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->Gc[X,z1] Gc[Y,z2] Gc[Z,z3] Gc[Z2,z4] Gc[Z3,z5] Gc[Z4,z6] Gc[Z5,z7] Gc[Z6,z8] V8a[z1,z2,z3,z4,z5,z6,z7,z8]};

lkx=<<V8PROPERstore;
V8PROPER=V8a[X_,Y_,Z_,Z2_,Z3_,Z4_,Z5_,Z6_]->(lkx[[2]]//.{Vr[XX__]->V[XX],V6r[XX__]->V6[XX],V8r[XX__]->V8[XX]});

V6PROPER=<<V6PROPERstore;
V6PROPER=V6a[X_,Y_,Z_,Z2_,Z3_,Z4_]->V6r[X,Y,Z,Z2,Z3,Z4]+Gc[z7,z8] Vr[X,Z3,Z4,z7] Vr[Y,Z,Z2,z8]+Gc[z7,z8] Vr[X,Z2,Z4,z7] Vr[Y,Z,Z3,z8]+Gc[z7,z8] Vr[X,Z2,Z3,z8] Vr[Y,Z,Z4,z7]+Gc[z7,z8] Vr[X,Z,Z4,z7] Vr[Y,Z2,Z3,z8]+Gc[z7,z8] Vr[X,Z,Z3,z8] Vr[Y,Z2,Z4,z7]+Gc[z7,z8] Vr[X,Z,Z2,z8] Vr[Y,Z3,Z4,z7]+Gc[z7,z8] Vr[X,Y,Z4,z7] Vr[Z,Z2,Z3,z8]+Gc[z7,z8] Vr[X,Y,Z3,z8] Vr[Z,Z2,Z4,z7]+Gc[z7,z8] Vr[X,Y,Z2,z8] Vr[Z,Z3,Z4,z7]+Gc[z7,z8] Vr[X,Y,Z,z8] Vr[Z2,Z3,Z4,z7]//.{Vr[XX__]->V[XX],V6r[XX__]->V6[XX]};

modules

tallyFunction and tallyCheck

varlookFunction[x0_]:=Module[{lkx,lky,varlist},
lkx=Union[Variables[x0]//.removeMark];
varlist={};
Do[AppendTo[varlist,Level[lkx[[ii]],1]],{ii,1,Length[lkx]}];
varList=Union[Flatten[varlist]]];

tallyFunction[x0_]:=Module[{lkx,lky},
Clear[lkx,lky,varlist];
x00=Expand[hold+x0];
tallyList={};
Do[
lkx=Variables[Simplify[x00[[ii]]/(x00[[ii]]//.removeAll)]];
varlist[ii]={};
Do[AppendTo[varlist[ii],Level[lkx[[jj]],1]],{jj,1,Length[lkx]}];
tallied[ii]=Sort[Tally[Flatten[varlist[ii]]]];
AppendTo[tallyList,tallied[ii]],{ii,1,Length[x00]}];
tally=Union[Flatten[tallyList,1]]];

tallyCheck[x0_]:=Module[{x00,test,hopxx},
x00=Expand[hold+x0]//.spreader;
If[Length[x00]>1000,
Print["500 terms only"];
int:=RandomInteger[{1,Length[x00]}];
test=0;
Do[test=test+x00[[int]],{ii,1,500}],test=x00];
hopxx=tallyFunction[test];
dumVars={};extVars={};
Do[
If[hopxx[[ii,2]]==2,AppendTo[dumVars,hopxx[[ii,1]]]];
If[hopxx[[ii,2]]==1,AppendTo[extVars,hopxx[[ii,1]]]];
If[hopxx[[ii,2]]>2,Print[{hopxx[[ii,1]], "appears",  hopxx[[ii,2]],"times"}];Break[]];
,{ii,1,Length[hopxx]}];
Print[{"external variables are",extVars}];
Print[{"dummy variables are",dumVars}];
If[Intersection[dumVars,extVars]=={},,Print["disaster"],Print["disaster"]];]

delFunction[x0]  and delFunctionExt

delFunction[x0_]:=Module[{},x0//.{del[x_,y_] Y___ X_[w___,y_,z___]->X[w,x,z] Y,del[y_,x_] Y___ X_[w___,y_,z___]->X[w,x,z] Y}]

this one uses the external delta function but keeps them : del[a, b] Gc[b, c] is replaced by del[a, b] Gc[a, c]

delExternal[x0_]:=Module[{x0in,tempx,extdel,vars},
x0out=0;
x0in=Expand[x0+hold];
Do[
tempx=orderFunction[Complement[Variables[x0in[[ii]]],Variables[x0in[[ii]]]//.del[XX__]->1]];
extdel={};
Do[vars=Level[tempx[[jj]],1];
If[Intersection[extVAR,vars]==vars,AppendTo[extdel,vars[[2]]->vars[[1]]]],{jj,1,Length[tempx]}];
x0out=x0out+(x0in[[ii]]/(x0in[[ii]]//.del[X_,Y_]->1))*(x0in[[ii]]//.del[X_,Y_]->1/.extdel)//.hold->0
,{ii,1,Length[x0in]}];
x0out//.hold->0]

i think:
for this module an external variable is any variable that appears once - for this case it doesn’t have to be in extVARs
must have all “external” variables alphabetically before dummies or gives the wrong answer
run tallyCheck to test if this condition is met. 

this one works only if all externals once and alphabetically before dums
the check in tallyCheck is not good enough for two reasons (1) passes if externals are alphabetically before dums; (2) doesn’t check individual terms

delFunctionW[x0_]:=Module[{tempx,tempy,x0in,start,done,workedx,delcoe,gone},
workedx=0;
gone={};
x0in=Expand[x0+hold];
Do[
start=x0in[[ii]];
Do[
tempx=Complement[orderFunction[Complement[Variables[start],Variables[start]//.del[XX__]->1]]//.gone,{1}];
If[tempx=={},Break[],tempy=tempx[[1,2]]->tempx[[1,1]]];
If[Intersection[extVAR,{tempx[[1,1]],tempx[[1,2]]}]=={tempx[[1,1]],tempx[[1,2]]},delcoe=del[tempx[[1,1]],tempx[[1,2]]];AppendTo[gone,delcoe->1],delcoe=1];
done=delcoe(start//.tempy//.del[X_,X_]->1);
start=done;
,{cc,1,100}];
workedx=workedx+orderFunction[start];
,{ii,1,Length[x0in]}];
worked=workedx//.hold->0
]

this one orders the del' s but not anything else

delFunctionNO[x0_]:=Module[{tempx,tempy,x0in,start,done,workedx,delcoe,gone},
workedx=0;
gone={};
x0in=Expand[x0+hold];
Do[
start=x0in[[ii]];
Do[
tempx=Complement[orderFunction[Complement[Variables[start],Variables[start]//.del[XX__]->1]]//.gone,{1}];
If[tempx=={},Break[],tempy=tempx[[1,2]]->tempx[[1,1]]];
If[Intersection[extVAR,{tempx[[1,1]],tempx[[1,2]]}]=={tempx[[1,1]],tempx[[1,2]]},delcoe=del[tempx[[1,1]],tempx[[1,2]]];AppendTo[gone,delcoe->1],delcoe=1];
done=delcoe(start//.tempy//.del[X_,X_]->1);
start=done;
,{cc,1,100}];
workedx=workedx+start;
,{ii,1,Length[x0in]}];
worked=workedx//.hold->0
]

this one doesn' t order deltas - for things like delta[-k1, k2] where the arguments are momenta and not indices

deltaFunction[x0_]:=Module[{tempx,tempy,x0in,start,done,workedx,delcoe,gone},
workedx=0;
gone={};
x0in=Expand[x0+hold];
Do[
start=x0in[[ii]];
Do[
tempx=Complement[Complement[Variables[start],Variables[start]//.delta[XX__]->1]//.gone,{1}];
If[tempx=={},Break[],tempy=tempx[[1,2]]->tempx[[1,1]]];
If[Intersection[extVAR,{tempx[[1,1]],tempx[[1,2]]}]=={tempx[[1,1]],tempx[[1,2]]},delcoe=delta[tempx[[1,1]],tempx[[1,2]]];AppendTo[gone,delcoe->1],delcoe=1];
done=delcoe(start//.tempy//.delta[X_,X_]->1);
start=done;
,{cc,1,100}];
workedx=workedx+start;
If[ii/500∈Integers,Print[N[ii/Length[x0in],3]]];
,{ii,1,Length[x0in]}];
worked=workedx//.hold->0
]

orderFunction[x0]

orderFunction[x0_]:=Module[{sortedVars,replaceRules,sort,toSort},sortedVars={};

replaceRules={};
sort[x___]:=If[Head[x]===Symbol,x,Sort[x]];
holder=x0+hold;
toSort=Variables[holder];

Do[AppendTo[sortedVars,sort[toSort[[ii]]]],{ii,1,Length[toSort]}];
Do[AppendTo[replaceRules,toSort[[ii]]->sortedVars[[ii]]],{ii,1,Length[toSort]}];

order3=holder//.replaceRules//.hold->0];

i don' t remember what these do - something for the BS calculation which doesn' t order all vertices

orderFunction2[x0_]:=Module[{vars2,vars4,sort2,sort4,temp,direction,tempNew,tempDum,tempExt},
If[Head[x0]==Times,Print["single term - this order function doesn't work"]];
vars2=Complement[Variables[x0],Variables[x0]//.remove2];
vars4=Complement[Variables[x0],Variables[x0]//.remove4];
sort2={};sort4={};
Do[AppendTo[sort2,vars2[[mm]]->orderFunction[vars2[[mm]]]],{mm,1,Length[vars2]}];
Do[
temp=Level[vars4[[hh]],1];
If[MemberQ[extVAR,temp[[1]]],direction=ext,direction=dum];
tempExt={};tempDum={};
Do[If[MemberQ[extVAR,temp[[ii]]],AppendTo[tempExt,temp[[ii]]],AppendTo[tempDum,temp[[ii]]]],{ii,1,Length[temp]}];
If[direction==dum,tempNew=Flatten[{Sort[tempDum],Sort[tempExt]}]];
If[direction==ext,tempNew=Flatten[{Sort[tempExt],Sort[tempDum]}]];
AppendTo[sort4,vars4[[hh]]->Head[vars4[[hh]]][tempNew[[1]],tempNew[[2]],tempNew[[3]],tempNew[[4]]]],{hh,1,Length[vars4]}];
ordered=x0/.sort2/.sort4]

orderFunction2[x0_]:=Module[{x00,vars2,vars4,sort2,sort4,temp,direction,tempNew,tempDum,tempExt},
x00=Expand[hold+x0];
vars2=Complement[Variables[x00],Variables[x00]//.remove2];
vars4=Complement[Variables[x00],Variables[x00]//.remove4];
sort2={};sort4={};
Do[AppendTo[sort2,vars2[[mm]]->orderFunction[vars2[[mm]]]],{mm,1,Length[vars2]}];
Do[temp=Level[vars4[[hh]],1];
tempNew=Flatten[{Sort[{temp[[1]],temp[[2]]}],Sort[{temp[[3]],temp[[4]]}]}];
AppendTo[sort4,vars4[[hh]]->Head[vars4[[hh]]][tempNew[[1]],tempNew[[2]],tempNew[[3]],tempNew[[4]]]];
,{hh,1,Length[vars4]}];
ordered=x00/.sort2/.sort4//.hold->0]

shifterM

shifterM[x0_]:=Module[{x00,allvars,term,sorter},
x00=Expand[x0+hold];
sorted=0;
Do[
allvars=Level[Variables[x00[[ii]]/(x00[[ii]]//.removeAll)],{2}];
inner=Complement[allvars,extVAR];
outer=Intersection[allvars,extVAR];
sorter={};
Do[AppendTo[sorter,inner[[jj]]->dumVEC[[jj]]],{jj,1,Length[inner]}];
sorted=sorted+orderFunction[(x00[[ii]]/.sorter)];
(* this is the testing stuff *)
(*Do[
cond2=(Tally[allvars][[ss,2]]==2)==True;
cond1=Intersection[extVAR,{Tally[allvars][[ss,1]]}]=={};
cond4=(Tally[allvars][[ss,2]]==1)==True;
cond3=MemberQ[extVAR,Tally[allvars][[ss,1]]]==True;
If[({cond1,cond2}=={True,False})&&count==0,Print[{"bad internal variable",Tally[allvars][[ss,1]]}];count=count+1];
If[({cond3,cond4}=={True,False})&&count==0,Print[{"bad external variable",Tally[allvars][[ss,1]]}];count=count+1];
,{ss,1,Length[Tally[allvars]]}];*)
If[ii/3000∈Integers,Print[ii]];
,{ii,1,Length[x00]}];
sorted//.hold->0
];

shifterNO[x0_]:=Module[{x00,allvars,term,sorter},
x00=Expand[x0+hold];
sorted=0;
Do[
allvars=Level[Variables[x00[[ii]]/(x00[[ii]]//.removeAll)],{2}];
inner=Complement[allvars,extVAR];
outer=Intersection[allvars,extVAR];
sorter={};
Do[AppendTo[sorter,inner[[jj]]->dumVEC[[jj]]],{jj,1,Length[inner]}];
sorted=sorted+(x00[[ii]]/.sorter);
(* this is the testing stuff *)
(*Do[
cond2=(Tally[allvars][[ss,2]]==2)==True;
cond1=Intersection[extVAR,{Tally[allvars][[ss,1]]}]=={};
cond4=(Tally[allvars][[ss,2]]==1)==True;
cond3=MemberQ[extVAR,Tally[allvars][[ss,1]]]==True;
If[({cond1,cond2}=={True,False})&&count==0,Print[{"bad internal variable",Tally[allvars][[ss,1]]}];count=count+1];
If[({cond3,cond4}=={True,False})&&count==0,Print[{"bad external variable",Tally[allvars][[ss,1]]}];count=count+1];
,{ss,1,Length[Tally[allvars]]}];*)
If[ii/3000∈Integers,Print[ii]];
,{ii,1,Length[x00]}];
sorted//.hold->0
];

loopOrderFunction[x0_]

multiply by hold because Count won' t work right for terms like V0[a, b, c, d] with no product of factors - not sure if this is needed?
yes hold is needed for terms with Head Times
new method: if x0 has only one term (Head is not Plus) then put this term in brackets

Clear[loopOrderFunction];
loopOrderFunction[x0pp_]:=Module[{input,noI,noV3,noV4,noV5,noV6,exG1,exG2,exG3,exV1,exV2,exV3,exV4,x0p,x0},
x0p=Expand[x0pp];
If[Head[x0p]==Plus,x0=x0p,x0=x0p,x0={x0p}];
loopOrder=Expand[hold*x0/.{Vct[X_,Y_,Z_,Z2_]->Vct1[X,Y,Z,Z2]+Vct2[X,Y,Z,Z2]+Vct3[X,Y,Z,Z2]+Vct4[X,Y,Z,Z2]}];
loopm=0;loop0=0;loop1=0;loop2=0;loop3=0;loop4=0;loop5=0;loop6=0;loop7=0;loop8=0;loop9=0;loop10=0;loop11=0;
loopLook={};
Clear[ii];
Do[
input=loopOrder[[ii]]//.powerspreader/.del[X_,Y_]->del[X,Y,hold];
noI[ii]=0;noV3[ii]=0;noV4[ii]=0;noV5[ii]=0;noV6[ii]=0;exG1[ii]=0;exG2[ii]=0;exG3[ii]=0;exV1[ii]=0;exV2[ii]=0;exV3[ii]=0;
noI[ii]=noI[ii]+Count[(Variables[input]//.{Gin[XX__]->1,del[XX__]->1}),X_[x_,y_]];
Do[noV3[ii]=noV3[ii]+Count[input,nameThree[[jj]][x__]],{jj,1,Length[nameThree]}];
Do[noV4[ii]=noV4[ii]+Count[input,nameFour[[jj]][x__]],{jj,1,Length[nameFour]}];
Do[noV5[ii]=noV5[ii]+Count[input,nameFive[[jj]][x__]],{jj,1,Length[nameFive]}];
Do[noV6[ii]=noV6[ii]+Count[input,nameSix[[jj]][x__]],{jj,1,Length[nameSix]}];
exV1[ii]=Count[input,Vct1[X_]]+Count[input,Vct1[X_,Y_,Z_,Z2_]]+Count[input,Vct11[X_]]+Count[input,Vct11[X_,Y_,Z_,Z2_]]+Count[input,VcT1[X_]]+Count[input,VcT1[X_,Y_,Z_,Z2_]]+Count[input,Vc111[X_]]+Count[input,Vc111[X_,Y_,Z_,Z2_]];
exV2[ii]=Count[input,Vct2[X_]]+Count[input,Vct2[X_,Y_,Z_,Z2_]]+Count[input,Vct22[X_]]+Count[input,Vct22[X_,Y_,Z_,Z2_]]+Count[input,VcT2[X_]]+Count[input,VcT2[X_,Y_,Z_,Z2_]]+Count[input,Vc222[X_]]+Count[input,Vc222[X_,Y_,Z_,Z2_]];
exV3[ii]=Count[input,Vct3[X_]]+Count[input,Vct3[X_,Y_,Z_,Z2_]]+Count[input,Vct33[X_]]+Count[input,Vct33[X_,Y_,Z_,Z2_]]+Count[input,VcT3[X_]]+Count[input,VcT3[X_,Y_,Z_,Z2_]]+Count[input,Vc333[X_]]+Count[input,Vc333[X_,Y_,Z_,Z2_]];
exV4[ii]=Count[input,Vct4[X_]]+Count[input,Vct4[X_,Y_,Z_,Z2_]]+Count[input,Vct44[X_]]+Count[input,Vct44[X_,Y_,Z_,Z2_]]+Count[input,VcT4[X_]]+Count[input,VcT4[X_,Y_,Z_,Z2_]]+Count[input,Vc444[X_]]+Count[input,Vc444[X_,Y_,Z_,Z2_]];
noL[ii]=noI[ii]-noV3[ii]-noV4[ii]-noV5[ii]-noV6[ii]+1+exV1[ii]+2exV2[ii]+3exV3[ii]+4exV4[ii];
If[noL[ii]==0,loop0=loop0+loopOrder[[ii]]//.hold->1];
If[noL[ii]==1,loop1=loop1+loopOrder[[ii]]//.hold->1];
If[noL[ii]==2,loop2=loop2+loopOrder[[ii]]//.hold->1];
If[noL[ii]==3,loop3=loop3+loopOrder[[ii]]//.hold->1];
If[noL[ii]==4,loop4=loop4+loopOrder[[ii]]//.hold->1];
If[noL[ii]==5,loop5=loop5+loopOrder[[ii]]//.hold->1];
If[noL[ii]==6,loop6=loop6+loopOrder[[ii]]//.hold->1];
If[noL[ii]==7,loop7=loop7+loopOrder[[ii]]//.hold->1];
If[noL[ii]==8,loop8=loop8+loopOrder[[ii]]//.hold->1];
If[noL[ii]==9,loop9=loop9+loopOrder[[ii]]//.hold->1];
If[noL[ii]==10,loop10=loop10+loopOrder[[ii]]//.hold->1];
If[noL[ii]==11,loop11=loop11+loopOrder[[ii]]//.hold->1];
If[ii/10000∈Integers,Print[ii]];
AppendTo[loopLook,noL[ii]];
,{ii,1,Length[loopOrder]}];

union=Union[loopLook];
loopm=Expand[x0p-loop0-loop1-loop2-loop3-loop4-loop5-loop6-loop7-loop8-loop9-loop10-loop11//.hold->1];
loopChecker=0==loopm;
(*Print[{loopChecker,union}]*);
]

tracking and dumbing

internalDumb-tracker:   toTrack ->  TRACKED

tracking

original=Expand[toTrack];

toTrack=shifterM[toTrack];

temp=Variables[toTrack];
temp2={};
Do[AppendTo[temp2,Head[temp[[ii]]]],{ii,1,Length[temp]}];
temp3=Union[temp2];
varCheck=Intersection[nameAll,temp3]==temp3

Clear[checkunU0U1,checkunU0U2,checkDUMB,checkTRACK];

unU0U = Sum[am[ii]*toTrack[[ii]], {ii, 1, Length[toTrack]}];

(* old version had shifterM[unU0U] - is this needed ? *)
unU=hold+unU0U;

extSWITCH={};
Do[Do[AppendTo[extSWITCH,extVAR[[ii]]->extVAR[[jj]]],{ii,1,Length[extVAR]}];,{jj,1,Length[extVAR]}];

Clear[Ulist, Vlist, removeUx, removeU, removeVx, removeV, V5list, removeV5x, removeV5, V6list, removeV6x, removeV6, V8list, removeV8x, removeV8];

Clear[nn]
Do[
 Ulist[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //.remove3];
removeUx[nn]={};
Do[AppendTo[removeUx[nn], {Ulist[nn][[ii]][[3]] -> Ulist[nn][[ii]][[1]], Ulist[nn][[ii]][[2]] -> Ulist[nn][[ii]][[1]]}],{ii, 1, Length[Ulist[nn]]}];
removeU[nn] = Flatten[removeUx[nn]];
(* *)
Vlist[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //.remove4];
removeVx[nn] = {};
Do[AppendTo[removeVx[nn], {Vlist[nn][[ii]][[4]] -> Vlist[nn][[ii]][[1]], Vlist[nn][[ii]][[3]] -> Vlist[nn][[ii]][[1]],Vlist[nn][[ii]][[2]] -> Vlist[nn][[ii]][[1]]}], {ii, 1, Length[Vlist[nn]]}];
removeV[nn] = Flatten[removeVx[nn]];
(* *)
V5list[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //.remove5];
removeV5x[nn] = {};
Do[AppendTo[removeV5x[nn], {V5list[nn][[ii]][[5]] -> V5list[nn][[ii]][[1]], V5list[nn][[ii]][[4]] -> V5list[nn][[ii]][[1]], V5list[nn][[ii]][[3]] -> V5list[nn][[ii]][[1]], V5list[nn][[ii]][[2]] -> V5list[nn][[ii]][[1]]}], {ii, 1, Length[V5list[nn]]}];
  removeV5[nn] = Flatten[removeV5x[nn]]; 
(* *)
V6list[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //. remove6];
 removeV6x[nn] = {};
Do[AppendTo[removeV6x[nn], {V6list[nn][[ii]][[6]] -> V6list[nn][[ii]][[1]],V6list[nn][[ii]][[5]] -> V6list[nn][[ii]][[1]],V6list[nn][[ii]][[4]] -> V6list[nn][[ii]][[1]], V6list[nn][[ii]][[3]] -> V6list[nn][[ii]][[1]], V6list[nn][[ii]][[2]] -> V6list[nn][[ii]][[1]]}], {ii, 1, Length[V6list[nn]]}];
  removeV6[nn] = Flatten[removeV6x[nn]];
(* *)
V8list[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //. remove8];
 removeV8x[nn] = {};
Do[AppendTo[removeV8x[nn], {V8list[nn][[ii]][[8]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[7]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[6]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[5]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[4]] -> V8list[nn][[ii]][[1]], V8list[nn][[ii]][[3]] -> V8list[nn][[ii]][[1]], V8list[nn][[ii]][[2]] -> V8list[nn][[ii]][[1]]}], {ii, 1, Length[V8list[nn]]}];
  removeV8[nn] = Flatten[removeV8x[nn]];
(*  *)
delFac[nn]=1;
Do[If[MemberQ[removeU[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV5[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV6[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV8[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
If[nn/10000∈Integers,Print[nn]];
  , {nn, 1, Length[unU]}];

unUedTemp = Sum[delFac[nn]*(unU[[nn]] //. removeU[nn] //. removeV[nn]  //. removeV5[nn]//. removeV6[nn]//. removeV8[nn])//.contractUV,{nn, 1, Length[unU]}];

unUed=shifterM[unUedTemp];

checkUnU0U1=Complement[Variables[unUed],Variables[unUed]//.remove3//.remove4//.remove5//.remove6/.remove8]=={}

checkUnU0U2=0==unUed-unU0U//.genericAll//.contractUV//.del[xx,xx]->1;

Union[varLook[unUed]//.am[X_]->1]

dumb=unUed//.am[X_]->1;

dumVars=Intersection[dumVEC,varlookFunction[dumb]]
extVars=Intersection[extVAR,varlookFunction[dumb]]

If[Length[dumVars]<9,
permsD=Permutations[dumVars];
perms={};
Do[AppendTo[perms,Flatten[{permsD[[ii]]},1]],{ii,1,Length[permsD]}];
vartot=Length[perms[[1]]]];

{Length[dumb],Length[perms],vartot}

Clear[jj,kk,nn,mm,fac,save]
Do[fac[ii]=1,{ii,1,Length[dumb]}];
chVec={};nBreak={};
DateString[]
tstart=AbsoluteTime[];
save={dumb[[1]]};
Do[
(* kk is the loop over all permutations *)
Do[
doperm={};
Do[AppendTo[doperm,perms[[kk,mm]]->perms[[1,mm]]],{mm,1,vartot}];
newthing=orderFunction[dumb[[jj]]/.doperm];
(* nn is the loop over all terms in save *)
count=0;
Do[
If[save[[1+Length[save]-nn]]==0,Goto[next]];
If[(Head[save[[1+Length[save]-nn]]/newthing]==Integer)||(Head[save[[1+Length[save]-nn]]/newthing]==Rational),fac[1+Length[save]-nn]=fac[1+Length[save]-nn]+(newthing/save[[1+Length[save]-nn]]//.removeAll);count=count+1;AppendTo[nBreak,{jj,kk,nn,Length[save]}];Break[]];
Label[next];
,{nn,1,Length[save]}];
If[count==1,Break[]],{kk,2,Length[perms]}];
If[count==0,AppendTo[save,dumb[[jj]]]];
(*save=Complement[save,{0}];*)
If[jj/50∈Integers,Print[{N[jj/Length[dumb]],DateString[]}]];
,{jj,2,Length[dumb]}];
If[print==yes,Print[{"time in minutes",Round[100(AbsoluteTime[]-tstart)/6000.],DateString[]}]];
DUMB=Sum[am[fac[ii]]save[[ii]],{ii,1,Length[save]}]//.am[x_]->x;
Length[DUMB]

If[Length[dumVars]<2,DUMB=dumb];
If[Head[dumb]==Times,DUMB=dumb];

checkDUMB=dumb==DUMB//.am[x_]->x//.genericAll

DUMBam=hold+DUMB;
Length[DUMBam]

fac is saving the aam[x] factor
facTrack saves the factor from am[x] -> 1 before dumbing

Clear[fac,facTemp,ii,jj,look1,look2,save,SAVE];
tstart=AbsoluteTime[];
fac=1;
Do[
look1=DUMBam[[ii]]/(DUMBam[[ii]]//.removeAll);
(*facTemp=Complement[Variables[DUMBam[[ii]]],Variables[DUMBam[[ii]]]/.aam[x_]->1];
If[facTemp=={},fac=1,fac=facTemp[[1]]];*)
count=0;
Do[
look2=unUed[[jj]]/(unUed[[jj]]//.removeAll);
If[look1==look2,
got=Complement[Variables[unUed[[jj]]],Variables[unUed[[jj]]]/.am[x_]->1][[1]];
save=unU0U-(unU0U//.got->0)//.got->1;
facTrack=DUMBam[[ii]]/unUed[[jj]]//.removeAll//.{am[x_]->1,aam[x_]->1};
count=count+1];
SAVE[ii]=fac*facTrack*save;
If[count==1,Break[]];
,{jj,1,Length[unUed]}];
If[DUMBam[[ii]]==hold,SAVE[ii]=0];
If[ii/20∈Integers,Print[{ii,DateString[]}]];
,{ii,1,Length[DUMBam]}];
If[print==yes,Print[{"time in minutes",Round[100(AbsoluteTime[]-tstart)]/6000.,DateString[]}]];

TRACKED=Sum[SAVE[ii],{ii,1,Length[DUMBam]}];

Length[TRACKED]

checkTRACK=TRACKED==toTrack//.genericAll

checker

If[typeUtracking==many,AppendTo[checkVector,{varCheck,checkUnU0U1,checkUnU0U2,checkTRACK}];
Print[Union[Flatten[checkVector]]],Print[{varCheck,checkUnU0U1,checkUnU0U2,checkTRACK}],Print[{varCheck,checkUnU0U1,checkUnU0U2,checkTRACK}]]

{Length[original],Length[TRACKED+hold]-1}

unU0U -> unUed

unU-ing

unU=hold+shifterM[unU0U];

extSWITCH={};
Do[Do[AppendTo[extSWITCH,extVAR[[ii]]->extVAR[[jj]]],{ii,1,Length[extVAR]}];,{jj,1,Length[extVAR]}];

Clear[Ulist, Vlist, removeUx, removeU, removeVx, removeV, V5list, removeV5x, removeV5, V6list, removeV6x, removeV6, V8list, removeV8x, removeV8];

Clear[nn]
Do[
 Ulist[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //.remove3];
removeUx[nn]={};
Do[AppendTo[removeUx[nn], {Ulist[nn][[ii]][[3]] -> Ulist[nn][[ii]][[1]], Ulist[nn][[ii]][[2]] -> Ulist[nn][[ii]][[1]]}],{ii, 1, Length[Ulist[nn]]}];
removeU[nn] = Flatten[removeUx[nn]];
(* *)
Vlist[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //.remove4];
removeVx[nn] = {};
Do[AppendTo[removeVx[nn], {Vlist[nn][[ii]][[4]] -> Vlist[nn][[ii]][[1]], Vlist[nn][[ii]][[3]] -> Vlist[nn][[ii]][[1]],Vlist[nn][[ii]][[2]] -> Vlist[nn][[ii]][[1]]}], {ii, 1, Length[Vlist[nn]]}];
removeV[nn] = Flatten[removeVx[nn]];
(* *)
V5list[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //.remove5];
removeV5x[nn] = {};
Do[AppendTo[removeV5x[nn], {V5list[nn][[ii]][[5]] -> V5list[nn][[ii]][[1]], V5list[nn][[ii]][[4]] -> V5list[nn][[ii]][[1]], V5list[nn][[ii]][[3]] -> V5list[nn][[ii]][[1]], V5list[nn][[ii]][[2]] -> V5list[nn][[ii]][[1]]}], {ii, 1, Length[V5list[nn]]}];
  removeV5[nn] = Flatten[removeV5x[nn]]; 
(* *)
(*Print[hereX];*)
V6list[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //. remove6];
 removeV6x[nn] = {};
Do[AppendTo[removeV6x[nn], {V6list[nn][[ii]][[6]] -> V6list[nn][[ii]][[1]],V6list[nn][[ii]][[5]] -> V6list[nn][[ii]][[1]],V6list[nn][[ii]][[4]] -> V6list[nn][[ii]][[1]], V6list[nn][[ii]][[3]] -> V6list[nn][[ii]][[1]], V6list[nn][[ii]][[2]] -> V6list[nn][[ii]][[1]]}], {ii, 1, Length[V6list[nn]]}];
  removeV6[nn] = Flatten[removeV6x[nn]];
(*  *)
V8list[nn] = Complement[Variables[unU[[nn]]], Variables[unU[[nn]]] //. remove8];
  removeV8x[nn] = {};
(*Print[here];*)
Do[AppendTo[removeV8x[nn], {V8list[nn][[ii]][[8]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[7]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[6]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[5]] -> V8list[nn][[ii]][[1]],V8list[nn][[ii]][[4]] -> V8list[nn][[ii]][[1]], V8list[nn][[ii]][[3]] -> V8list[nn][[ii]][[1]], V8list[nn][[ii]][[2]] -> V8list[nn][[ii]][[1]]}], {ii, 1, Length[V8list[nn]]}];
  removeV8[nn] = Flatten[removeV8x[nn]];
(* *)
delFac[nn]=1;
Do[If[MemberQ[removeU[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV5[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV6[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
Do[If[MemberQ[removeV8[nn],extSWITCH[[ii]]],delFac[nn]=delFac[nn]*del[extSWITCH[[ii,1]],extSWITCH[[ii,2]]]],{ii,1,Length[extSWITCH]}];
If[nn/500000∈Integers,Print[nn]];
  , {nn, 1, Length[unU]}];

unUedTemp = Sum[delFac[nn]*(unU[[nn]] //. removeU[nn] //. removeV[nn]  //. removeV5[nn]//. removeV6[nn]//.removeV8[nn])//.contractUV,{nn, 1, Length[unU]}];

unUed=orderFunction[shifterM[unUedTemp]];

Length[unU]

Clear[unUednew];
Do[
start=Complement[Variables[unU[[jj]]],Variables[unU[[jj]]]//.remove4];
hop1=start//.removeV[jj]//.contractUV;
hop2=start//.Reverse[removeV[jj]]//.contractUV;
removeVhelp={};
Do[If[Length[Level[hop1[[ii]],1]]==1,AppendTo[removeVhelp,start[[ii]]->hop1[[ii]]]];
If[Length[Level[hop2[[ii]],1]]==1,AppendTo[removeVhelp,start[[ii]]->hop2[[ii]]]],{ii,1,Length[start]}];
unUednew[jj]=delFac[jj](unU[[jj]]//.removeVhelp/.removeV[jj]),{jj,1,Length[unU]}];
unUednewAll=orderFunction[shifterM[Sum[unUednew[jj],{jj,1,Length[unU]}]//.hold->0]];

checker

check1=Complement[Variables[unUed],Variables[unUed]//.remove3//.remove4//.remove5//.remove6/.remove8]=={}

check2=Complement[Variables[unUednewAll],Variables[unUednewAll]//.remove3//.remove4//.remove5//.remove6/.remove8]=={}

If[check1&&check2,Print[unUed==unUednewAll]];

0==unUed-unU0U//.genericAll//.contractUV//.del[xx,xx]->1//.removeMark

dumber -  external with am[i] factors  - must do internal dumbing first  - normally unU0U first

external dumbing

original=dumb;

Length[original]

dumb=delExternal[shifterM[dumb]];

dumVars=Intersection[dumVEC,varlookFunction[dumb]]
extVars=Intersection[extVAR,varlookFunction[dumb]]

If[Length[dumVars]<8,permsD=Permutations[dumVars],permsD={{}}];

If[(symtype==abXcdXefgh)||(symtype==abXcdXef)||(symtype==abXefXgh)||(symtype==abcXefg)||(symtype==abXefgh)||(symtype==abXcd)||(symtype==abXcdef)||(symtype==abcdXef)||(symtype==abcdXefgh)||(symtype==none),,,
permsE=Permutations[extVars];
perms={};
Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE[[jj]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE]}];
vartot=Length[perms[[1]]]];

If[symtype==none,
perms=permsD;
vartot=Length[perms[[1]]]];

If[symtype==abXcd,
permsE1=Permutations[{a,b}];
permsE2=Permutations[{c,d}];
perms={};
Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}];
vartot=Length[perms[[1]]]];

If[symtype==abXcdef,
permsE1=Permutations[{a,b}];
permsE2=Permutations[{c,d,e,f}];
perms={};
Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}];
vartot=Length[perms[[1]]]];

If[symtype==abXefXgh,
permsE1=Permutations[{a,b}];
permsE2=Permutations[{e,f}];
permsE3=Permutations[{g,h}];
perms={};
Do[Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]],permsE3[[hh]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}],{hh,1,Length[permsE3]}];
vartot=Length[perms[[1]]]];

If[symtype==abXcdXefgh,
permsE1=Permutations[{a,b}];
permsE2=Permutations[{c,d}];
permsE3=Permutations[{e,f,g,h}];
perms={};
Do[Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]],permsE3[[hh]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}],{hh,1,Length[permsE3]}];
vartot=Length[perms[[1]]]];

If[symtype==abXcdXef,
permsE1=Permutations[{a,b}];
permsE2=Permutations[{c,d}];
permsE3=Permutations[{e,f}];
perms={};
Do[Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]],permsE3[[hh]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}],{hh,1,Length[permsE3]}];
vartot=Length[perms[[1]]]];

If[symtype==abXefgh,
permsE1=Permutations[{a,b}];
permsE2=Permutations[{e,f,g,h}];
perms={};
Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}];
vartot=Length[perms[[1]]]];

If[symtype==abcXefg,
permsE1=Permutations[{a,b,c}];
permsE2=Permutations[{e,f,g}];
perms={};
Do[Do[Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]]},1]],{ii,1,Length[permsD]}],{jj,1,Length[permsE1]}],{kk,1,Length[permsE2]}];
vartot=Length[perms[[1]]]];

If[symtype==abcdXef,
permsE1=Permutations[{a,b,c,d}];
permsE2=Permutations[{e,f}];
perms={};
Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]]},1]],{ii,1,Length[permsD]},{jj,1,Length[permsE1]},{kk,1,Length[permsE2]}];
vartot=Length[perms[[1]]]];

If[symtype == abcdXef,
  count = 0;
  permsE1 = Permutations[{a, b, c, d}];
  permsE2 = Permutations[{e, f}];
  permsE2 = {{}};
  perms = {};
  Do[count = count + 1;
   If[count/1000 ∈ Integers, Print[N[count/(Length[permsD]*Length[permsE1]*Length[permsE2]), 3]]];
   AppendTo[perms, Flatten[{permsD[[ii]], permsE1[[jj]], permsE2[[kk]]}, 1]], {ii, 1, Length[permsD]}, {jj, 1, Length[permsE1]}, {kk, 1, Length[permsE2]}];
  vartot = Length[perms[[1]]]];

tstart=AbsoluteTime[];
If[symtype==abcdXefgh,
permsE1=Permutations[{a,b,c,d}];
permsE2=Permutations[{e,f,g,h}];
perms={};
Do[AppendTo[perms,Flatten[{permsD[[ii]],permsE1[[jj]],permsE2[[kk]]},1]];
If[Length[perms]/10000∈Integers,Print[N[Length[perms]/(6!*4!*4!),3]]],{ii,1,Length[permsD]},{jj,1,Length[permsE1]},{kk,1,Length[permsE2]}];
vartot=Length[perms[[1]]];
Print[{"total time is",N[(AbsoluteTime[]-tstart)/60,3]}]];

{Length[perms],vartot,Length[dumb]}

Clear[jj,kk,nn,mm,save,fac]
Do[fac[ii]=1,{ii,1,Length[dumb]}];
chVec={};nBreak={};
DateString[]
tstart=AbsoluteTime[];
save={dumb[[1]]};
Do[
(* kk is the loop over all permutations *)
Do[
doperm={};
Do[AppendTo[doperm,perms[[kk,mm]]->perms[[1,mm]]],{mm,1,vartot}];
newthing=orderFunction[dumb[[jj]]/.doperm];
(* nn is the loop over all terms in save *)
count=0;
Do[
If[save[[1+Length[save]-nn]]==0,Goto[next]];
If[(Head[save[[1+Length[save]-nn]]/newthing]==Integer)||(Head[save[[1+Length[save]-nn]]/newthing]==Rational),fac[1+Length[save]-nn]=fac[1+Length[save]-nn]+(newthing/save[[1+Length[save]-nn]]//.removeAll);count=count+1;AppendTo[nBreak,{jj,kk,nn,Length[save]}];Break[]];
Label[next];
,{nn,1,Length[save]}];
If[count==1,Break[]],{kk,1,Length[perms]}];
If[count==0,AppendTo[save,dumb[[jj]]]];
(*save=Complement[save,{0}];*)
If[jj/20∈Integers,Print[{N[jj/Length[dumb]],DateString[]}]];
,{jj,2,Length[dumb]}];
Print[{"time in minutes",Round[100(AbsoluteTime[]-tstart)/6000.]}];
DUMB=Sum[am[fac[ii]]save[[ii]],{ii,1,Length[save]}]//.am[1]->1;
Length[DUMB]

Clear[symtype]

checker

check1=dumb==DUMB//.am[x_]->x//.genericAll;
check2=Sum[dumb[[ii]],{ii,1,Length[dumb]}]==DUMB//.am[x_]->x//.genericAll//.holdL[X_]->0;
check1||check2

{Length[original],Length[DUMB+hold]-1}