(* ::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]];


Place[{r:(TC|R6T|Slide), 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[{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[{Slide},{i_, j_, k_}] := Diag /@ {Slide[i,j,k], Slide[j,k,i], Slide[k,i,j]};
Diagrams[Slide] := Place[{Slide}, {1,2,3}];
Diagrams[Slide+k_.*ar] /; k>0 := Flatten[
Place[#, Range[2k+3]]& /@ Permutations[Table[ar, {k}]~Append~Slide]
];
Diagrams[Slide+k_.*ar] /; k<0 := {};


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]]
);
R[Diag[lft___, TC[i_,j_,k_], rgt___]] := (
+NormalizeDiag[Diag[lft, ar[i, j], ar[i+0.5, k], rgt]]
-NormalizeDiag[Diag[lft, ar[i+0.5, j], ar[i, k], rgt]]
);
R[Diag[lft___, Slide[i_,j_,k_], 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]]
);


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]
];


DimAwLong[3]


Tij[ar[ti_,hi_], ar[tj_,hj_]] := If[
ti<hj<hi || hi<hj<ti,
Sign[hj-tj],0
];
T[d_Diag] := Outer[Tij,List@@d, List@@d]


T[Diagrams[4ar] // Last] // MatrixForm


Wa[d_Diag] := Det[T[d]];
Wa[expr_] := expr /. d_Diag :> Wa[d]


Wa[Diagrams[3ar]]


R /@ Diagrams[TC]


Wa[R /@ Diagrams[TC]]


Wa[R /@ Diagrams[TC+1ar]]


Union[Wa[R /@ Diagrams[TC+2ar]]]


Wa[R /@ Diagrams[R6T]]


Wa[R /@ Diagrams[R6T+1ar]] // Union


Wa[R /@ Diagrams[R6T+2ar]] // Union


R /@ Diagrams[Slide]


Wa[R /@ Diagrams[Slide]]


Wa[R /@ Diagrams[Slide+1ar]]


(Diagrams[Slide+1ar])[[8]]


R[Diag[ar[1,3],Slide[4,5,2]]]


Wa[Diag[ar[1,3],ar[4,5],ar[6,2]]-Diag[ar[1,4],ar[5,3],ar[6,2]]]
