(* ::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.                                                         *)
(************************************************************************)



SetAttributes[Diag, Orderless];
Place[{ar},{i_, j_}] := {Diag[ar[i,j]], Diag[ar[j,i]]};
Place[{ar, objs__}, {i_, rest__}] := Flatten[Table[
Outer[Join,
Place[{ar}, {i, {rest}[[k]]}],
Place[{objs}, Delete[{rest}, k]]
],
{k, Length[{rest}]}
]];
Diagrams[k_.*ar]  := Place[Table[ar, {k}], Range[2k]];


DiagramRotateLeft[d_Diag]:=Module[
{labels=Union@@(List@@Apply[List,d,{1}])},
d/.Thread[Rule[labels,RotateLeft[labels]]]
];
DiagramRotateToMinimal[expr_]:=expr/.d_Diag:>Module[
{bd=d,rd=DiagramRotateLeft[d]},
While[rd=!=d,
bd=First[Sort[{bd,rd}]];
rd=DiagramRotateLeft[rd]];
bd
];
ClosedDiagrams[dir_] := ClosedDiagrams[dir] = Union[DiagramRotateToMinimal[Diagrams[dir]]]


Place[{r:(TC|R6T), objs__}, {i_, rest__}] := Flatten[Table[
Outer[Join,
Place[{r}, {i, {rest}[[j]], {rest}[[k]]}],
Place[{objs}, Delete[{rest}, {{j}, {k}}]]
],
{k, 2, Length[{rest}]}, {j,1, k-1}
]];
Place[{r:RI, objs__}, {i_, rest__}] := Outer[Join,
Place[{r}, {i}],
Place[{objs}, {rest}]
];


