(1) Lyndon algorithm (direct product, Lyndon symmetry action convention)

【conventions:】
1 ->B->G->A->1
group element: g_i = (a_i, b_i)
any n-cocycle f[{g_1,g_2,...,g_n}] = f[{{a1,b1},{a2,b2},...,{an,bn}}]

(n-1)-cochain p

n=3;(* n-cocycle *)

AofG[g_]:={g[[1]],0};
BofG[g_]:={0,g[[2]]};

action[g_,b_]:=b;(* Need to change *)
cross[ab_,apbp_](*ag,bh*):=Module[{g=ab[[1]],a=ab[[2]],h=apbp[[1]],b=apbp[[2]]},
{g+h,a+action[g,b](**omega[g,h]*)}
];
cross[{a,b},{ap,bp}];

(* If g_i=0 for some i, then f[g]=0 *)
Clear[f0]
f[vecg_]:=Module[{i},
For[i=1,i≤Length[vecg],i++,
If[ToString[vecg[[i]]//Total]=="0",Return[0]];
];
Return[f0[vecg]];
];
f[{{a[1],b[1]},{a[2],b[2]},{a[3],b[3]}}];
f[{{0,0},{a[2],b[2]},{a[3],b[3]}}];
f[{{a[1],b[1]},{a[2],b[2]},{0,0}}];

(* (n-1)-cochain p by Lyndon *)
p[h_,k_,vecg_(* n-1 *)]:=(* 0≤h<k<n *)f[Table[AofG[vecg[[i]]],{i,1,h}]~Join~Table[BofG[vecg[[i]]],{i,h+1,k}]~Join~{Sum[AofG[vecg[[i]]],{i,h+1,k}]}~Join~Table[vecg[[i]],{i,k+1,Length[vecg]}]];
dp[h_,k_,vecg1_(* n *)]:=(pp[h,k,vecg1[[2;;]]]+Sum[(-1)^i*pp[h,k,vecg1[[;;(i-1)]]~Join~{cross[vecg1[[i]],vecg1[[i+1]]]}~Join~vecg1[[(i+2);;]]],{i,1,Length[vecg1]-1}]+(-1)^(Length[vecg1])*pp[h,k,vecg1[[;;-2]]])/.pp->p;
p[0,1,Table[{a[i],b[i]},{i,1,n-1}]];
dp[0,1,Table[{a[i],b[i]},{i,1,n}]];

(* p for diff (h,k) *)
Print["【】p for diff (h,k):"]
For[hp=0,hp<n-1,hp++,
For[kp=hp+1,kp<n,kp++,
Print["---(h,k)=(",hp,",",kp,"):"];
Print[p[hp,kp,Table[{a[i],b[i]},{i,1,n-1}]]]
]
];
Print[]

(* Check dp is trivial for argument (h',k')<(h,k) *)
Print["【Check】dp is trivial for arguments argument (h',k')<(h,k):"];
hh=0;
kk=1;
For[hp=0,hp<n-1,hp++,
For[kp=hp+1,kp<n,kp++,
Print["---(h',k')=(",hp,",",kp,"):"];
vec=Table[{a[i],b[i]},{i,1,n}]/.Flatten[{Table[b[i]->0,{i,1,hp}],Table[a[i]->0,{i,hp+1,kp}],b[kp+1]->0}];
(*Print[vec];*)
Print[(-1)^kk*dp[hh,kk,vec]];
If[hp==hh&&kp==kk,Print[f[vec]," = f"];If[f[vec]==(-1)^kk*dp[hh,kk,vec],Print[Style["f == (-1)^kdp  (True)",Red]],Print["f≠(-1)^kdp"]]]
]
];

n=3;
p[1,2,Table[{a[i],b[i]},{i,1,n-1}]]
dp[1,2,Table[{a[i],b[i]},{i,1,n}]]

Construct normal n-cocycle f using (n-1)-cochain p

Clear[newf];
newf=f[Table[{a[i],b[i]},{i,1,n}]];
newf=newf/.Flatten[{Table[a[i]->aa[i],{i,1,n}],Table[b[i]->bb[i],{i,1,n}]}];
For[h=0,h<n-1,h++,
For[k=h+1,k<n,k++,
(*Print["---(h,k)=(",h,",",k,"):\n","begin: newf = ",newf];*)
Clear[tempf];
tempf[vecg_]:=newf/.Flatten[{Table[aa[i]->vecg[[i,1]],{i,1,n}],Table[bb[i]->vecg[[i,2]],{i,1,n}]}];
newf=tempf[Table[{a[i],b[i]},{i,1,n}]]-(-1)^k*(dp[h,k,Table[{a[i],b[i]},{i,1,n}]]/.f0->tempf);
newf=newf/.f0->f;
newf=newf/.Flatten[{Table[a[i]->aa[i],{i,1,n}],Table[b[i]->bb[i],{i,1,n}]}];
(*Print["after: newf = ",newf];*)
]
];
newf=newf/.Flatten[{Table[aa[i]->a[i],{i,1,n}],Table[bb[i]->b[i],{i,1,n}]}];
Print["new f = ",newf]

(* check new f is normal *)
Print["【Check】newf is normal:"];
For[h=0,h<n-1,h++,
For[k=h+1,k<n,k++,
Print["---(h,k)=(",h,",",k,"):"];
temp=newf/.Flatten[{Table[b[i]->0,{i,1,h}],Table[a[i]->0,{i,h+1,k}],b[k+1]->0}];
temp=temp/.f0->f;
Print[temp];
]
];

(* decompose new f as f_{pq} *)
Print["【】decompose new f as f_{pq}:"];
For[h=0,h<n,h++,
Print["---(p,q)=(",h,",",n-h,"):"];
temp=newf/.Flatten[{Table[b[i]->0,{i,1,h}],Table[a[i]->0,{i,h+1,n}]}];
temp=temp/.f0->f;
Print[temp];
];

(2) Lyndon algorithm (semi-direct product with central extension, Hochschild-Serre symmetry action convention)

【conventions:】
1 ->A->\tilde{G}->G->1
group element: g_i = (a_i, g_i)
any n-cocycle  f[{{a1,g1},{a2,g2},...,{an,gn}}]
g = {g}
gh = {g, h}
ghk = {g, h, k}
(ghk)^-1 = Inverse[{g, h, k}] = {k^-1, h^-1, g^-1}
a_g = {a, {g}}
^g(a) = act[{g},a]

conventions & preparations

Clear[h,k,act,actOnF]

times[g_,h_]:=If[g=={},h,If[h=={},g,
If[NumberQ[g[[-1]]*h[[1]]]&&g[[-1]]*h[[1]]==1,times[g[[;;-2]],h[[2;;]]],
Flatten[{g,h}]]]]
times[{g},{}];
times[{},{h}];
times[{g},{h}];
times[{g},{1/g}];
times[{g,h},{1/h,k,l}];
times[{1/g,h},{1/h,g,k}];


times[g_,h_,k_]:=times[g,times[h,k]];
times[{},{h},{k}];
times[{g},{},{k}];
times[{g},{h},{}];
times[{g},{h},{k}];
times[{g1,g2},{h1,h2,h3},{k1,k2}];
times[{g,1/h},{h},{k}];

(* new function *)
timesNG[vecg_]:=If[Length[vecg]==0,{},If[Length[vecg]==2,times[vecg[[1]],vecg[[2]]],times[vecg[[1]],timesNG[vecg[[2;;]]]]]];
timesNG[{}];
timesNG[{{g1},{g2}}];
timesNG[{{g1},{g2},{g3}}];
timesNG[{{g1},{g2},{g3},{g4}}];
timesNG[{{g1},{g2},{g3},{g4},{g5}}];
timesNG[{{},{g2},{g3},{g4}}];
timesNG[{{g1},{},{g3},{g4}}];
timesNG[{{g1},{g2},{},{g4}}];
timesNG[{{g1},{g2},{g3},{}}];
timesNG[{{g1},{},{g3},{}}];

inverse[g_]:=Reverse[1/g]
inverse[{}];
inverse[{g}];
inverse[{g,h}];
inverse[{g,h,k}];

(* new: Flatten g and h *)
omega[g_,h_]:=If[g=={},1,If[h=={},1,w[g//Flatten,h//Flatten]]];
omega[{},{}];
omega[{g},{}];
omega[{},{g}];
omega[{g},{h}];

(* G action on A *)
action[g_,a_]:=
If[g=={},a,
If[NumberQ[a]&&a==1,1,
If[ToString[a[[0]]]=="Times",Product[action[g,a[[i]]],{i,1,Length[a]}],
If[ToString[a[[0]]]=="act",action[times[g,a[[1]]],a[[2]]],
If[ToString[a[[0]]]=="Rule",Rule[action[g,a[[1]]],action[g,a[[2]]]],
act[g,a]
]]]]];
action[{},a];
action[{g},1];
action[{g},b];
action[{g},a*b];
action[{g},action[{h},d]];
action[{g},c action[{h},d]];
action[{g},a->b];
action[{g^-1},a];
action[{1/g},action[{1/h},d]];
action[{g},action[{1/g},d]];

(* new *)
(* simplify g in action[g,a] *)
actionSimplifyG[g_,a_]:=action[g//Flatten,a];
actionSimplifyG[{},a];
actionSimplifyG[{{g1}},a];
actionSimplifyG[{g1,{},{{g2}}},a];
actionSimplifyG[{(1/({}))},a];
actionSimplifyG[{{},(1/g1),{},(1/({g2})),{},{}},a];

(* new *)
(* G action on {a,{}} *)
actionOnAG[g_,ag_(**)]:={action[g,ag[[1]]],{}}
actionOnAG[{g},{a,{}}];

cross[ag_,bh_]:=Module[{a=ag[[1]],b=bh[[1]],g=ag[[2]],h=bh[[2]]},
{a*action[g,b]*omega[g,h],times[g,h]}
];
cross[{a,{}},{b,{}}];
cross[{a,{g}},{b,{}}];
cross[{a,{}},{b,{h}}];
cross[{a,{g}},{b,{h}}];
cross[{a,{g,h}},{b,{k,l}}];

(* \tilde{G} action on coefficient *)
(* new: Flatten g in ag={a,{g}} *)
Clear[F];
actionOnF[ag_,F_]:=If[NumberQ[F]&&F==0,0,
If[NumberQ[F]&&F==1,1,
If[ToString[ag]==ToString[{1,{}}],F,
If[ToString[F[[0]]]=="Times",Product[actionOnF[ag,F[[i]]],{i,1,Length[F]}],
If[ToString[F[[0]]]=="Power",Power[actionOnF[ag,F[[1]]],F[[2]]],
If[ToString[F[[0]]]=="actOnF",actionOnF[cross[ag,F[[1]]],F[[2]]],
actOnF[(*ag*){ag[[1]],ag[[2]]//Flatten},F]
]]]]]];
actionOnF[{1,{}},F[c,d]];
actionOnF[{a,{}},F[c,d]];
actionOnF[{1,{g}},F[c,d]];
actionOnF[{a,{g}},1];
actionOnF[{a,{g}},0];
actionOnF[{a,{g}},(1/(F[a,b]))];
actionOnF[{a,{g}},F[c,d]];
actionOnF[{a,{g}},actionOnF[{b,{h}},F[c,d]]];

(* new *)
(* use condition actOnF[ag,0] = 0 to simplify *)
actOnFrep[ag_,F_]:=If[ToString[F]=="0",0,actOnF0[ag,F]];
actOnFrep[{a,{g}},0];
actOnFrep[{a,{g}},FF];

(n-1)-cochain p

n=4(* n-cocycle *)

AofAG[ag_]:={ag[[1]],{}};
GofAG[ag_]:={1,ag[[2]]};
AofAG[{a,{g}}];
GofAG[{a,{g}}];

(* If ag_i=0 for some i, then f[ag]=0 *)
Clear[f0]
f[vecg_]:=Module[{i},
For[i=1,i≤Length[vecg],i++,
If[ToString[vecg[[i]]]=="{1, {}}",Return[0]];
];
Return[f0[vecg]];
];
f[{{a[1],{g[1]}},{a[2],{g[2]}},{a[3],{g[3]}}}];
f[{{1,{}},{a[2],{g[2]}},{a[3],{g[3]}}}];
f[{{a[1],{g[1]}},{a[2],{g[2]}},{1,{}}}];

(* simplify/flatten g in f[ag] *)
fSimplifyG[vecag_]:=f[Table[{vecag[[i,1]],vecag[[i,2]]//Flatten},{i,1,Length[vecag]}]];
fSimplifyG[{{a1,{g1}},{a2,{g21,g22}},{a3,{g3}},{a4,{g4}}}];
fSimplifyG[{{a1,{{}}},{a2,{g21,{g22}}},{a3,{g3,{}}},{a4,{g4}}}];

(* (n-1)-cochain p *)
p[h_,k_,vecag_(* n-1 *)]:=f[Table[vecag[[i]],{i,1,h-1}]~Join~{{1,timesNG[Table[vecag[[i,2]],{i,h,k-1}]]}}~Join~(*Table[AofAG[vecag[[i]]],{i,h,k-1}]*)(*Table[actionOnAG[inverse[timesNG[Table[GofAG[vecag[[j]]][[2]],{j,i,k-1}]]],AofAG[vecag[[i]]]],{i,h,k-1}]*)Table[actionOnAG[inverse[timesNG[Table[GofAG[vecag[[j]]][[2]],{j,i,k-1}]]],AofAG[vecag[[i]]]*omega[GofAG[vecag[[i]]][[2]],timesNG[Table[GofAG[vecag[[j2]]][[2]],{j2,i+1,k-1}]]]],{i,h,k-1}]~Join~Table[GofAG[vecag[[i]]],{i,k,n-1}]];

(* Print p for diff (h,k) *)
(*Print["【】p for diff (h,k):"];
For[k1=n,k1≥2,k1--,
For[h1=k1-1,h1≥1,h1--,
Print["---(h,k)=(",h1,",",k1,"):"];
Print[p[h1,k1,Table[{a[i],{g[i]}},{i,1,n-1}]]];
]
];*)

(* dp *)
dp[h_,k_,vecag1_(* n *)]:=(actionOnF[vecag1[[1]],pp[h,k,vecag1[[2;;]]]]+Sum[(-1)^i*pp[h,k,vecag1[[;;(i-1)]]~Join~{cross[vecag1[[i]],vecag1[[i+1]]]}~Join~vecag1[[(i+2);;]]],{i,1,Length[vecag1]-1}]+(-1)^(Length[vecag1])*pp[h,k,vecag1[[;;-2]]])/.pp->p;
(*dp[1,2,{{1,{g[1]}},{a[2],{}},{1,{g[3]}}}]*)
(*dp[1,2,Table[{a[i],{g[i]}},{i,1,n}]]*)

(* Check dp is trivial for argument (h',k')>(h+1,k+1) *)
hh=1;kk=2;(* 1≤h<k≤n *)
Print["【Check】dp is trivial for arguments argument (h',k')>(h+1,k+1)=(",Style[hh+1,Red],Style[",",Red],Style[kk+1,Red],"):"];
For[kp=n+1,kp≥3,kp--,
For[hp=kp-1,hp≥2,hp--,
Print["\n---(h',k')=(",hp,",",kp,"):"];
vec=Table[{a[i],{g[i]}},{i,1,hp-2}]~Join~{{1,{g[hp-1]}}}~Join~Table[{a[i],{}},{i,hp,kp-1}]~Join~Table[{1,{g[i]}},{i,kp,n}];
(*Print["vec=",vec];*)
Print["±dp=",(-1)^(*kp*)hh*dp[hh,kk,vec]/.actOnF->actOnFrep];
If[hp==hh+1&&kp==kk+1,Print[Style[" f =",Red],Style[f[vec],Red]]]
]
];

Construct normal n-cocycle f using (n-1)-cochain p

(* n-coboundary *)
dx[vecag1_(* n *)]:=(actionOnF[vecag1[[1]],x[vecag1[[2;;]]]]+Sum[(-1)^i*x[vecag1[[;;(i-1)]]~Join~{cross[vecag1[[i]],vecag1[[i+1]]]}~Join~vecag1[[(i+2);;]]],{i,1,Length[vecag1]-1}]+(-1)^(Length[vecag1])*x[vecag1[[;;-2]]]);
xSimplifyG[vecag_]:=x[Table[{vecag[[i,1]],vecag[[i,2]]//Flatten},{i,1,Length[vecag]}]];
nboundaryX=dx[Table[{a[i],{g[i]}},{i,1,n}]];

(* construct new f from f *)
Clear[newf];
newf=f[Table[{a[i],{g[i]}},{i,1,n}]](*+nboundaryX*);
newf=newf/.Flatten[{Table[a[i]->aa[i],{i,1,n}],Table[g[i]->gg[i],{i,1,n}]}];
(*Print[Style["2≤h<k≤",Red],Style[n+1,Red],Style[" in f_n[s_{h,k}].",Red]];*)
For[k=n+1,k≥3,k--,
For[h=k-1,h≥2,h--,
(*Print["\n---(h,k)=(",h,",",k,"):\n","begin: newf = ",newf];*)

Clear[tempf];
(*tempf[vecg_](* {a[i],{g[i]}} *):=newf/.Flatten[{Table[aa[i]->vecg[[i,1]],{i,1,n}],Table[{gg[i]}->vecg[[i,2]],{i,1,n}]}];*)
tempf[vecg_](* {a[i],{g[i]}} *):=newf/.Table[aa[i]->vecg[[i,1]],{i,1,n}]/.Table[If[Length[vecg[[i,2]]]≤1,(1/(gg[i]))->(1/(vecg[[i,2]])),(1/(gg[i]))->Table[(1/(vecg[[i,2,-j]])),{j,1,Length[vecg[[i,2]]]}]],{i,1,n}]/.Table[gg[i]->vecg[[i,2]],{i,1,n}]/.f0->fSimplifyG/.act->actionSimplifyG/.w->omega/.actOnF->actionOnF;
(*Print["tempf = ",tempf[Table[{aa[i],{gg[i]}},{i,1,n}]],"\n",tempf[Table[{aa[i],{gg[i]}},{i,1,n}]]-newf];*)

(*Print["dp[h-1,k-1] = ",dp[h-1,k-1,Table[{a[i],{g[i]}},{i,1,n}]]];
Print["dp[h-1,k-1]/.f0->newf = ",dp[h-1,k-1,Table[{a[i],{g[i]}},{i,1,n}]]/.f0->tempf];*)

newf=tempf[Table[{a[i],{g[i]}},{i,1,n}]]-(-1)^(h+1)*(dp[h-1,k-1,Table[{a[i],{g[i]}},{i,1,n}]]/.f0->tempf);
newf=newf//.{f0->fSimplifyG,act->actionSimplifyG,w->omega,actOnF->actionOnF,x->xSimplifyG};
newf=newf/.Flatten[{Table[a[i]->aa[i],{i,1,n}],Table[g[i]->gg[i],{i,1,n}]}];
(*Print["after: newf = ",newf];*)
]]
newf=newf/.Flatten[{Table[aa[i]->a[i],{i,1,n}],Table[gg[i]->g[i],{i,1,n}]}];
If[Length[newf]<5,Print["newf = ",newf],Print["newf = ",newf[[1]]," + ... + ",newf[[-1]]]];

(* check new f is normal *)
Print["\n【Check】newf is normal:"];
Print[Style["2≤h<k≤",Red],Style[n+1,Red],Style[" in f_n[s_{h,k}].",Red]]
For[k=n+1,k≥3,k--,
For[h=k-1,h≥2,h--,
Print["---(h,k)=(",h,",",k,"):"];
(*temp=newf/.Flatten[{Table[b[i]->0,{i,1,h}],Table[a[i]->0,{i,h+1,k}],b[k+1]->0}];*)
temp=newf/.Flatten[{a[h-1]->1,Table[g[i]->{},{i,h,k-1}],Table[a[i]->1,{i,k,n}]}];
temp=temp//.{f0->fSimplifyG,act->actionSimplifyG,w->omega,actOnF->actionOnF,x->xSimplifyG};
Print[temp];
]
];

(* use arguments label (a_g,b_h,...) *)
Clear[h,k];
newfag=newf/.{a[1]->a,a[2]->b,a[3]->c,a[4]->d,a[5]->e,g[1]->g,g[2]->h,g[3]->k,g[4]->l,g[5]->m};
If[Length[newf]<5,Print["newf(ag,...) = ",newfag],Print["newf(ag,...) = ",newfag[[1]]," + ... + ",newfag[[-1]]]]

Extract f_ {pq} from the new f

(*Print["\n【】decompose new f as f_{pq}:"];*)
For[p1=0,p1≤n,p1++,
Print["\n---(p,q)=(",p1,",",n-p1,"):"];
(*Print[Table[{a[i],{g[i]}},{i,1,n}]/.Flatten[{Table[{g[i]}->{},{i,1,n-p1}],Table[a[i]->1,{i,n-p1+1,n}]}]];*)
temp=newf/.Flatten[{Table[g[i]->{},{i,1,n-p1}],Table[a[i]->1,{i,n-p1+1,n}]}];
temp=temp//.{f0->fSimplifyG,act->actionSimplifyG,w->omega,actOnF->actionOnF,x->xSimplifyG};
temp=temp/.{a[1]->a,a[2]->b,a[3]->c,a[4]->d,a[5]->e,g[1]->g,g[2]->h,g[3]->k,g[4]->l,g[5]->m};
newfvec[p1]=temp;
Print[temp];
];

Print["---All newf = ",newfag];