(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(* ::Input::Initialization:: *)
Print@"\!\(\*
StyleBox[\"Warning\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\":\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"risky\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"$m1\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"and\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"$m2\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"in\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"EROAdjoin\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"!\",\nFontColor->RGBColor[1, 0, 0]]\)"


(* ::Input::Initialization:: *)
SetAttributes[{EROMake,EROPeek,EROAdjoin}, HoldFirst];


(* ::Input::Initialization:: *)
EROMake[er_,n_Integer]:=er=Table[0,n];


(* ::Input::Initialization:: *)
EROPeek[er_,n_Integer]:= If[er[[n]]==0,n,er[[n]]=EROPeek[er,er[[n]]]];


(* ::Input::Initialization:: *)
EROAdjoin[er_,n1_Integer\[UndirectedEdge]n2_Integer]:=(
$m1=EROPeek[er,n1]; $m2=EROPeek[er,n2];
Switch[Order[$m1, $m2],0, $m1,1, er[[$m2]]=$m1,-1, er[[$m1]]=$m2])


(* ::Input::Initialization:: *)
VPB[n_,gs_List]:=1+Sum[(2n(n-1))^s,{s,0,Length[gs]-1}]+FromDigits[gs//.{Subscript[\[Sigma], i_,j_]:>(n-1)(i-1)+If[j<i,j-1,j-2], Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i_,j_]:>n(n-1)+Subscript[\[Sigma], i,j]},2n(n-1)];


(* ::Input::Initialization:: *)
VPB[n_,c_Integer]:=Module[{c1,cc,r=0,s,i,j,d},
c1=cc=c-1;
While[(c1=cc-(2n(n-1))^r)>=0,cc=c1;++r];
Table[
{r,i,j}=1+IntegerDigits[d,MixedRadix[{2,n,n-1}],3];
If[j>=i,++j];
If[r==1,Subscript[\[Sigma], i,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j]],
{d,IntegerDigits[cc,2n(n-1),r]}
]]


(* ::Input::Initialization:: *)
CountVPB[n_,m_]:=CountVPB[n,{m,m}];
CountVPB[n_,{m1_,m2_}]:=Module[{\[Sigma],gens,dc,d2n,s,VPB,T,ij,ijk,ijkl,i,j,k,l,perm},
{Subscript[\[Sigma], i_,j_]:=(n-1)(i-1)+If[j<i,j-1,j-2], Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i_,j_]:=n(n-1)+Subscript[\[Sigma], i,j]};
gens=Range[2n(n-1)]-1;
dc[m_]:=dc[m]=Sum[(2n(n-1))^s,{s,0,m}];
Print[dc/@{m1,m2}," diagrams..."];
EROMake[$er,dc[m2]];
VPB[_,gs_List]:=1+dc[Length[gs]-1]+FromDigits[gs,2n(n-1)];
T[b1_,b2_]:=EROAdjoin[$er,b1\[UndirectedEdge]b2];
Do[{i,j}=ij; {
T[VPB[n,Join[p,{Subscript[\[Sigma], i,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j]},q]],VPB[n,Join[p,q]]],
T[VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j],Subscript[\[Sigma], i,j]},q]],VPB[n,Join[p,q]]]
},
{s,0,m2-2},{t,0,s},{p,Tuples[gens,t]},{q,Tuples[gens,s-t]},
{ij,Join@@(Permutations/@Subsets[Range[n],{2}])}
];
Do[{i,j,k}=ijk; {
T[VPB[n,Join[p,{Subscript[\[Sigma], i,j],Subscript[\[Sigma], i,k],Subscript[\[Sigma], j,k]},q]],VPB[n,Join[p,{Subscript[\[Sigma], j,k],Subscript[\[Sigma], i,k],Subscript[\[Sigma], i,j]},q]]],
T[VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), j,i],Subscript[\[Sigma], i,k],Subscript[\[Sigma], j,k]},q]],VPB[n,Join[p,{Subscript[\[Sigma], j,k],Subscript[\[Sigma], i,k],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), j,i]},q]]],
T[VPB[n,Join[p,{Subscript[\[Sigma], i,j],Subscript[\[Sigma], i,k],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,j]},q]],VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,j],Subscript[\[Sigma], i,k],Subscript[\[Sigma], i,j]},q]]],
T[VPB[n,Join[p,{Subscript[\[Sigma], i,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,i],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,j]},q]],VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,i],Subscript[\[Sigma], i,j]},q]]],
T[VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), j,i],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,i],Subscript[\[Sigma], j,k]},q]],VPB[n,Join[p,{Subscript[\[Sigma], j,k],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,i],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), j,i]},q]]],
T[VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), j,i],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,i],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,j]},q]],VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,i],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), j,i]},q]]]
},
{s,0,m2-3},{t,0,s},{p,Tuples[gens,t]},{q,Tuples[gens,s-t]},
{ijk,Join@@(Permutations/@Subsets[Range[n],{3}])}
];
Do[{i,j,k,l}=ijkl; {
T[VPB[n,Join[p,{Subscript[\[Sigma], i,j],Subscript[\[Sigma], k,l]},q]],VPB[n,Join[p,{Subscript[\[Sigma], k,l],Subscript[\[Sigma], i,j]},q]]],
T[VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j],Subscript[\[Sigma], k,l]},q]],VPB[n,Join[p,{Subscript[\[Sigma], k,l],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j]},q]]],
T[VPB[n,Join[p,{Subscript[\[Sigma], i,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,l]},q]],VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,l],Subscript[\[Sigma], i,j]},q]]],
T[VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,l]},q]],VPB[n,Join[p,{Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), k,l],Subscript[\!\(\*OverscriptBox[\(\[Sigma]\), \(_\)]\), i,j]},q]]]
},
{s,0,m2-2},{t,0,s},{p,Tuples[gens,t]},{q,Tuples[gens,s-t]},
{ijkl,Join@@(Permutations/@Subsets[Range[n],{4}])}
];
Count[Take[$er,dc[m1]],0]
]



