(* Routine Poset Property Test Functions *)


(* ConnctdQ[] ----------------------------------------------------------- *)

(* Determines if the poset ppstt is connected. *)

ConnctdQ[ppstt_] := CnnctdQ[ppstt,{},{1}];
(* Builds connected component based at element 1.  New elements (nw) are 
	those connected to the elts known so far (sofar) to be in this 
	component. *)

CnnctdQ[ppstt_,sofar_,nw_ /; nw\[Equal]{}] :=
	False /; Length[sofar]< Length[ppstt];

CnnctdQ[ppstt_,sofar_,nw_ /; nw\[Equal]{}] :=
	True /; Length[sofar]\[Equal]Length[ppstt];

CnnctdQ[ppstt_,sofar_,nw_] := CnnctdQ[
	ppstt,
	Union[sofar,nw],
	Complement[
		Apply[
			Union,
			Map[
				Function[x,
					Union[
						ppstt[[x]],
						Map[#[[1]]&,Position[ppstt,x]]
					]
				],
				nw
			]
		],
		Union[sofar,nw]
	]
];



(* UniqMaxmlQ[] --------------------------------------------------------- *)

(* Returns True if and only if pssst has a unique maximal element. *)

UniqMaxmlQ[pssst_] := (Length[Apply[Union,pssst]]\[Equal]Length[pssst]-1);







(* dCompltQ[] ----------------------------------------------------------- *)

(* Determines if the poset poost is d-Complete. *)

dCompltQ[poost_] := Module[{nn=Length[poost],parnts,vbotts,dmndtops,
	tailbtm,necktop,tailexts,neckexts},

	(* Find the parents of each elt and quit if any has more than 2. *)
	parnts = Map[
		Map[#[[1]]&,#]&,
		Map[
			Position[poost,#]&,
			Range[nn]
		]
	];
	If[ Max[Map[Length[#]&,parnts]]>2, Return[False] ];

	(* Find all elts with exactly 2 parents (bottoms of v's) and quit if
		any two v-bottoms share both parents. *)
	vbotts = Select[ Range[nn], (Length[parnts[[#]]]\[Equal]2)& ];
	If[ !Apply[Unequal,Map[parnts[[#]]&,vbotts]], Return[False] ];

	(* Finds the top elts of any diamonds and quits if there is a v-bottom 
		that is not completed by a diamond top or if a diamond top covers 
		more than 2 elts. *)
	dmndtops = Map[
		Function[x,
			Apply[
				Intersection,
				Map[
					parnts[[#]]&,
					parnts[[x]]
				]
			]
		],
		vbotts
	];
	If[ Min[Map[Length[#]&,dmndtops]]<1, Return[False] ];
	If[ Max[Map[Length[poost[[#[[1]]]]]&,dmndtops]]>2, Return[False] ];

	(* Run through vbotts and move on if we cannot extend the tail.  If the 
		tail is extendable, we quit if there is more than one way to extend 
		the tail or if there's not exactly one free neck extension.   *)
	Do[
		tailbtm = vbotts[[ib]];
		necktop = dmndtops[[ib]][[1]];





		While[
			(tailexts = 
				Select[poost[[tailbtm]],(Length[parnts[[#]]]\[Equal]1)&] 
			) \[NotEqual] {},
			
			If[ Length[tailexts]>1, Return[Return[False]] ];

			neckexts = Select[ 
				parnts[[necktop]], 
				(Length[poost[[#]]]\[Equal]1)& 
			];
			
			If[ Length[neckexts]\[NotEqual]1, Return[Return[False]] ];
			
			necktop = neckexts[[1]];
			tailbtm = tailexts[[1]]
		]
	,{ib,Length[vbotts]}];
	
	True
];