(* PosetUtils.m --------------------------------------------------------- *)


(* Ideel[] -------------------------------------------------------------- *)

(* Finds the ideal of ppst generated by generatrs.  Elements appear in 
	increasing order. *)

Ideel[ppst_,generatrs_] := Ideel[ppst,generatrs] =
	Union[ generatrs, Flatten[Map[Ideel[ppst,ppst[[#]]]&,generatrs]] ]; 



(* AntiChnsIdls[] ------------------------------------------------------- *)

(* Finds all antichains of poseet and their corresponding ideals.  Elements 
	appear in increasing order. *)

AntiChnsIdls[poseet_] := Module[{antchns={{}},thrdscnds={{}}},
	Do[
		Do[
			(* If an element of poseet is not a child of any elt in the current
				antichain and if none of the elemnts in the antichain are 
				descendants of this element, we add this element to the 
				antichain to obtain a new antichain. *)
			If[!MemberQ[ig,thrdscnds[[jp]]] &&
				Intersection[antchns[[jp]],Ideel[poseet,{ig}]] \[Equal] {},
				AppendTo[ antchns, Append[antchns[[jp]],ig] ];
				AppendTo[ thrdscnds, Union[thrdscnds[[jp]],Ideel[poseet,{ig}]] ]
			]                                                 
		,{jp,Length[antchns]}];
	,{ig,Length[poseet]}];
	{antchns,thrdscnds}
];



(* PllOff[] ------------------------------------------------------------- *)

(* Pulls off an ordered list idal of elts of an ideal from the poset labpst,
	which is in labeled child form. *)

PllOff[labpst_,idal_] :=
	Map[
		Function[x,
			MapAt[ Select[#,!MemberQ[idal,#]&]&, x, {1} ]
		],
		Select[ labpst, !MemberQ[idal,#[[2]]]& ]
	];


(* Relabl[] ------------------------------------------------------------- *)

(* Relabels the black child form pst according to the yellow-to-black 
	inverse extension inv. *)

Relabl[pst_,inv_] :=
	Map[                      (* Apply x-function to each black element x. *)
		Function[x, 
			Sort[                         (* Child lists must be increasing. *)
				Map[                                 (* Apply yel relabelling *)
					Ordering[inv][[#]]&,
					pst[[x]]                      (* to each black child list. *)
				]                                            (* End for Map[. *)
			]                                              (* End for Sort[. *)
		],                                           (* End for Function[x. *) 
		inv                       (* Yellow-indexed list of black elements. *)
	];



(* NewChdLst[] ---------------------------------------------------------- *)

(* Given black ppst and an initial yellow-indexed list partlseq, produces
	the yellow child list for the newest yellow element. *)

NewChdLst[ppst_,partlseq_] :=
	Sort[Flatten[     (* Get rid of extra {}'s and order yellow children. *)
                           (* Find yellow position for each black child. *)
		Map[ Position[partlseq,#]&,
                           (* Black child list of the newest yellow elt. *)
			ppst[[ partlseq[[-1]] ]]
		]                                                      
	]];



(* ShrnkCnvxSt[] -------------------------------------------------------- *)

(* Takes a poset ppst and a list of elements in a convex subset cnvx
	and returns the child form of cnvx with new consecutive labels which 
	start with 1.  The inverse relabelling rule is also cnvx! *)

ShrnkCnvxSt[ppst_,cnvx_] :=
	ReplaceAll[
		Map[
			Select[#,MemberQ[cnvx,#]&]&,
			Map[ppst[[#]]&,cnvx]
		],
		Map[ (cnvx[[#]]\[Rule]#)&, Range[Length[cnvx]] ]
	];


(* InvStdTblx[] --------------------------------------------------------- *)

(* Finds all inverse order extensions of the convex subset cxst of posst,
	using the specified inverse extension program IEpgrm. *)

InvStdTblx[posst_,cxst_,IEpgrm_] :=
	ReplaceAll[
		IEpgrm[ShrnkCnvxSt[posst,cxst]],
		Map[ (#\[Rule]cxst[[#]])&, Range[Length[cxst]] ]
	];