Pensieve header: Finding the braids for which the complexity of $\bar{\Gamma}$ grows in the fastest way.

SetDirectory@"C:\\drorbn\\AcademicPensieve\\Projects\\OU";
<< "OU-Programs.m"

A_∖B_:=Complement[A,B];
VPBGens[n_]:=VPBGens[n]=Flatten@Table[{(Subscript[σ, i,j]),(Subscript[(OverBar[σ]), i,j])},{i,n},{j,Range[n]∖{i}}];

PF[n_,(Subscript[σ, i_,j_])] :=PF[n,(Subscript[σ, i,j])]=Module[{p,q,s},
Flatten@{(Subscript[σ, i,j]),(Subscript[σ, j,i]),(Subscript[(OverBar[σ]), j,i]),
Table[{(Subscript[σ, p,q]),(Subscript[σ, q,p]),(Subscript[(OverBar[σ]), p,q]),(Subscript[(OverBar[σ]), q,p])},{p,{i,j}},{q,Range[n]∖{i,j}}],
Table[{(Subscript[σ, p,q]),(Subscript[(OverBar[σ]), p,q])},{p,Range[i+1,n]∖{j}},{q,Range[n]∖{i,j,p}}] }];
PF[n_,(Subscript[(OverBar[σ]), i_,j_])] := PF[n,(Subscript[(OverBar[σ]), i,j])]=PF[n,(Subscript[σ, i,j])]/.(Subscript[σ, i,j])->(Subscript[(OverBar[σ]), i,j])

PVPBDs[n_,0]:={VPB[n]};
PVPBDs[n_,1]:=VPB[n,#]&/@VPBGens[n];
PVPBDs[n_,m_]:=Flatten[PVPBDs[n,m-1]/.VPB[n,σs___,σ_]:>(VPB[n,σs,σ,#]&/@PF[n,σ])]

AllVPBs[n_,m_]:=DeleteDuplicatesBy[(OverBar[Γ])]@Flatten@Table[b, {k,0,m},{b,PVPBDs[n,k]}]

Max[(Length[(OverBar[Γ])[#]]-3)&/@AllBs[3,3]]

ML[m_]:=Max[(Length[(OverBar[Γ])[#]]-3)&/@AllBs[3,m]]

Echo[ML[#]]& /@ Range[8]

MaximalBy[AllBs[3,4],Length@*(OverBar[Γ])]

MaximalBy[AllBs[3,5],Length@*(OverBar[Γ])]

MaximalBy[AllBs[3,6],Length@*(OverBar[Γ])]

Table[If[OddQ[k],2,-1],{k,7}]

Table[Echo[Length[(OverBar[Γ])[BR[3,Table[If[OddQ[k],2,-1],{k,m}]]]]-3], {m,13}]

Table[Echo[ExtractionGraph[(OverBar[Γ])[BR[3,Table[If[OddQ[k],2,-1],{k,m}]]], GraphLayout->Automatic]], {m,10}]

FindSequenceFunction[{1,4,10,20,36,62,104,172,282,460}]

FindSequenceFunction[{4,10,20,36,62,104,172,282,460,748,1214,1968}]

ML[n_,m_]:=Max[(Length[(OverBar[Γ])[#]]-n)&/@AllBs[n,m]]

Echo[ML[4,#]]& /@ Range[5]

Echo[ML[2,#]]& /@ Range[10]

vML[n_,m_]:=Max[(Length[(OverBar[Γ])[#]]-n)&/@AllVPBs[n,m]]

Echo[vML[2,#]]& /@ Range[6]

MaximalBy[AllVPBs[2,4],Length@*(OverBar[Γ])]

MaximalBy[AllVPBs[2,5],Length@*(OverBar[Γ])]

Table[Echo[Length[(OverBar[Γ])[VPB[2,Sequence@@Table[If[OddQ[k],(Subscript[σ, 1,2]),(Subscript[(OverBar[σ]), 2,1])],{k,m}]]]]-2], {m,10}]

Table[Echo[ExtractionGraph[(OverBar[Γ])[VPB[2,Sequence@@Table[If[OddQ[k],(Subscript[σ, 1,2]),(Subscript[(OverBar[σ]), 2,1])],{k,m}]]],GraphLayout->Automatic]], {m,8}]

FindLinearRecurrence[{1,4,11,28,69,168,407,984,2377,5740}]

Echo[vML[3,#]]& /@ Range[5]