(* ::Package:: *)

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

(* ::Input::Initialization:: *)
SR={ (* Straightening Rules *)
w[l___,Subscript[x, c_,d_],Subscript[x, a_,b_],r___]/;a<b<c<d:>w[l,Subscript[x, a,b],Subscript[x, c,d],r],
w[l___,Subscript[x, a_,c_],Subscript[x, a_,b_],r___]/;a<b<c:>q^-1 w[l,Subscript[x, a,b],Subscript[x, a,c],r],
w[l___,Subscript[x, b_,c_],Subscript[x, a_,c_],r___]/;a<b<c:>q^-1 w[l,Subscript[x, a,c],Subscript[x, b,c],r],
w[l___,Subscript[x, b_,c_],Subscript[x, a_,b_],r___]/;a<b<c:>q w[l,Subscript[x, a,b],Subscript[x, b,c],r]-q w[l,Subscript[x, a,c],r],
w[l___,Subscript[x, a_,d_],Subscript[x, b_,c_],r___]/;a<b<c<d:>w[l,Subscript[x, b,c],Subscript[x, a,d],r],
w[l___,Subscript[x, b_,d_],Subscript[x, a_,c_],r___]/;a<b<c<d:>w[l,Subscript[x, a,c],Subscript[x, b,d],r]-(q-q^-1)w[l,Subscript[x, b,c],Subscript[x, a,d],r]
};


(* ::Input::Initialization:: *)
Straighten[\[ScriptCapitalE]_]:=FixedPoint[Expand[#/.SR]&,\[ScriptCapitalE],10]


(* ::Input::Initialization:: *)
AllSingleSteps[\[ScriptCapitalE]_]:=Union@Expand@Flatten[
Map[
p|->MapAt[
\[Omega]|->Replace[{}->{\[Omega]}]@ReplaceList[SR]@\[Omega],
{\[ScriptCapitalE]},p
],
Position[{\[ScriptCapitalE]},_w,\[Infinity]]
]
];
AllSingleSteps[\[ScriptCapitalL]_List]:=Union@Flatten[AllSingleSteps/@\[ScriptCapitalL]]


(* ::Input::Initialization:: *)
Test[\[ScriptCapitalE]_]:=Length@Union[Straighten/@AllSingleSteps[\[ScriptCapitalE]]]