Place[{R6T},{i_, j_, k_}] := Permutations[{i,j,k}] /. {i1_,j1_,k1_} :> Diag[R6T[i1,j1,k1]];
Diagrams[R6T] := Place[{R6T}, {1,2,3}];
Diagrams[R6T+k_.*ar] /; k>0 := Flatten[
Place[#, Range[2k+3]]& /@ Permutations[Table[ar, {k}]~Append~R6T]
];
Diagrams[R6T+k_.*ar] /; k<0 := {};


Place[{TC},{i_, j_, k_}] := Diag /@ {TC[i,j,k], TC[j,k,i], TC[k,i,j]};
Diagrams[TC] := Place[{TC}, {1,2,3}];
Diagrams[TC+k_.*ar] /; k>0 := Flatten[
Place[#, Range[2k+3]]& /@ Permutations[Table[ar, {k}]~Append~TC]
];
Diagrams[TC+k_.*ar] /; k<0 := {};


Place[{RI}, {i_}] := {Diag[RI[i]]};
Diagrams[RI] = Place[{RI}, {1}];
Diagrams[RI+k_.*ar] /; k>0 := Flatten[
Place[#, Range[2k+1]]& /@ Permutations[Table[ar, {k}]~Append~RI]
];
Diagrams[RI+k_.*ar] /; k<0 := {};


DiagramsSansFI[specs_] := Select[Diagrams[specs],
FreeQ[#, ar[i_,j_] /; Abs[i-j]==1]&
];
ClosedDiagramsSansFI[specs_] := Select[ClosedDiagrams[specs],
FreeQ[#, ar[i_,j_] /; Abs[i-j]==1]&
]


NormalizeDiag[diag_Diag] := Module[
{indices = Union@@ (List @@ diag /. ar -> List)},
diag /. Thread[indices -> Range[Length[indices]]]
];
R[Diag[lft___, R6T[i_,j_,k_], rgt___]] := (
+NormalizeDiag[Diag[lft, ar[i,j], ar[i+0.5, k], rgt]]
+NormalizeDiag[Diag[lft, ar[i,j], ar[j+0.5, k], rgt]]
+NormalizeDiag[Diag[lft, ar[i,k], ar[j, k+0.5], rgt]]
-NormalizeDiag[Diag[lft, ar[i,k], ar[i+0.5, j], rgt]]
-NormalizeDiag[Diag[lft, ar[i,j+0.5], ar[j, k], rgt]]
-NormalizeDiag[Diag[lft, ar[i,k+0.5], ar[j, k], rgt]]
);
(* ooops, TC is HC; needs fixing *)
R[Diag[lft___, TC[i_,j_,k_], rgt___]] := (
+NormalizeDiag[Diag[lft, ar[i,k], ar[j, k+0.5], rgt]]
-NormalizeDiag[Diag[lft, ar[i,k+0.5], ar[j, k], rgt]]
);
R[Diag[lft___, RI[i_], rgt___]] := (
+NormalizeDiag[Diag[lft, ar[i,i+0.5], rgt]]
-NormalizeDiag[Diag[lft, ar[i+0.5,i], rgt]]
);
RSansFI[d_Diag] := (R[d] /. Diag[lft___, ar[i_,j_], rgt___] /; Abs[i-j]==1 :> 0)


DimAvLong[m_] /; m<2 := Length[Diagrams[m ar]];
DimAvLong[m_] /; m>=2 := Module[
{diags, rels, mat, rel, i},
diags=Diagrams[m ar];
rels=R /@ Diagrams[R6T+(m-2)ar];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
];


DimAsvLong[m_] /; m<1 := Length[Diagrams[m ar]];
DimAsvLong[m_] /; m>=1 := Module[
{diags, rels, mat, rel, i},
diags=Diagrams[m ar];
rels=Join[
R /@ Diagrams[R6T+(m-2)ar],
R /@ Diagrams[RI+(m-1)ar]
];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
];


DimArvLong[m_] /; m<2 := Length[DiagramsSansFI[m ar]];
DimArvLong[m_] /; m>=2 := Module[
{diags, rels, mat, rel, i},
diags=DiagramsSansFI[m ar];
rels=RSansFI /@ DiagramsSansFI[R6T+(m-2)ar];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
];


DimAvClosed[m_] /; m<2 := Length[ClosedDiagrams[m ar]];
DimAvClosed[m_] /; m>=2 := Module[
{diags, rels, mat, rel, i},
diags=ClosedDiagrams[m ar];
rels=DiagramRotateToMinimal[R /@ ClosedDiagrams[R6T+(m-2)ar]];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
]


DimAsvClosed[m_] /; m<1 := Length[ClosedDiagrams[m ar]];
DimAsvClosed[m_] /; m>=1 := Module[
{diags, rels, mat, rel, i},
diags=ClosedDiagrams[m ar];
rels=DiagramRotateToMinimal[R /@ Join[
ClosedDiagrams[R6T+(m-2)ar], ClosedDiagrams[RI+(m-1)ar]
]];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
]


DimArvClosed[m_] /; m<2 := Length[ClosedDiagramsSansFI[m ar]];
DimArvClosed[m_] /; m>=2 := Module[
{diags, rels, mat, rel, i},
diags=ClosedDiagramsSansFI[m ar];
rels=Union[
DiagramRotateToMinimal[RSansFI /@ ClosedDiagramsSansFI[R6T+(m-2)ar]] /. Diag[lft___, ar[i_,j_], rgt___] /; Abs[i-j]==1 :> 0
];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
];


DimAwLong[m_] /; m<2 := Length[Diagrams[m ar]];
DimAwLong[m_] /; m>=2 := Module[
{diags, rels, mat, rel, i},
diags=Diagrams[m ar];
rels=R /@ Join[Diagrams[R6T+(m-2)ar], Diagrams[TC+(m-2)ar]];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
];


DimAwClosed[m_] /; m<2 := Length[ClosedDiagrams[m ar]];
DimAwClosed[m_] /; m>=2 := Module[
{diags, rels, mat, rel, i},
diags=ClosedDiagrams[m ar];
rels=DiagramRotateToMinimal[
R /@ Join[Diagrams[R6T+(m-2)ar], Diagrams[TC+(m-2)ar]]
];
mat = SparseArray[
Join @@ Table[
rel=rels[[i]];
{i,Position[diags, #][[1,1]]} -> Coefficient[rel, #]& /@ Cases[{rel}, diag_Diag, Infinity],
{i,Length[rels]}
],
{Length[rels], Length[diags]}
];
Length[diags]-MatrixRank[mat]
];


PrimitivesToAll[p_List] := Module[{x},
CoefficientList[Series[
Product[(1-x^i)^(-p[[i]]), {i, Length[p]}],
{x, 0, Length[p]}],x]
]



