Help := proc() if args=NULL then print(`Procedures for a general poset:`); print(`HasseToPoset(H), IsLattice(P)`); print(`Up(a,P), Down(a,P), Interval(a,b,P)`); print(`Meet(a,b,P), Join(a,b,P)`); print(``); print(`Procedures for the subset lattice:`); print(`BooleanPoset(n), UpBool(S,n), DownBool(S), IntervalBool(S1,S2)`); print(`MeetBool(S1,S2), JoinBool(S1,S2)`); print(``); print(`The data structure for a poset is a set of lists of length 2.`); print(`These lists form the partial order. The first element is less`); print(`than or equal to the second element.`); print(``); print(`For help on a specific procedure type Help().`); else if args = HasseToPoset then print(`HasseToPoset(H)`); print(`Inputs:`); print(`H - The Hasse diagram for a poset P (ie- the cover`); print(` relations) in the form of a set of lists of length`); print(` two in which the first element is the smaller and `); print(` the second element is the larger one.`); print(`Outputs:`); print(` The poset, P, for which H is the hasse diagram. This`); print(` is a set of lists of length two as above, but includes`); print(` the transitive relations. For example, if [a,b] and [b,c]`); print(` are in H then [a,c] will be in P.`); elif args = IsLattice then print(`IsLattice(P)`); print(`Inputs:`); print(` P - a poset`); print(`Outputs:`); print(` true if P is a Lattice, and false if P is not a lattice.`); print(` If P is not a lattice then this procedure also prints `); print(` out the bad set (the set of pairs which don't have a`); print(` unique meet or join as well as "meet" or "join" `); print(` accordingly).`); elif args = Up then print(`Up(a,P):`); print(`Inputs:`); print(` a - an element of the poset P`); print(` P - a poset`); print(`Outputs:`); print(` The set of elements greater than or equal to a in P`); elif args = Down then print(`Down(a,P):`); print(`Inputs:`); print(` a - an element of the poset P`); print(` P - a poset`); print(`Outputs:`); print(` The set of elements less than or equal to a in P`); elif args = Interval then print(`Interval(a,b,P):`); print(`Inputs:`); print(` a - an element of the poset P`); print(` b - an element of the poset P`); print(` P - a poset`); print(`Outputs:`); print(` The set of elements greater than or equal to a and `); print(` less than or equal to b in P`); elif args = Meet then print(`Meet(a,b,P)`); print(`Inputs:`); print(` a - an element of the poset P`); print(` b - an element of the poset P`); print(` P - a poset`); print(`Outputs:`); print(` The largerst element less than both a and b in P.`); print(` If P is not a lattice and the intersection of the `); print(` set of elements less than a with the set of elements`); print(` less than b has multiple greatest elements then this`); print(` procedure outputs the set of greatest elements.`); elif args = Join then print(`Join(a,b,P)`); print(`Inputs:`); print(` a - an element of the poset P`); print(` b - an element of the poset P`); print(` P - a poset`); print(`Outputs:`); print(` The least element greater than both a and b in P.`); print(` If P is not a lattice and the intersection of the `); print(` set of elements greater than a with the set of elements`); print(` greater than b has multiple least elements then this`); print(` procedure outputs the set of least elements.`); fi;fi; end: with(combinat): #===================================================== #HasseToPoset(H) #Inputs: # H - The Hasse diagram for a poset P (ie- the cover # relations) in the form of a set of lists of length # two in which the first element is the smaller and # the second element is the larger one. #Outputs: # The poset, P, for which H is the hasse diagram. This # is a set of lists of length two as above, but includes # the transitive relations. For example, if [a,b] and [b,c] # are in H then [a,c] will be in P. HasseToPoset := proc(H,S) local P,P1,pair,smaller,larger,pair2,G; P := {}; P1 := H; while P1<>P do P := P union P1; for pair in P1 do smaller := pair[1]; larger := pair[2]; for pair2 in P do if pair2[1]=larger then P1 := P1 union {[smaller,pair2[2]]}; fi; od; od; od; P := P union {seq([s,s],s in S)}; RETURN(P); end: #===================================================== #BooleanPoset(n) #Inputs: # n - a positive integer #Outputs: # The poset of all subsets of {1,2,...,n} with the subset # ordering, ie- S11 then Bad := Bad union {[`join`,a,b]}; #print(`join`,a,b,Join(a,b,P)); #RETURN(false); fi; if nops(Meet(a,b,P))<>1 then Bad := Bad union {[`meet`,a,b]}; #print(`meet`,a,b,Meet(a,b,P)); #RETURN(false); fi; od; od; if nops(Bad)>0 then print(Bad); RETURN(false); else RETURN(true); fi; end: #===================================================== #Up(a,P): #Inputs: # a - an element of the poset P # P - a poset #Outputs: # The set of elements greater than or equal to a in P Up := proc(a,P) local p,U; U := {a}; for p in P do if p[1]=a then U := U union {p[2]}; fi; od; RETURN(U); end: #----------------------------------------------------- UpBool := proc(S1,n) local toAdd; toAdd := powerset({seq(i,i=1..n)} minus S1); RETURN({seq(S1 union ta, ta in toAdd)}); end: #===================================================== #Down(a,P): #Inputs: # a - an element of the poset P # P - a poset #Outputs: # The set of elements less than or equal to a in P Down := proc(a,P) local p,DD; DD := {a}; for p in P do if p[2]=a then DD := DD union {p[1]}; fi; od; RETURN(DD); end: #----------------------------------------------------- DownBool := proc(S1) local toSubt; toSubt := powerset(S1); RETURN({seq(S1 minus ts, ts in toSubt)}); end: #===================================================== #Join(a,b,P) #Inputs: # a - an element of the poset P # b - an element of the poset P # P - a poset #Outputs: # The least element greater than both a and b in P. # If P is not a lattice and the intersection of the # set of elements greater than a with the set of elements # greater than b has multiple least elements then this # procedure outputs the set of least elements. Join := proc(a,b,P) local aUp,bUp,abUp,J,c,p; aUp := Up(a,P); bUp := Up(b,P); abUp := aUp intersect bUp; #print(abUp); J := abUp; for c in abUp do for p in P do if p[2]=c then if p[1] in abUp and p[1] <> c then #print(c,p,J); J := J minus {c}; fi; fi; od; od; RETURN(J); end: #----------------------------------------------------- JoinBool := proc(S1,S2) RETURN(S1 union S2); end: #===================================================== #Meet(a,b,P) #Inputs: # a - an element of the poset P # b - an element of the poset P # P - a poset #Outputs: # The largerst element less than both a and b in P. # If P is not a lattice and the intersection of the # set of elements less than a with the set of elements # less than b has multiple greatest elements then this # procedure outputs the set of greatest elements. Meet := proc(a,b,P) local aDn,bDn,abDn,J,c,p; aDn := Down(a,P); bDn := Down(b,P); abDn := aDn intersect bDn; #print(abUp); J := abDn; for c in abDn do for p in P do if p[1]=c then if p[2] in abDn and p[2] <> c then #print(c,p,J); J := J minus {c}; fi; fi; od; od; RETURN(J); end: #----------------------------------------------------- MeetBool := proc(S1,S2) RETURN(S1 intersect S2); end: #===================================================== #Interval(a,b,P): #Inputs: # a - an element of the poset P # b - an element of the poset P # P - a poset #Outputs: # The set of elements greater than or equal to a and # less than or equal to b in P Interval := proc(a,b,P) local ua,db; ua := Up(a,P); db := Down(b,P); RETURN(ua intersect db); end: #----------------------------------------------------- #IntervalBool(S1,S2) #Inputs: # S1,S2 - Two subsets of [n] (where n is thought of as # the largest element of S1 union S2 #Outputs: # The set of sets which are contained in S2 and contain S1 IntervalBool := proc(S1,S2) local R,pR; if not evalb(S1 subset S2) then RETURN({}); else R := S2 minus S1; pR := powerset(R); #print(R,pR); RETURN({seq(S1 union p,p in pR)}); fi; end: