(* ::Package:: *)

(* ::Subsection::Closed:: *)
(*Credits*)


(* ::Text:: *)
(*http://www.mcs.csueastbay.edu/~kbalasub/reprints/136.pdf*)
(*http://www.math.umn.edu/~tlawson/old/18.704/symmetric1.pdf*)
(*http://www.polyomino.f2s.com/david/haskell/charactersSn.html*)
(*http://en.wikipedia.org/wiki/Symmetric_polynomial*)
(*http://www.personal.rhul.ac.uk/usah/080/QITNotes_files/Irreps_v06.pdf*)
(*http://mathcircle.berkeley.edu/BMC3/SymPol.pdf*)
(*http://faculty.math.tsinghua.edu.cn/~jzhou/SymmetricF.pdf*)
(*Littlewood-Richardson program: modification of and parts from Daniel Bump (bump@math.stanford.edu) Copyright 1996.*)
(*http://math.stackexchange.com/questions/114151*)
(*http:// math.stackexchange.com/questions/395842*)
(*http://math.stackexchange.com/questions/83214*)
(*http://lipn.univ-paris13.fr/~toumazet/biblio/ARTICLES/NTB.pdf*)
(*http://young.sp2mi.univ-poitiers.fr/cgi-bin/form-prep/marc/LiE_form.act?action=LRR*)
(*http://mathoverflow.net/questions/22515/practical-ways-to-get-skew-schur-functions*)
(*http://en.wikipedia.org/wiki/Littlewood%E2%80%93Richardson_rule*)
(*http://projecteuclid.org/download/pdf_1/euclid.bams/1183548016*)


(* ::Text:: *)
(*Special thanks to Marc van Leeuwen for several patient explanations, both by email and on Math StackExchange.*)
(*Also credit to William J. Keith (Michigan Tech University Math Department) for guiding me in the study of t-core and t-quotients*)
(*Grateful mention of Prof. Joris Van der Jeugt for letting me attend  his course 'Representation Theory' (R.U.Gent)  fall 2014.*)
(**)


(* ::Text::RGBColor[0, 0, 1]:: *)
(*to do: cyclecleasses -> classSize ;  {m,e,h,p,s} to be replaced by script { \[ScriptM] , \[ScriptE] , \[ScriptH] , \[ScriptP] , \[ScriptS] } or gothic { \[GothicM] , \[GothicE] , \[GothicH] , \[GothicP] , \[GothicS] } characters ,*)
(*entered as esc-sc-#-esc ( "\[Script#] " ) or es-go-#-esc ; convert to subscript notation; reserve single letter functions u[par,v_] for symbolic S.F. and double letter functions for expressions involving Subscript[x, i] ; *)


(* ::Subsection:: *)
(*Inits*)


(* ::Text:: *)
(*variables in use before installing ToolBox.nb :*)


(* ::Input::Initialization:: *)
DeleteCases[Names["@*"], str_ /; StringMatchQ[str, "$*"] || 
    StringMatchQ[ToString[FullForm[str]], "*Formal*"]]


(* ::Input::Initialization:: *)
Quiet[Needs["Combinatorica`"],General::compat];


(* ::Text:: *)
(*variables in use after installing ToolBox.nb :  (all other cells are initialisation cells, execute this one to have it as last instruction)*)


(* ::Input::RGBColor[1, 0, 0]:: *)
(*DeleteCases[Names["@*"], str_ /; StringMatchQ[str, "$*"] || *)
(*    StringMatchQ[ToString[FullForm[str]], "*Formal*"]]*)


(* ::Text:: *)
(*Defined Functions: {"asorder","aspartitions","chars","content","core","coredecompose","corerecompose","countSkewSSYT","countSkewSYT","cycleclasses","descentset","e","e2f","e2h","e2m","e2p","e2s","ee","expr2pow","f","f2e","f2h","f2m","f2p","f2s","ff","fromEdge","h","h2e","h2f","h2h","h2m","h2p","h2s","hh","hooklength","inversions","kostka","latticeword","latticewordQ","lesspartitions","m","m2e","m2f","m2h","m2m","m2p","m2s","majorsstrong","majorsweak","mm","monomProd2Sum","p","p2e","p2f","p2h","p2m","p2s","par2pow","partitionexact","pow2m","pow2par","pp","rankpartition","rectify","s","s2e","s2f","s2h","s2m","s2p","schurProd2Sum","showskew","skewfactor","skewredu","skewschur","skewschur2","skewSSYT","skewSYT","ss","stanley","tableauxForm","tableauxToWord","threadSP","toEdge","trim","unrankpartition","unthreadSP","weight","wordToTableaux"}*)


(* ::Subsection::Closed:: *)
(*Definitions and Implementation conventions.*)


(* ::Text:: *)
(*in the following description we designate the five S.P. by a generic name  u   (representing m, p, h, e or s).*)
(*We choose to define 3 formats for representing the Symmetric Polynomials (S.P.) .*)
(**	expanded format:  u[ arg  , # of variables v ]  produces \[CapitalSigma]  a Subscript[x, 1]^i  Subscript[x, 2]^j ... Subscript[x, v]^z : allows all symbolic manipulations using standard algebraic functions,  but becomes large and slow for small to moderate arguments, and quite unfit for human consumption.*)
(*It can however always be reduced to elementary S.P. by  the standard 'SymmetricReduction' function.*)
(**	condensed format:  Subscript[\[CapitalSigma], i] Subscript[a, i] Subscript[p, n]^i  where Subscript[p, n]^i stands for the i-th partition of  n in reverse lexicographic ordering. It codes the expanded format by ignoring the permutation of the (interchangeable) indices and extracting only the (orderless) exponents recast into a partition of n. This format loses the info on the actual number of variables used.  It groups monomials according to the exponents : 5 Subscript[x, 1]^3 Subscript[x, 3]^2 becomes 5 Subscript[p, 5]^3 since {3,2} is the 3rd partition of 5. The info that there are 3 or more variables 'in play' (as shown by the indices 1 and 3) is lost.*)
(**	unevaluated format uu[ arg , # of variables v ] which can be taken as argument for symbolic transformation functions. Only the basic definition uu[ partition, v ]==0 /; Length[partition]>v is coded for (one cannot distribute 5 exponents over 4 variables).  *)


(* ::Text:: *)
(*The S.P.  p , h and e  have the property of being threaded over their (first) argument:  p[{3,1,1}, v] equals p[3, v]  p[1, v]^2 and the transformation rules work on this last unevaluated form with integer argument. The forward and backward conversions on uu are performed by the functions threadSP[ expr , uu ] and unthreadSP[  arg , uu ] regrouping (products of)  integer arguments   uu[ n (,v])^i uu[ m , (v])^j ...  into partition arguments   uu[{ n (i copies), m (j copies) ... }, v] or the reverse.*)
(*The S.P. m (monomial) and s (Schur) do not share this property, and always need a partition as first argument. Transformations thus need a threading step in order to get acceptable arguments.*)


(* ::Text:: *)
(*Transformation Functions:*)
(*u[ arg  , # of variables v ] produces the expanded format  \[CapitalSigma]  a Subscript[x, 1]^i  Subscript[x, 2]^j ... Subscript[x, v]^z ,*)
(*expr2pow[  arg  ] converts expanded format into condensed format  Subscript[\[CapitalSigma], i] Subscript[a, i] Subscript[p, n]^i ,*)
(*pow2m[ condensed , v :optional ] converts the condensed format into monomial S.P. but if no v (# of variables) is entered, then it defaults to the partition size n common to all terms Subscript[p, n]^i  *)
(*uu[ arg , v ] is an inactive (unevaluated) representation except for a partition \[Lambda] as argument when |\[Lambda]|> v  (producing 0) ;*)
(**)
(*u2w[ arg , v ] converts uu[ arg , v ] into ww[ arg , v ] if such transformation is known and available; it is intended to be implemented as a substitution rule, example:  ( expression containing uu[ arg , v ] )  /.  uu-> u2w  //Expand*)
(**)
(*monomProd2Sum[ arg  ] implements the decomposition of powers and products of mm[ par, v ] into sums of them. ( http://math.stackexchange.com/questions/83214 )*)
(*schurProd2Sum[ arg  ] implements the decomposition of powers and products of ss[ par, v ] into sums of them by calling the L-R rule package.*)
(**)
(*The following grid shows the available conversions:*)
(*(entries in red need a partition-type argument, entries in black can also take an integer argument) *)


(* ::Text:: *)
(*{*)
(* {            to*)
(*   from   , e, p, h, m, s},*)
(* {e, 1, e2p, e2h, e2m, e2s},*)
(* {p, p2e, 1, p2h, p2m, p2s},*)
(* {h, h2e, h2p, 1, h2m, h2s},*)
(* {m, m2e, m2p, m2h, 1, m2s},*)
(* {s, s2e, s2p, s2h, s2m, 1}*)
(*}*)


(* ::Subsection::Closed:: *)
(*General*)


(* ::Input::Initialization:: *)
Partition1Q[arg_List]:=And[MatchQ[arg,{___Integer}],arg=={}||Positive[1+Min[arg-Append[Rest[arg],0]]]];


(* ::Input::Initialization:: *)
partitionexact[n_,m_]:=TransposePartition/@(Prepend[#,m]&/@Partitions[n-m,m]);


(* ::Input::Initialization:: *)
NumberOfPartitions2[(n_Integer)?Positive, 0] := 0; 
NumberOfPartitions2[0, k_Integer] := 1; 
NumberOfPartitions2[(n_Integer)?Positive, 1] := 1; 
NumberOfPartitions2[(n_Integer)?Positive, (k_Integer)?Positive] := 
NumberOfPartitions[n] /; k >= n; 
NumberOfPartitions2[n_Integer, k_Integer] := Block[{$RecursionLimit = Infinity}, 
    NumberOfPartitions2[n, k] = 
NumberOfPartitions2[n, k - 1] + NumberOfPartitions2[n - k, k]]; 


(* ::Input::Initialization:: *)
rankpartition[{}]:=0;
rankpartition[(p_)?Partition1Q] := PartitionsP[Tr[p]] - 
    Sum[(NumberOfPartitions2[Tr[#1], First[#1] - 1] & )[
Drop[p, k]], {k, 0, Length[p] - 1}]; 


(* ::Input::Initialization:: *)
unrankpartition[n_Integer, k_Integer] := 
Block[{ove, res, qq, zz, mem}, 
     ove = PartitionsP[n] - k; res = {}; While[n - Tr[res] > 0, 
qq = 0; zz = 0; 
        While[(mem = NumberOfPartitions2[n - Tr[res], qq + 1]) <= ove,
 zz = mem; qq++]; 
        AppendTo[res, qq + 1]; ove = ove - zz]; res] /; 
k <= PartitionsP[n] && k > 0; 


(* ::Input::Initialization:: *)
rankpartition[par_?Partition1Q,All]:=Tr[PartitionsP[Range[Tr[par]-1]]]+rankpartition[par];


(* ::Input::Initialization:: *)
unrankpartition[0,All]:={};
unrankpartition[n_Integer,All]:=Block[{k=1,z},While[(z=Tr[PartitionsP[Range@k]])<n,k++];unrankpartition[k,PartitionsP[k]+n-z]];


(* ::Input::Initialization:: *)
aspartitions[n_]:=Reverse/@Sort[Sort/@Partitions[n]];


(* ::Input::Initialization:: *)
asorder[n_]:=rankpartition/@Reverse/@Sort[Sort/@
Partitions[n]];


(* ::Input::Initialization:: *)
lesspartitions[\[Lambda]_?Partition1Q]:=Drop[Partitions[Tr@\[Lambda]],rankpartition[\[Lambda]]];


(* ::Input::Initialization:: *)
trim[{}]:={};
trim[\[Lambda]_?Partition1Q]:=DeleteCases[MapAt[#-1&,\[Lambda],#],0]&/@Position[\[Lambda] -Append[Rest[\[Lambda]],0],_?Positive];


(* ::Input::Initialization:: *)
grow[par_?Partition1Q]:=Join[{Append[par,1]},MapAt[#+1&,par,#]&/@Join[{{1}},1+Position[Differences[par],_?Negative]]];


(* ::Input::Initialization::GrayLevel[0]:: *)
\[Epsilon][\[Lambda]_?PartitionQ]:=(-1)^(Tr[\[Lambda]]-Count[\[Lambda],_?Positive]);


(* ::Input::Initialization::GrayLevel[0]:: *)
z[\[Lambda]_?PartitionQ]:=Apply[Times, Tally[\[Lambda]]/.{a_Integer,b_}->a^b b!];


(* ::Subsection::Closed:: *)
(*Kostka*)


(* ::Input::Initialization:: *)
multi[n_, v_, q_, le_] := Take[Apply[Multinomial @@ Append[Length /@ 
Split[Sort[#1]], v - #2]*#3 & , 
     ({#1, Length[#1], If[Length[#1] > v || Length[#1] < le, 0, 1]} & ) 
/@ Partitions[n], {1}], {q, -1}]; 


(* ::Input::Initialization:: *)
multipol[(par_)?Partition1Q, v_Integer] := multi[Tr[par], v, 
rankpartition[par], Length[par]]; 


(* ::Input::Initialization:: *)
recur[(par_)?Partition1Q, v_Integer, h_:{}] := 0 /; v < Length[par]; 


(* ::Input::Initialization:: *)
recur[(par_)?Partition1Q, v_Integer, h_:{}] := 
Block[{segs, deco, trabase, np}, 
 np = Tr[par]; segs = Length /@ Split[TransposePartition[par]]; 
 deco = (Table[Max[0, Min[i - j + 1, 1]], {i, 0, #1}, {j, #1}] & ) /@ segs; 
 trabase = TransposePartition[par] - 1; 
 Tr[Flatten[Outer[w[TransposePartition[DeleteCases[
trabase + Flatten[{##1}], 0]]] & , 
 Sequence @@ deco, 1]] /. w[q_List] -> temp[q, v - 1, DeleteCases[
 Sort[Append[h, np - Tr[q] - Tr[h]]], 0]]]]; 


(* ::Input::Initialization:: *)
intermed0[par_List, v_Integer, h_List] := 
   Block[{}, (w[Reverse[Sort[Append[#1, Tr[h]]]]] & ) /@ 
Take[Partitions[Tr[par]], 
       -(PartitionsP[Tr[par]] + 1 - rankpartition[par])] . MapThread[
#1*#2 & ,  {multipol[par, v], kostka1[par]}]]; 


(* ::Input::Initialization:: *)
Clear[kostka1]; 
kostka1[{(1)..}] := {1}; 
kostka1[{k_Integer}] := 1 + 0*Range[PartitionsP[k]]; 
(* kostka1[(par_)?Partition1Q] := kostka1[par] = Block[{parlen = Tr[par],
v = Tr[par], it, vec}, 
     it = recur[par, v] //. temp[a_, b_, c_] :> recur[a, b, c] /; 
(Tr[a] == parlen && b > 1) || b < Length[a]; 
 vec = (it /. temp -> intermed0 /. w[p_List] -> w[rankpartition[p]]) + 
 Plus @@ w /@ Range[rankpartition[par], PartitionsP[Tr[par]]]; 
((List @@ vec /. w[_] -> 1) - 1)/
(multipol[par, Tr[par]] /. 0 -> 1)]; *)


(* ::Input::Initialization:: *)
 <<"http://users.telenet.be/Wouter.Meeussen/kostkaList.txt";


(* ::Input::Initialization:: *)
kostka[{}]:=0; 


(* ::Input::Initialization:: *)
kostka[(par_)?Partition1Q] /; Tr[par]<=20:= PadLeft[kostka1[par], PartitionsP[Tr[par]]]; 


(* ::Input::Initialization:: *)
kostka[(par_)?Partition1Q] /;(Tr[par]>20&&Tr[par]<30):=Part[ kostkamat[Tr[par]],rankpartition[par]];


(* ::Input::Initialization:: *)
kostkamat[n_Integer] :=kostkamat[n]=Block[{k1,k2},k1=s2h[#,n]&/@Partitions[n] /. hh[par_,_]:>h^rankpartition[par];
k2=Rest[PadRight[CoefficientList[#,h],1+PartitionsP[n]]]&/@k1;
Transpose[Inverse[k2]]];


(* ::Subsection::Closed:: *)
(*Hook lengths and Contents*)


(* ::Input::Initialization:: *)
hooklength[(\[Lambda]_)?Partition1Q] := Table[Count[\[Lambda], q_ /; q >= j] + 1 - i + \[Lambda][[i]] - j, 
{i, Length[\[Lambda]]}, {j, \[Lambda][[i]]}]; 


(* ::Input::Initialization:: *)
content[(par_)?Partition1Q] :=Table[j-i,{i,Length[par]},{j,par[[i]]}];


(* ::Input::Initialization:: *)
stanley[(p_)?Partition1Q, t_Integer] := Times @@ ((t + Flatten[content[p]])/
Flatten[hooklength[p]]); 


(* ::Input::Initialization:: *)
weight[li_List] := Table[Count[Sort[Flatten[li]], k],
 {k, Max[Flatten[li]]}]; 


(* ::Input::Initialization:: *)
latticeword[t_?TableauQ]:=Part[Position[t,#],1,1]&/@Range[Max[t]];


(* ::Input::Initialization:: *)
latticewordQ[w_]:=And@@Table[If[w[[i]]>1,Count[Take[w,i], w[[i]]-1 ]>=Count[Take[w,i],w[[i]]],True],{i,1,Length[w]}];


(* ::Input::Initialization:: *)
descentset[t_?TableauQ] := Sort[Cases[t, i_Integer /; Position[t, i + 1][[1,1]] > 
       Position[t, i][[1,1]], {2}]]; 


(* ::Input::Initialization:: *)
inversions[t_?TableauQ]:=Block[{t0 },t0= First[Position[t,#]]&/@Range[Max[t]];
Cases[Table[ {i,j},{j,2,Max[t]},{i,j-1}],{i_,j_}/;MatchQ[t0[[i]]-t0[[j]],{_?Negative,_?Positive}]->{i,j},{2}] ];


(* ::Subsection::Closed:: *)
(*SSYT*)


(* ::Input::Initialization:: *)
majorsweak[left_List, right_List] := Block[{le1 = Length[left],
 le2 = Length[right]}, 
    If[le2 > le1 || Min[Sign[left - PadRight[right, le1]]] < 0, False, True]]; 


(* ::Input::Initialization:: *)
majorsstrong[left_List, right_List] :=  !(First[right] > First[left] || 
     Min[Sign[PadRight[left, Length[right]] - right]] < 1); 


(* ::Input::Initialization:: *)
solspace[par_List, v_Integer] := Block[{tra = TransposePartition[par], it}, 
    it = MapIndexed[Function[{q, i}, Union[(PadRight[#1, q] & ) /@ 
Partitions[q*(v + 1 - Tr[i]), 
           v + 1 - Tr[i]]]], par]; MapIndexed[
      Cases[#1, q_List /; majorsweak[q, (1 - Tr[#2]) + 
Take[tra, par[[Tr[#2]]]]]] & , it]]; 


(* ::Input::Initialization:: *)
SSYT[par_List, v_Integer] := Block[{sspace}, sspace = solspace[par, v]; 
     v + 1 - If[Length[par] === 1, List /@ Flatten[sspace, 1], Backtrack[sspace, 
        If[Length[#1] < 2, True, majorsstrong[#1[[-2]], #1[[-1]]]] & ,
 True & , All]]]; 


(* ::Input::Initialization:: *)
tableauxForm[yt_List] := (TableForm[#1, TableSpacing -> {1, 1}] & ) /@ 
yt (* /.  q:{__Integer} :> StringJoin @@ ToString /@ q *); 


(* ::Subsection::Closed:: *)
(*Symmetric Polynomials*)


(* ::Input::Initialization:: *)
par2pow[(p1_)?Partition1Q] := Subscript[p, Tr[p1]]^rankpartition[p1]; 


(* ::Input::Initialization:: *)
pow2par[li_] := dummy+li /. Plus -> List /. Subscript[p, a_]^(b_:1) :> X[Partitions[a][[b]]]/. dummy->Sequence[]; 


(* ::Input::Initialization:: *)
expr2pow[expr_] := Block[{a, q, e, w, u1, u2, u3}, 
    u1 = Expand[q*Together[Expand[expr /. 
Subscript[a_, b_] -> a[b]]] + q*a] /. Plus -> List; 
     u2 = u1 /. Times -> w /. q -> Sequence[] /. 
w[(i_Integer) | (i_Rational), r__] :> i*w[r] /. 
       x[_]^(e_:1) -> e; u3 = Plus @@ u2 /. w[arg__] :> 
Reverse[Sort[w[arg]]] /. w[a] -> 0 /. a -> 0; 
     u3 /. w[q__] :> Subscript[p, Tr[{q}]]^rankpartition[{q}]]; 


(* ::Input::Initialization:: *)
threadSP[expr_, uu_] := Expand[expr /. uu[arg_List, v_] :> 
Times @@ Thread[uu[arg, v]]]; 


(* ::Input::Initialization:: *)
unthreadSP[expr_, uu_] := Expand[expr] /. uu[a_Integer, v_]^(i_:1) :> 
uu[Table[a, {i}], v] //. 
    uu[a_, v_]*uu[b_, v_] :> uu[Reverse[Sort[Join[a, b]]], v]; 


(* ::Input:: *)
(*(* <<Algebra`SymmetricPolynomials`; *)*)


(* ::Input:: *)
(*Clear[ee,pp,hh, mm, ss];*)


(* ::Input::Initialization:: *)
ee[0,_]:=1;ee[n_,_]:=0/;n<0; ee[n_,v_]:=0/;n>v;ee[{},_]:=1;ee[li_List,v_]:=0/; Max[li]>v;
pp[0,v_]:=v;pp[n_,_]:=0/;n<0;
hh[0,_]:=1;hh[n_,_]:=0/;n<0;
mm[{},_]:=1;  (* added 13/08/2015  *)
mm[li_List,v_Integer]:=0 /; Length[li]>v || Max[li]<=0;
ss[{},_]:=1;
ss[li_List,v_Integer]:=0 /; Length[li]>v|| Max[li]<=0;
(* not pp[list_,v_Integer]:=0 /; Length[list]>v; or s2p doesn't work;  to be investigated *)


(* ::Input::Initialization:: *)
h2e[i_Integer,_]/;i<0  := 0;h2e[0,_] := 1;
e2h[i_Integer,_]/;i<0  := 0;e2h[0,_] := 1;
h2p[i_Integer,_]/;i<0  := 0;h2p[0,_] := 1;
p2h[i_Integer,_]/;i<0  := 0;p2h[0,_] := 1;
e2p[i_Integer,_]/;i<0  := 0;e2p[0,_] := 1;
p2e[i_Integer,_]/;i<0  := 0;p2e[0,_] := 1;
(* added 15/10/2014 *)
s2p[{},_]  := 0; s2h[{},_]:=0;


(* ::Input::Initialization:: *)
Clear[e];e[{0},0]:=1;e[{0},_]:=0;
e[n_Integer,v_]:=Tr[Times@@@Select[Subsets[Table[Subscript[x,j],{j,v}]],Length[#]==n&]];
e[par_?Partition1Q,v_]:=Times@@(e[#,v]&/@ par);


(* ::Input::Initialization:: *)
e2p[n_Integer,v_Integer]:=Expand[Det[Table[If[1+c-r==0,n+1-r,pp[ 1+c-r  ,v]]/. pp[0, v ] -> v /. pp[q_, _] /; 
q < 0 -> 0,{r,n},{c,n}]]/n!];


(* ::Input::Initialization:: *)
e2h[n_Integer,v_Integer]:=Expand[Det[Table[hh[ 1+c-r,v]/. hh[0, _] -> 1 /. 
        hh[q_, _] /; q < 0 -> 0,{r,n},{c,n}]]];


(* ::Input::Initialization:: *)
Clear[e2m];
e2m[\[Lambda]_?Partition1Q,v_Integer]:=Block[{ko=kostka/@Partitions[Tr[\[Lambda]]]},
Part[Transpose[Map[ kostka[TransposePartition[#]]&,Partitions[Tr[\[Lambda]]]]].ko ,rankpartition[\[Lambda]]] . (mm[#,v]&/@Partitions[Tr[\[Lambda]]])];


(* ::Input::Initialization:: *)
Clear[p];p[{0},0]:=1;p[{0},_]:=0;p[0,v_]:=v;p[n_,_]:=0/;n<0;
p[n_Integer,v_]:=Sum[Subscript[x,j]^n,{j,v}];
p[par_?Partition1Q,v_]:=Times@@(p[#,v]&/@ par);


(* ::Input::Initialization:: *)
p2e[n_Integer,v_Integer]:=Expand[Det[Table[If[ c ==n,(n+1-r)ee[ 1+c-r  ,v],ee[ 1+c-r  ,v]]/. ee[0, v ] -> 1 /. ee[q_, _] /; q < 0 -> 0,{r,n},{c,n}]] ];


(* ::Input::Initialization:: *)
p2h[n_Integer,v_Integer]:=Expand[-(-1)^n Det[Table[If[ c ==n,(n+1-r)hh[ 1+c-r  ,v],hh[ 1+c-r  ,v]]/.hh[0, v ] -> 1 /. hh[q_, _] /; q < 0 -> 0,{r,n},{c,n}]] ];


(* ::Input::Initialization:: *)
 p2s[\[Lambda]_?Partition1Q,v_Integer]:= (Part[chars[#],rankpartition[\[Lambda]]]&/@ Partitions[Tr@\[Lambda]]) . (ss[#,v]&/@ Partitions[Tr@\[Lambda]]);


(* ::Input::Initialization:: *)
Clear[h];h[0,_]:=1;h[{0},_]:=0;
h[n_Integer,v_]:=Tr[Apply[Times,(Table[Subscript[x,j],{j,v}]^#)&/@
Compositions[n,v],{1}]];
h[par_?Partition1Q,v_]:=Times@@(h[#,v]&/@ par);


(* ::Input::Initialization:: *)
h2e[n_Integer,v_Integer]:=Expand[Det[Table[ee[ 1+c-r,v]/. ee[0, _] -> 1 /. 
       ee[q_, _] /; q < 0 -> 0,{r,n},{c,n}]]];


(* ::Input::Initialization:: *)
h2p[n_Integer,v_Integer]:=Expand[Det[Table[ ptemp[ 1+c-r  ,v] /. ptemp[0, v ] -> -n-1+r/. ptemp[q_, _] /; q < 0 -> 0,{r,n},{c,n}]]/n! /. ptemp->pp];


(* ::Input::Initialization:: *)
h2m[n_Integer, v_Integer]:= Tr[mm[#,v]&/@Partitions[n]];


(* ::Input::Initialization:: *)
h2s[\[Mu]_?Partition1Q,v_Integer]:=Tr[(Part[ kostka[#] ,rankpartition[\[Mu]]] ss[#,v])&/@Take[Partitions[Tr[\[Mu]]],rankpartition[\[Mu]]]];


(* ::Input::Initialization:: *)
Clear[m];m[li_List,_]:=0/; Max[li]<=0;
m[par_?Partition1Q,v_]:=Block[{le=Length[par],it },If[le>v,Return[0]];
it=Permutations[PadRight[par,v]];
Tr[ Apply[Times,Table[Subscript[x,j],{j,v}]^# & /@ it,{1}]]];


(* ::Input::Initialization:: *)
pow2m[expr_,v_:0]:=Block[{par}, expr/. (Subscript[p, n_]^(e_:1)) :> mm[par=unrankpartition[n,e],If[v===0,n,v]]/Apply[Multinomial,Length/@Split[PadRight[par,If[v===0,n,v]]]]];


(* ::Input::Initialization:: *)
Clear[m2e];
m2e[\[Lambda]_?Partition1Q,v_Integer]:=Block[{ko=kostka/@Partitions[Tr[\[Lambda]]]},
Part[Inverse[Transpose[Map[ kostka[TransposePartition[#]]&,Partitions[Tr[\[Lambda]]]]].ko ],rankpartition[\[Lambda]]] . (ee[#,v]&/@Partitions[Tr[\[Lambda]]])];


(* ::Input::Initialization:: *)
m2s[\[Lambda]_?Partition1Q,v_Integer]:=Expand[Inverse[kostka/@Partitions[Tr@\[Lambda]]][[rankpartition@\[Lambda]]] . (ss[#1,v]& /@Partitions[Tr@\[Lambda]])];


(* ::Input::Initialization:: *)
Clear[monomProd2Sum0,monomProd2Sum1,monomProd2Sum]; 


(* ::Input::Initialization:: *)
monomProd2Sum0[mm[\[Lambda]_, v_Integer], mm[\[Mu]_, v_]] := Block[{\[Alpha], \[Beta], dim\[Beta], it}, 
    {\[Alpha], \[Beta]} = Last /@ Sort[({Length[Union[#1]], #1} & ) /@ {\[Lambda], \[Mu]}]; 
     dim\[Beta] = Multinomial @@ Length /@ Split[PadRight[\[Beta], v]]; 
     it = (PadRight[\[Beta], v] + #1 & ) /@ Permutations[PadRight[\[Alpha], v]]; 
     Expand[Tr[(((dim\[Beta]/Multinomial @@ Length /@ Split[#1])*mm[DeleteCases[#1, 0], v] & )[
          Reverse[Sort[#1]]] & ) /@ it]]]; 


(* ::Input::Initialization:: *)
monomProd2Sum1[expr_] := Expand[Expand[expr] /. {mm[\[Lambda]_, v_Integer]^(e_ /; e > 1) :> 
       mm[\[Lambda], v]^(e - 2)*monomProd2Sum0[mm[\[Lambda], v], mm[\[Lambda], v]], mm[\[Lambda]_, v_Integer]*mm[\[Mu]_, v_] :> 
       monomProd2Sum0[mm[\[Lambda], v], mm[\[Mu], v]]}]; 


(* ::Input::Initialization:: *)
monomProd2Sum[expr_] := FixedPoint[monomProd2Sum1, expr]; 


(* ::Input::Initialization:: *)
Clear[s];s[{},_]:=1; s[li_List, _] := 0 /; Max[li] <= 0; 
s[(p_)?Partition1Q, v_] := s[p, v] = Block[{le = Length[p], n = Tr[p]}, 
     If[v < le, Return[0]]; Together[Expand[Factor[Det[Outer[#2^#1 & , 
PadRight[p, v] + v - Range[v], 
            Array[Subscript[x, #1] & , v]]]]/Factor[Det[Outer[#2^#1 & , Range[v - 1, 0, -1], 
            Array[Subscript[x, #1] & , v]]]]]]]; 


(* ::Input::Initialization:: *)
Clear[s2e]; s2e[\[Mu]_?Partition1Q, v_] := 
Block[{\[Nu] = PadRight[TransposePartition[\[Mu]], Max[v, Length[TransposePartition[\[Mu]]], 
        Length[\[Mu]]]]},unthreadSP[
     Expand[Det[Table[ee[\[Nu][[i]] - i + j, v]/. ee[0, _] -> 1 /. 
      ee[q_, _] /; q < 0 -> 0, {i, v}, {j, v}]]] ,ee]]; 


(* ::Input::Initialization:: *)
s2p[\[Mu]_?Partition1Q,v_Integer]:= Part[Transpose[Inverse[chars/@Partitions[Tr[\[Mu]]]]],rankpartition[\[Mu]] ]. (pp[#,v]&/@Partitions[Tr[\[Mu]]])  ;


(* ::Text:: *)
(*first Giambelli formula, alias Jacobi-Trudy identity.*)


(* ::Input::Initialization:: *)
s2h[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[Det[Table[hh[\[Lambda][[r]] +c-r,v]/. hh[0, _] -> 1 /. 
        hh[q_, _] /; q < 0 -> 0,{r,Length[\[Lambda]]},{c,Length[\[Lambda]]}]]],hh];


(* ::Input::Initialization:: *)
Clear[s2m];s2m[{},_]:=0;s2m[\[Lambda]_?Partition1Q,v_Integer]:=Expand[  (mm[#1,v]& /@Prepend[lesspartitions[\[Lambda]],\[Lambda]]).Drop[kostka[\[Lambda]],rankpartition[\[Lambda]]-1]];


(* ::Text:: *)
(*Products of Schur polynomials can be expanded into sums if the # of variables in both are the same; for Schur functions, the # of variables returned is the minimal # needed to avoid loss of terms, so max[ v,  \[ScriptL](\[Lambda])+\[ScriptL](\[Mu]) ].*)


(* ::Input::Initialization:: *)
schurProd2Sum0[ss[\[Lambda]_?Partition1Q,v_],ss[\[Mu]_?Partition1Q,v_]]:=Tr[(LRRule[\[Lambda],\[Mu]] /. q:{__Integer}->ss[q,Max[v,Length[\[Lambda]]+Length[\[Mu]]]])];


(* ::Text:: *)
(*for LRRule, see section "Littlewood-Richardson" below.*)


(* ::Input::Initialization:: *)
schurProd2Sum1[expr_] := Expand[Expand[expr] /. {ss[\[Lambda]_, v_Integer]^(e_ /; e > 1) :> 
       ss[\[Lambda], v]^(e - 2)*schurProd2Sum0[ss[\[Lambda], v], ss[\[Lambda], v]], ss[\[Lambda]_, v_Integer]*ss[\[Mu]_, v_] :> 
      schurProd2Sum0[ss[\[Lambda], v], ss[\[Mu], v]]}]; 


(* ::Input::Initialization:: *)
schurProd2Sum[expr_] := FixedPoint[schurProd2Sum1, expr]; 


(* ::Input::Initialization:: *)
e2p[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[threadSP[ee[\[Lambda],v],ee]/. ee->e2p],pp]


(* ::Input::Initialization:: *)
e2h[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[threadSP[ee[\[Lambda],v],ee]/. ee->e2h],hh]


(* ::Input::Initialization:: *)
p2e[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[threadSP[pp[\[Lambda],v],pp]/. pp->p2e],ee]


(* ::Input::Initialization:: *)
p2h[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[threadSP[pp[\[Lambda],v],pp]/. pp->p2h],hh]


(* ::Input::Initialization:: *)
h2e[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[threadSP[hh[\[Lambda],v],hh]/. hh->h2e],ee]


(* ::Input::Initialization:: *)
h2p[\[Lambda]_?Partition1Q,v_Integer]:=unthreadSP[Expand[threadSP[hh[\[Lambda],v],hh]/. hh->h2p],pp]


(* ::Input::Initialization:: *)
h2m[\[Lambda]_?Partition1Q,v_Integer]:=Expand[unthreadSP[Expand[threadSP[hh[\[Lambda],v],hh]/.hh->h2e],ee]/.ee->e2m]


(* ::Input::Initialization:: *)
p2m[\[Lambda]_?Partition1Q,v_]:=Expand[p2e[\[Lambda],v]/. ee->e2m]


(* ::Input::Initialization:: *)
e2s[\[Lambda]_?Partition1Q,v_]:=Expand[e2p[\[Lambda],v]/. pp->p2s]


(* ::Input::Initialization:: *)
m2p[\[Lambda]_?Partition1Q,v_]:=Expand[m2e[\[Lambda],v]/. ee->e2p]


(* ::Input::Initialization:: *)
m2h[\[Lambda]_?Partition1Q,v_]:=Expand[m2e[\[Lambda],v]/. ee->e2h]


(* ::Input::Initialization:: *)
f2m[\[Lambda]_?Partition1Q,v_]:=m2e[\[Lambda],v]/.ee->h2m //Expand;
f2h[\[Lambda]_?Partition1Q,v_]:=m2e[\[Lambda],v]/.ee->hh //Expand;f2e[\[Lambda]_?Partition1Q,v_]:=m2e[\[Lambda],v]/.ee->h2e//Expand;f2p[\[Lambda]_?Partition1Q,v_]:=m2e[\[Lambda],v]/.ee->h2p //Expand;f2s[\[Lambda]_?Partition1Q,v_]:=m2e[\[Lambda],v]/.ee->h2s //Expand;


(* ::Input::Initialization:: *)
m2f[\[Lambda]_?Partition1Q,v_]:=m2h[\[Lambda],v]/.hh->h2f //Expand;
h2f[\[Lambda]_?Partition1Q,v_]:=e2m[\[Lambda],v]/.mm->ff //Expand;e2f[\[Lambda]_?Partition1Q,v_]:=h2m[\[Lambda],v]/.mm->ff//Expand;p2f[\[Lambda]_?Partition1Q,v_]:=p2h[\[Lambda],v]/.hh->h2f //Expand;s2f[\[Lambda]_?Partition1Q,v_]:=s2h[\[Lambda],v]/.hh->h2f//Expand;


(* ::Input::Initialization:: *)
f[\[Lambda]_?Partition1Q,v_]:=f2e[\[Lambda],v]/.ee->e//Expand;


(* ::Subsection::Closed:: *)
(*Character Table of Subscript[S, n]*)


(* ::Input::Initialization:: *)
cycleclasses[(p_)?Partition1Q] := (Tr[p]!/Times @@ #1 & )[(#1!*Range[Tr[p]]^#1 & )[
    Function[par, (Count[par, #1] & ) /@ Range[Tr[p]]][p]]];


(* ::Input::Initialization:: *)
cycleclasses[n_Integer] := (n!/Times @@ #1 & ) /@ (#1!*Range[n]^#1 & ) /@ 
     Function[par, (Count[par, #1] & ) /@ Range[n]] /@ Partitions[n]; 


(* ::Input::Initialization:: *)
w2[0]:=1;w2[n_?Negative]:=0;
w2[n_Integer]:=Coefficient[Series[Exp[Sum[s2[k]t2^k /k,{k,n}]],
{t2,0,n}],t2^n]//Expand;


(* ::Input::Initialization:: *)
schur2[(par_)?Partition1Q] := 
  Expand[Tr[par]!*Det[Table[w2[par[[i]] - i + j], {i, Length[par]},
 {j, Length[par]}]]];


(* ::Input::Initialization:: *)
chars[(par_)?Partition1Q] := chars[par] = Block[{u1, u2}, 
     u1 = schur2[par] //. s2[j_]^(e_:1) :> s2[Sequence @@ Table[j, {e}]] //. 
        s2[i__]*s2[j__] :> s2[i, j]; 
      u2 = Rest[CoefficientList[u1 /. s2[pa__] :> 
p^rankpartition[Reverse[Sort[{pa}]]], p]]; 
      u2/cycleclasses[Tr[par]]]; 


(* ::Input::Initialization:: *)
 <<"http://users.telenet.be/Wouter.Meeussen/charList.txt"


(* ::Subsection::Closed:: *)
(*Littlewood-Richardson*)


(* ::Text:: *)
(*Based on http://sporadic.stanford.edu/bump/match/weight/lwr.m*)
(*Copyright 1996 by Daniel Bump (bump@math.stanford.edu)*)
(*but modified to improve speed.*)


(* ::Text:: *)
(*In this package, it is implemented as 'schurProd2Sum' in a similar way as 'monomProd2Sum'.*)


(* ::Input::Initialization:: *)
grow3[par_,q_]:=Block[{g1,g2,g3},g1=Nest[Union@Flatten[grow /@#,1]&,{par},q];
g2=(#-PadRight[TransposePartition@par,Length[#]])&/@TransposePartition/@g1;
g3=DeleteCases[g2,{___,k_,___}/;k>1];
TransposePartition[PadRight[TransposePartition@par,Length[#]]+#]&/@g3];


(* ::Input::Initialization:: *)
growList3[li_List,m_Integer]:=Flatten[Function[q,Join[q,{#}]&/@grow3[Last[q],m]]/@li,1];


(* ::Input::Initialization:: *)
LRWord[t_]:=Join@@Table[Join@@Table[Table[j-1,{PartitionEval[t[[j]],i]-PartitionEval[t[[j-1]],i]}],{j,Length[t],2,-1}],{i,1,Length[t[[-1]]]}];


(* ::Input::Initialization:: *)
PartitionEval[p_,i_]:=If[i<=Length[p],p[[i]],0];


(* ::Text:: *)
(*modif for {} element 2016/09/04 :*)


(* ::Input::Initialization:: *)
LRRule[\[Lambda]_?Partition1Q,{}]:={\[Lambda]}; LRRule[{},\[Mu]_?Partition1Q]:={\[Mu]};LRRule[\[Lambda]_?Partition1Q,\[Mu]_?Partition1Q]:=Last/@(Fold[Select[growList3[#1,#2],latticewordQ[LRWord[#]]&]&,{{\[Lambda]}},\[Mu]]);


(* ::Input::Initialization:: *)
cLR[\[Lambda]_?PartitionQ,\[Mu]_?PartitionQ,\[Nu]_?PartitionQ]:= If[Tr[\[Lambda]]=!=Tr[\[Mu]]+Tr[\[Nu]],0,Count[LRRule[\[Mu],\[Nu]],\[Lambda]]];


(* ::Subsection::Closed:: *)
(*Inproduct*)


(* ::Text:: *)
(*enter as esc < esc and esc > esc*)


(* ::Input::Initialization:: *)
Clear[AngleBracket];
AngleBracket[u_,v_+w_]:=AngleBracket[u,v]+AngleBracket[u,w];
AngleBracket[u_+v_,w_]:=AngleBracket[u,w]+AngleBracket[v,w];
AngleBracket[a_ u_,v_]/;Element[a,Rationals]:=a AngleBracket[u,v];
AngleBracket[u_,a_ v_]/;Element[a,Rationals]:=a AngleBracket[u,v];


(* ::Input::Initialization:: *)
AngleBracket[0,_]:=0;AngleBracket[_,0]:=0;


(* ::Input::Initialization:: *)
\[LeftAngleBracket]u_[\[Lambda]_?Partition1Q,d_],v_[\[Mu]_?Partition1Q,d_]\[RightAngleBracket] :=Block[{w=Tr[\[Lambda]],h0,m0,vech,vecm},If[Tr[\[Mu]]=!=w,Return[0]];
vech=ToExpression[StringTake[ToString[u],1]<>"2h"][\[Lambda],d]/. h2h->hh/. hh[par_,_]:>h0^rankpartition[par];
vecm=ToExpression[StringTake[ToString[v],1]<>"2m"][\[Mu],d]/. m2m->mm/. mm[par_,_]:>m0^rankpartition[par];(hvec=Rest@PadRight[CoefficientList[vech,h0],1+PartitionsP[w]]).(mvec=Rest@PadRight[CoefficientList[vecm,m0],1+PartitionsP[w]])];


(* ::Subsection::Closed:: *)
(*skewschur, skewSYT and skewSSYT*)


(* ::Text:: *)
(*skewschur modified # of variables from Max[Length[\[Lambda]],Length[\[Mu]]] to Tr[\[Lambda]]-Tr[\[Mu]] on 01/02/2015.*)
(*Determinant size set to v0 i.s.o. v on 13/08/2015.*)


(* ::Input::Initialization:: *)
skewschur[\[Lambda]_?PartitionQ,\[Mu]_?PartitionQ,v1_:0] :=Block[{v,v0},If[Not[majorsweak[\[Lambda],\[Mu]]],Return[0]];v=Max[v1,Tr[\[Lambda]]-Tr[\[Mu]]];v0=Max[Length[\[Lambda]],Length[\[Mu]]];Expand[unthreadSP[Det@Table[hh[PadRight[\[Lambda],v0][[i]]-PadRight[  \[Mu] ,v0][[j]]-i+j,v],{i,v0},{j,v0}],hh] /. hh->h2s]];


(* ::Input::Initialization:: *)
skewschur2[\[Lambda]_?PartitionQ,\[Mu]_?PartitionQ]:=Block[{v,v0,\[Lambda]tr,\[Mu]tr},
If[!majorsweak[\[Lambda],\[Mu]],Return[0]];
v=Tr[\[Lambda]]-Tr[\[Mu]];
v0=Max[First[\[Lambda]],First[\[Mu]]];\[Lambda]tr =PadRight[TransposePartition[ \[Lambda]],v0];\[Mu]tr =PadRight[TransposePartition[ \[Mu]],v0];Expand[unthreadSP[Det@Table[ee[\[Lambda]tr[[i]]-\[Mu]tr[[j]]-i+j,v],{i,v0},{j,v0}]/.ee->e2p,pp]  /. pp->p2s]];


(* ::Input::Initialization:: *)
showskew[\[Lambda]_,\[Mu]_]:=If[majorsweak[\[Lambda],\[Mu]],{Table[1- Boole[i<=Length[\[Mu]]&&j<=\[Mu][[i]]],{i,Length[\[Lambda]]},{j,\[Lambda][[i]]}]/. 1->"x"}//tableauxForm,{}];


(* ::Input::Initialization:: *)
skewSYT[\[Lambda]_, \[Mu]_] /; majorsweak[\[Lambda], \[Mu]] := Block[{a1, a2, a3, a4}, 
   a1 = Rest /@ Position[Nest[Map[trim, #1, {-2}] /. 
          q:{__Integer} /;  !majorsweak[q, \[Mu]] -> {} & , {\[Lambda]}, Tr[\[Lambda]] - Tr[\[Mu]]], \[Mu]]; 
    a2 = (FoldList[trim[#1][[#2]] & , \[Lambda], #1] & ) /@ a1; 
    a3 = -Differences /@ Map[PadRight[#1, Length[\[Lambda]]] & , a2, {-2}]; 
    a4 = Map[Range[Length[\[Lambda]]] . #1 & , a3, {-2}]; 
 (Block[{it, w}, it = 0*Range /@ PadRight[\[Mu], Length[\[Lambda]]]; w = 1; 
         Fold[MapAt[Flatten[{#1, w++}] & , #1, {#2}] & , it, Reverse[#1]]] & ) /@ a4]


(* ::Input::Initialization:: *)
countSkewSYT[\[Lambda]_?Partition1Q,\[Alpha]_?Partition1Q]/; majorsweak[\[Lambda],\[Alpha]]:=skewschur[\[Lambda],\[Alpha]]/. ss[q_,_]:> NumberOfTableaux[q];


(* ::Input::Initialization:: *)
skewSSYT[\[Lambda]_?Partition1Q,\[Mu]_?Partition1Q,v_Integer]/;majorsweak[\[Lambda], \[Mu]]:=Reverse@Block[{a1,a2,a3},If[v<Length[\[Lambda]]-Length[\[Mu]],Return[{}]];
a1=Transpose[{TransposePartition[\[Lambda]],TransposePartition[\[Lambda]]-PadRight[TransposePartition[\[Mu]],First[\[Lambda]]]}];
a2=Function[a,PadLeft[#,First@a]&/@KSubsets[Range[v],Last@a]]/@a1;If[First[\[Lambda]]===1,Return[Flatten[Map[List,a2,{-1}],1]]];
a3=Backtrack[a2,(Min[Min/@Differences[Transpose[PadRight[{#},Automatic,999]]]]>=0)&,True&,All];
DeleteCases[Transpose[PadRight[#,Automatic,999]],999,-1]&/@a3];


(* ::Text:: *)
(*modif 2016/12/04  " Return[Flatten[a2,1]]] " -> " If[First[\[Lambda]]===1,Return[List/@Flatten[a2,1]]] " and order reversed to make SSYT[ { n } , n ] equal to skewSSYT[ { n } , { } , n] *)


(* ::Input::Initialization:: *)
countSkewSSYT[\[Lambda]_?Partition1Q,\[Mu]_?Partition1Q,v_Integer]:=If[!majorsweak[\[Lambda],\[Mu]],0,skewschur[\[Lambda],\[Mu]]/. ss[a_,_]:>stanley[a,v]];


(* ::Input::Initialization:: *)
skewredu1[\[Lambda]_,\[Mu]_]/;majorsweak[\[Lambda],\[Mu]]:=Delete[#,List/@DeleteCases[Table[i Boole[\[Lambda][[i]]==\[Mu][[i]]],{i,Length[\[Mu]]}],0]]&/@{\[Lambda],\[Mu]};
skewredu[\[Lambda]_,\[Mu]_]/;majorsweak[\[Lambda],\[Mu]]:=TransposePartition/@Apply[skewredu1,TransposePartition/@skewredu1[\[Lambda],\[Mu]]];


(* ::Input::Initialization:: *)
skewfactor[\[Lambda]1_,\[Mu]1_]/;majorsweak[\[Lambda]1,\[Mu]1]:=Block[{a1,a2,a3,\[Lambda],\[Mu]},{\[Lambda],\[Mu]}=skewredu[\[Lambda]1,\[Mu]1];a1=Apply[Join,Table[{i,j},{i,Length[\[Lambda]]},{j,\[Lambda][[i]],\[Lambda][[Min[i+1,Length[\[Lambda]]]]],-1}]];
a2=Map[{First[#],First[#]>Length[\[Mu]]||\[Mu][[First[#]]]<#[[2]]}&,a1];a3=Map[First,DeleteCases[SplitBy[a2,MatchQ[#,{_,False}]&],{{_,False}}],{2}];
Partition[Flatten[skewredu[Part[\[Lambda],#],Part[PadRight[\[Mu],Length[\[Lambda]],0],#]/.0->Sequence[]]&/@Map[Union,a3],1],2]];


(* ::Input::Initialization:: *)
rectify[{{}}]:={{}};rectify[\[Zeta] : {__List}] /; PartitionQ[Length /@ \[Zeta]] := First[wordToTableaux[DeleteCases[Flatten[Reverse[\[Zeta]]], 0]]];


(* ::Subsection::Closed:: *)
(*t - core and t - quotients*)


(* ::Text:: *)
(* credit to William J. Keith (Michigan Tech University Math Department) for guiding me in the study of t-core and t-quotients*)


(* ::Input::Initialization:: *)
toEdge[{}]:={0};
toEdge[par_?PartitionQ]:=Reverse[Flatten[(par-PadRight[Rest[par],Length[par]])/. i_Integer:>{1, 0*Range@i}]];


(* ::Input::Initialization:: *)
fromEdge[{}]:={};fromEdge[{1 ...,0 ...}]:={};
fromEdge[{1 ..,q__}]:=fromEdge[{q}];
fromEdge[{q__,0 ..}]:=fromEdge[{q}];
fromEdge[edge:{0,(1|0)...,1}]:=DeleteCases[Reverse[Rest[FoldList[Plus,0,Reverse[Count[#,0]&/@Split[Reverse@edge, FreeQ[#2,1]&]]]]],0];


(* ::Input::Initialization:: *)
coredecompose[\[Lambda]_?PartitionQ,d_Integer]:=Block[{temp,it},temp=Transpose[Partition[toEdge[\[Lambda]],d,{d},1,0]]; fromEdge/@Join[{Flatten[it=Transpose[Reverse[Sort[#]]&/@ temp]] },
 RotateLeft[temp,-1+Position[it,0,2,1][[1,2]]]  ]];


(* ::Input::Initialization:: *)
core[\[Lambda]_?PartitionQ,d_Integer]:=Block[{temp},temp=Transpose[Partition[toEdge[\[Lambda]],d,{d},1,0]]; fromEdge@Flatten[Transpose[Reverse[Sort[#]]&/@ temp]]  ];


(* ::Input::Initialization:: *)
corerecompose[{cor_?Partition1Q,quot__?Partition1Q}]:=Block[{d=Length[{quot}],beg,try,le,ri,x},d=Length[{quot}];beg=Transpose[Partition[toEdge@cor,d,{d},1,0]];
try=toEdge/@{quot};
le=Max[Tr/@try-Tr/@beg]-(Tr/@try-Tr/@beg);
ri=Max[Length/@try-Tr/@try+Tr/@beg]-(Length/@try-Tr/@try+Tr/@beg);
fromEdge@Flatten[Transpose[PadRight[Thread[x[try,le+Length/@try,1]]/. x->PadLeft]]]
];


(* ::Subsection::Closed:: *)
(*RSK correspondence *)


(* ::Text:: *)
(*(Robinson\[Dash]Schensted\[Dash]Knuth correspondence)*)
(*built-in functions require a permutation resp. a Standard YT as argument(s).*)
(*This restriction is bypassed in this section. *)
(*alternative functions :  wordToTableaux and tableauxToWord*)


(* ::Input::Initialization:: *)
?PermutationToTableaux


(* ::Input::Initialization:: *)
?TableauxToPermutation


(* ::Input::Initialization:: *)
plug[t_List,x_]:=Block[{head,bump,po,t1=t}, po=Flatten[Position[Thread[head[t1,x]]/. head->Order,-1,1,1]];
If[po==={},Return[{t1=Flatten[{t1,x}],{}}],{bump}=t1[[po]];t1=ReplacePart[t1,First[po]->x];{t1,bump}]];


(* ::Input::Initialization:: *)
ins[t:{__List},x1_]:=Block[{row=1,new,t2=First[t],t3=Last[t],x=x1},
While[row<= Length[t2]&& x=!= {},{new,x}=plug[t2[[row]],x];
t2=ReplacePart[t2,row->new];row++];If[x==={}, {t2,Append[t3,row-1]},{Append[t2,{x}],Append[t3,Length[t2]+1]}]];


(* ::Input::Initialization:: *)
wordToTableaux[str_List]:=Block[{tem},{First@#,tem=0;Fold[If[tem++;#2>Length[#1],Append[#1,{tem}],MapAt[Append[#,tem]&,#1,#2]]&,{{}},Last@#]}&@Fold[ins,{{}},str]];


(* ::Input::Initialization:: *)
deleteFromTableau2[t1_,r_Integer]:=Module[{t=t1,col,row,item=Last[t1[[r]]]},col=Length[t[[r]]];If[col==1,t=Drop[t,-1],t[[r]]=Drop[t[[r]],-1]];Do[While[Not[OrderedQ[{item,t[[row,col]]}]]&&Length[t[[row]]]>col,col++];If[OrderedQ[{item,t[[row,col]]}],col--];{item,t[[row,col]]}={t[[row,col]],item},{row,r-1,1,-1}];t];


(* ::Input::Initialization:: *)
tableauxToWord[p1_,q1_]:=Module[{p=p1,q=q1,row,firstrow},Reverse[Table[firstrow=First[p];row=Position[q,Max[q]][[-1,1]];p=deleteFromTableau2[p,row];q[[row]]=Drop[q[[row]],-1];If[p=={},First[firstrow],Select[Transpose[PadRight[{firstrow,First[p]}]],Unequal@@#&,1][[1,1]]],{Plus@@Map[Length,p1]}]]]/;Map[Length,p1]===Map[Length,q1];


(* ::Text:: *)
(*Motivation:*)
(*the Jeu-de Taquin equivalence (https://en.wikipedia.org/wiki/Jeu_de_taquin)  of skewSYT or skewSSYT to rectify  SYT resp. SSYT uses the RSK algorithm to convert the reading word of the Tableau (bottom up, left to right) in to a tableaux-pair, the insersion tableau being the rectification of the skew input tableau.*)


(* ::Text:: *)
(*The LR-coefficient of Subscript[s, \[Nu]] in Subscript[s, \[Lambda]/\[Mu]] equals the number of skew tableaux of shape \[Lambda]/\[Mu] that are Jeu-de-Taquin equivalent to any SYT of shape \[Nu].*)


(* ::Input::Initialization:: *)
schutzDual[t:{{___}..}]:= Block[{n},n=Count[t,_Integer,{2}];rectify[Reverse[n+1-PadRight[t],{1,2}]/. n+1->0]];