3
$\begingroup$

In my thesis, I need to find all Up-sets of the set in the picture below using the order provided in the picture. I tried to code this problem with Mathematica but I can't find a nice and optimal algorithm. A definition of Up-set is given in this link:https://en.wikipedia.org/wiki/Upper_set. For instance in the first picture, green set is an up-set. because "for any element in this set such as x, all element that such as y, such that x<= y are is this set". I need to coding this definition to find all up-set for an arbitrary set with an arbitrary order.

enter image description here

enter image description here

$\endgroup$
  • $\begingroup$ You need to provide the ordering, so you'd need a directed graph. What are the T and inverted T supposed to denote? $\endgroup$ – Sjoerd C. de Vries Dec 13 '16 at 20:01
  • $\begingroup$ They are biggest and smallest element on order relation and we can replace a,b,c,d,e with 1,2,3,4,5. Actually thy are not comparable necessary. $\endgroup$ – Jamal Farokhi Dec 13 '16 at 20:12
5
$\begingroup$

I'm not sure whether I fully interpreted your initial drawing and description correctly, but would the following work for you?

Your set as a Graph:

g = Graph[{"T", 1, 2, 3, 4, 5, "⊥"}, 
          {"T" -> 1, "T" -> 2, "T" -> 3, 4 -> 1, 4 -> 2, 5 -> 2, 4 -> 3, 
            5 -> 3, 5 -> 1, 4 -> "⊥", 5 -> "⊥"}, 
          VertexLabels -> Placed["Name", Center], 
          VertexLabelStyle -> Directive[FontSize -> 32], 
          VertexCoordinates -> {{245, 446}, {103, 316}, {268, 313}, {409, 354}, 
                                {177, 227}, {383, 264}, {323, 93}}
    ]

Mathematica graphics

With this representation VertexComponent[g, #] & gives you the UpSet of the vertex you apply it on. So the lists of all UpSets is given by:

VertexComponent[g, #] & /@ VertexList[g]
(* {{"T"}, {1, "T", 4, 5}, {2, "T", 4, 5}, {3, "T", 4, 5}, {4}, {5}, {"⊥", 4, 5}} *)
$\endgroup$
2
$\begingroup$
set = Range[4]
subsets = Subsets[set];
rg = RelationGraph[SubsetQ[#1, #2] && Length[#1] == Length[#2] + 1 &, 
  subsets, VertexSize -> 0.7, VertexLabels -> Placed["Name", Center], 
  VertexLabelStyle -> Directive[Red, Bold], VertexStyle -> White]
upset[n_] := 
 Module[{sel = Select[VertexList[rg], MemberQ[#, n] &], 
   v = VertexList[rg], e = EdgeList[rg], com, h},
  com = Complement[v, sel];
  h = Thread[sel -> Green]~Join~Thread[com -> White];
  Graph[v, e, VertexCoordinates -> GraphEmbedding[rg], 
   VertexStyle -> h, VertexSize -> 0.7, 
   VertexLabels -> Placed["Name", Center], 
   VertexLabelStyle -> Directive[Red, Bold], ImageSize -> 600]
  ]

So finding upsets 1,2,3,4:

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.