\(\(\( (*\ 
      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 == {}]\  := 
	
        False\  /; \ Length[sofar] < \ Length[ppstt];\)


    \(CnnctdQ[ppstt_, sofar_, nw_\  /; \ nw == {}]\  := 
	
        True\  /; \ Length[sofar] == 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]] == 
            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[\([#]\)]] == 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[\([#]\)]] == 
                            
                            1)\) &]\ 
			)\)\  ≠ \ {}, 
			
			If[\ Length[tailexts] > 1, \ 
                Return[Return[False]]\ ]; 

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