2
$\begingroup$

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[#[[2]], #[[1]]] == 0 &], {1}];
Graph[\[CapitalGamma], edges, VertexLabels -> "Name"]

which looks like the following.

enter image description here

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?

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

I'd do this:

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

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

enter image description here

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

sources[g]
(* {7, 10, 24} *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ Someone might point out GraphComputation`SourceVertexList, but it does exactly the same thing as sources above. IGraph/M also has IGSourceVertexList and IGSinkVertexList, implemented roughly this way. $\endgroup$ – Szabolcs Jan 22 '18 at 14:44
1
$\begingroup$

If you just want the maximal elements and don't need the graph, you could use Internal`ListMin. Internal`ListMin 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^#)&] @ -Internal`ListMin[-e]
]

For your example:

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

| improve this answer | |
$\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.