# Finding maximal elements of partially ordered sets

I am dealing with partially ordered sets $\Gamma$, which I represent as directed graphs with an edge going from $a$ to $b$ if $a \leq b$ in $\Gamma$. For example the following graph,

\[CapitalGamma] = {2, 3, 5, 7, 6, 8, 10, 12, 24};
edges = Apply[DirectedEdge,Select[Tuples[\[CapitalGamma], 2],
Mod[#[], #[]] == 0 &], {1}];
Graph[\[CapitalGamma], edges, VertexLabels -> "Name"]


which looks like the following. This is the poset with elements $\{2, 3, 5, 7, 6, 8, 10, 12, 24\}$, ordered by division. In this set the maximal elements are $7,10$ and $24$. Is there some clever way in Mathematica to find a list of maximal elements directly from a graph?

• You can generate your graph with a one-liner: RelationGraph[Divisible, \[CapitalGamma]]. – Szabolcs Jan 22 '18 at 14:41

I'd do this:

Γ = {2, 3, 5, 7, 6, 8, 10, 12, 24};

g = SimpleGraph[RelationGraph[Divisible, Γ], VertexLabels -> "Name"]

sources[g_?GraphQ] := Pick[VertexList[g], VertexInDegree[g], 0]

sources[g]
(* {7, 10, 24} *)

• Someone might point out GraphComputationSourceVertexList, but it does exactly the same thing as sources above. IGraph/M also has IGSourceVertexList and IGSinkVertexList, implemented roughly this way. – Szabolcs Jan 22 '18 at 14:44

If you just want the maximal elements and don't need the graph, you could use InternalListMin. InternalListMin finds the minimal elements of a set of lists using a component-wise partial order (see (805)):

maximal[list_] := Module[{p, e},
p=FactorInteger[LCM@@list][[All, 1]];
e=IntegerExponent[#, p]& /@ list;
Sort @ Map[Times@@(p^#)&] @ -InternalListMin[-e]
]


maximal[{2,3,5,7,6,8,10,12,24}]


{7, 10, 24}

A comparison with the Graph-base approach using a larger list:

list = RandomSample[Range[10^4], 1000];

r1 = maximal[list]; //AbsoluteTiming
r2 = sources[
SimpleGraph[RelationGraph[Divisible, list], VertexLabels -> "Name"]
]; //AbsoluteTiming

Sort @ r1 === Sort @ r2


{0.175122, Null}

{1.45297, Null}

True