(* HookUtils.m ---------------------------------------------------------- *)


(* WPx[] ---------------------------------------------------------------- *)

(* Given a poset P, computes the polynomial WP(x) using the given inverse
	extensions program and returns the list of its coefficients. *)

(* Must be run within GenWPx.nb for the variable invrsex[*] and for the 
	equations from stdisos* and lookups*, which are needed for the inverse
	extensions program. *)

WPx[ppst_,IEpgrm_] := Module[{z},
	CoefficientList[
		Apply[Plus,                                    (* Adds powers of z. *)
			Map[Function[x,
				z^(Apply[Plus,               (* Adds doubled descent indices. *)
					Map[
						((Sign[x[[#]]-x[[#+1]]]+1)*#)&,  (* Doubles desc posits *)
						Range[Length[x]-1]         (* Potential descent posits. *)
					]
				]/2)     (* Removes doubling. *)
			],IEpgrm[ppst]]
		]
	,z]
];




(* HookQ[] -------------------------------------------------------------- *)

(* Given the polynomial WP(x) for a poset P with np elements, determines if
	P is hook length [evenly divides and result has np factors (1-x^* )]and 
	returns list of hooks, *, if it is; otherwise returns the empty set. *)

HookQ[np_,wpxcffs_] := Module[{remaing, z, hooks={}},
	remaing = Cancel[
		Product[(1-z^ik),{ik,np}]/
		Apply[Plus,Map[wpxcffs[[#]]*z^(#-1)&,Range[Length[wpxcffs]]]]
	];
	
	If[ !PolynomialQ[remaing], Return[{}] ];

	Do[
		While[ PolynomialQ[temp=Cancel[remaing/(1-z^jp)]],
			remaing = temp;
			PrependTo[hooks,jp]
		]
	,{jp,np,1,-1}];

	Which[
		remaing \[NotEqual] 1,
		Return[{}],
		remaing \[Equal] 1,
		Return[hooks]
	]
];





(* DirectSm[] ----------------------------------------------------------- *)

(* Forms the direct sum of two given posets. *)

DirectSm[pstaa_,pstbb_] := Join[ pstaa, Map[(#+Length[pstaa])&,pstbb] ];





(* GaussCoeff[] --------------------------------------------------------- *)

(* Forms a specific polynomial in the variable q. *)

GaussCoeff[q_,aa_,bb_] :=
	Cancel[
		Product[(1-q^kg),{kg,aa}]/
		Product[(1-q^ig),{ig,bb}]/
		Product[(1-q^jg),{jg,aa-bb}]
	];  





(* ToPolyn[] ------------------------------------------------------------ *)

(* Forms the polynomial in q with the coefficients given in cflst. *) 

ToPolyn[cflst_,q_] :=
	Apply[Plus,
		Map[
			cflst[[#]]*q^(#-1)&,
			Range[ Length[cflst] ]
		]
	];




(* InvStdTab[] ---------------------------------------------------------- *)

(* Finds all inverse extensions of a convex subset of a poset.  Needs 
	auxiliary data stored in global variables. *)

InvStdTab[pstt_,cxst_] := Module[{nc=Length[cxst],shrnk},
	shrnk = ShrnkCnvxSt[pstt,cxst];
	ReplaceAll[
		Map[
			Function[x,
				Map[ Ordering[s[shrnk]][[#]]&, x ]
			],
			invrsex[nc][[ m[Relabl[shrnk,Ordering[s[shrnk]]]] ]]
		],
		Map[ (#\[Rule]cxst[[#]])&, Range[nc] ]
	]
];