# Plotting Poset Relations in Mathematica [closed]

Let $n$ be a positive integer and let $p$ denote the largest prime $\le n$. Let $i=2^{a_2}3^{a_3}5^{a_5}\cdots p^{a_p}$, $a_l\ge 0$.

For nonprimes $s,t\le n$, we say $s\le t$ (poset relation) if, for each $i$, whenever $s$ has at least 2 prime factors (or powers) that $i$ doesn't have, $t$ also has at least 2 prime factors that $i$ doesn't have.

For example, if $n=9$, then we have $6\le 9$ (since if 6 has two or more primes that $i$ doesn't have, then $i$ is not divisible by 2 nor 3, so that 9 has two more powers of 3 than $i$), $6\le 4$ (since if 6 has two or more primes than $i$, then $i$ is not divisible by 2, so that $4$ has two more powers of 2 than $i$), and $4\le 8$ (since if $4$ has two or more primes that $i$ doesn't have, then $i$ is not divisible by 2 so that $8$ has two or more powers of 2 that $i$ doesn't have).

For a given $n$, is there a code that will provide all of the relations $s\le t$ for $s,t\le n$?

• What is $j$ in your definition? Can you express your relationships in Mathematica code? – MarcoB Aug 21 '17 at 20:44
• Sorry I meant to put $t$. I currently have no code for this relation. The description I gave for $s \le t$ is the best one I have at the moment. – The Substitute Aug 21 '17 at 21:26
• (1) Your definitions are not very clear and (2) the title is different than the question you are asking. – Anton Antonov Aug 21 '17 at 23:03

I believe the following does what you want. First, let's write a function to convert the integers $s$ and $t$ into lists of prime exponents:

toExp[s_, n_] := IntegerExponent[s, Prime @ Range @ PrimePi[n]]


For example:

toExp[6, 9]
toExp[9, 9]


{1, 1, 0, 0}

{0, 2, 0, 0}

Now, in this case the integers $i$ can also be represented by 4-element lists of nonnegative integers. So, in general, the criteria that $s$ has 2 or more factors compared to $i$ can be represented as:

Sum[Max[Subscript[s, k] - Subscript[i, k], 0], {k,  PrimePi[n]}] >= 2


Similarly, the criteria that $t$ has 2 or more factors compared to $i$ is expressed in the same way.

Now, the partial order specified by the OP is:

For nonprimes $s,t\le n$, we say $s\le t$ (poset relation) if, for each $i$, whenever $s$ has at least 2 prime factors (or powers) that $i$ doesn't have, $t$ also has at least 2 prime factors that $i$ doesn't have.

Alternatively, we can say that if there exists an $i$ such that $s$ has 2 more factors, yet $t$ has only 0 or 1 more factor than $i$, then the poset relation is false. This statement can be encoded in the following Reduce statement:

posetQ[n_][s_Integer, t_Integer] := With[
{
i = Thread[p @ Range @ PrimePi[n]],
ls = toExp[s, n],
lt = toExp[t, n]
},

TrueQ @ !Reduce[
And[
Total[Max[#, 0]& /@ (ls-i)] >= 2,
Total[Max[#, 0]& /@ (lt-i)] < 2,
Thread[And @@ i >= 0, And]
],
i,
Integers
]
]


Let's see if this function recreates your desired relations:

posetQ[6, 9]
posetQ[6, 4]
posetQ[4, 8]


True

True

True

posetQ[9, 6]
posetQ[4, 6]
posetQ[8, 4]
posetQ[6, 2]


False

False

False

False

• Thanks! For fixed $n$, Is it possible to list out all of the pairs $a,b$ such that posetQ[n][a,b] is true? My current strategy to do that would be to include, for the example $n=8,$ Table[Table[posetQ[k, n], {k, 1, 8}], {n, 1, 8}] but I don't think the latter is as helpful. – The Substitute Aug 23 '17 at 1:38
• I think With[{tups=Tuples[Range,2]}, Pick[tups, posetQ@@@tups]] should do it. – Carl Woll Aug 23 '17 at 1:59
• That works. Is there a way to remove all noncompisite integers from this list? That is, I'd like to have all numbers less than $n$ other than $1$ and primes. – The Substitute Aug 23 '17 at 2:07
• You should work on learning how to do that yourself. Anyway, use Select[Range[2, 8], CompositeQ] instead of Range. – Carl Woll Aug 23 '17 at 2:15