Find all "chains" in the poset of divisors

6

3

I want to input a set of divisors of an integer $n$ and return all subsets of these divisors ${d_1,d_2,...d_k=n}$ such that $d_1$ divides $d_2$, $d_2$ divides $d_3$, ... and $d_(k-1)$ divides $d_k$. I would like to have a code that could be understood by a beginner Mathematica user.

Geoffrey Critzer

Posted 2015-06-03T11:52:03.760

Reputation: 1 531

1As a possible starting point: Select[Subsets[Divisors[n], {3, DivisorSigma[0, n]}], And @@ (Divisible @@@ Partition[Reverse[#], 2, 1]) &]; doing this in a more efficient manner is something I'll leave for people smarter than me to do… ;) – J. M.'s ennui – 2015-06-03T13:38:23.360

Re: I would like to have a code that could be understood by a beginning Mathematica user.. Code is just code, and can be understood by anyone furnished with suitable documentation, the appropriate behavioral drivers and some time to spare. Sometimes it can be understood by language interpreters too. – Dr. belisarius – 2015-06-04T00:48:08.623

@Guess who it is, Thanks. Your code was very helpful. I learned a lot! – Geoffrey Critzer – 2015-06-04T15:06:59.017

1@Belisarius, Thanks for your comment. Here is what happens when a beginning Mathematica user has lots of time to spare:Table[Timing[ Table[Length[ Select[Subsets[Divisors[n], {k}], Apply[And, Map[Apply[Divisible, #] &, Partition[Reverse[#], 2, 1]]] &]], {k, 1, PrimeOmega[n] + 1}]], {n, Table[Apply[Times, Prime[Range[m]]], {m, 0, 5}]}] ... and we are led to Sloane's OEIS A038719 – Geoffrey Critzer – 2015-06-04T15:08:53.340

1@GeoffreyCritzer Nice!. This is the equivalent expression using my answer Join @@ (Join[{DivisorSigma[0, #]}, Tally[Length /@ allChains[#]][[All, 2]]] & /@ Table[Times @@ Prime[Range[m]], {m, 1, 7}]) .But I think it's slower! – Dr. belisarius – 2015-06-04T16:12:57.483

@GeoffreyCritzer well, I performed the timed tests wrong. Mine is actually much, much faster – Dr. belisarius – 2015-06-04T19:37:43.997

Compare Timing[Join @@ Table[Table[ Length[Select[Subsets[Divisors[n], {k}], Apply[And, Map[Apply[Divisible, #] &, Partition[Reverse[#], 2, 1]]] &]], {k, 1, PrimeOmega[n] + 1}], {n, Table[Apply[Times, Prime[Range[m]]], {m, 0, 5}]}]] – Dr. belisarius – 2015-06-04T19:39:40.913

1with Timing[Join @@ (Join[{DivisorSigma[0, #]}, Tally[Length /@ allChains[#]][[All, 2]]] & /@ Table[Times @@ Prime[Range[m]], {m, 1, 5}])] – Dr. belisarius – 2015-06-04T19:39:57.750

Answers

11

A graph representation:

opts = {VertexLabels -> "Name", ImagePadding -> 10};

g[n_] := Graph[Flatten[Thread[DirectedEdge[#, Most@Divisors@#]] & /@ Divisors@n], opts]

aa = g[30]

Mathematica graphics

Then (v10 only, thanks to @billc for running it for me):

fp = FindPath[aa, 30, 1, Infinity, All]
(*
 {{30, 1}, {30, 15, 1}, {30, 10, 1}, {30, 6, 1}, {30, 5, 1}, 
  {30, 3, 1}, {30, 2, 1}, {30, 15, 5, 1}, {30, 15, 3, 1}, {30, 10, 5, 1}, 
  {30, 10, 2, 1}, {30, 6, 3, 1}, {30, 6, 2, 1}}
*)

(For pre-v10 options see here)

Now, all the adjacent sublists in those lists are valid chains.

Union @@ (Flatten[Table[#[[i ;; j]], {j, 2, Length@#}, {i, 1, j - 1}], 1] & /@ fp)

(*
 {{2, 1}, {3, 1}, {5, 1}, {6, 1}, {6, 2}, {6, 3}, {10, 1}, {10, 2}, 
  {10, 5}, {15, 1}, {15, 3}, {15, 5}, {30, 1}, {30, 2}, {30, 3}, {30, 5}, 
  {30, 6}, {30, 10}, {30, 15}, {6, 2, 1}, {6, 3, 1}, {10, 2, 1}, {10, 5, 1},
  {15, 3, 1}, {15, 5, 1}, {30, 2, 1}, {30, 3, 1}, {30, 5, 1}, {30, 6, 1},
  {30, 6, 2}, {30, 6, 3}, {30, 10, 1}, {30, 10, 2}, {30, 10, 5}, {30, 15, 1},
  {30, 15, 3}, {30, 15, 5}, {30, 6, 2, 1}, {30, 6, 3, 1}, {30, 10, 2, 1}, 
  {30, 10, 5, 1}, {30, 15, 3, 1}, {30, 15, 5, 1}}
*)

The last step is also equivalent to:

Union@Flatten[ReplaceList[#, {___, i_, x___, j_, ___} :> {i, x, j}] & /@ fp, 1]

Finally, the whole thing can be packed up in a function like:

allChains[n_] := Module[{a, fp},
  a = Graph@ Flatten[Thread[DirectedEdge[#, Most@Divisors@#]] & /@ Divisors@n];
  fp = FindPath[a, n, 1, Infinity, All];
  Union @@ (Flatten[Table[#[[i ;; j]], {j, 2, Length@#}, {i, 1, j - 1}], 1] & /@ fp)
  ]

Dr. belisarius

Posted 2015-06-03T11:52:03.760

Reputation: 112 848

Looks great! I think your use of an abundant number is a good example…

– J. M.'s ennui – 2015-06-03T23:07:52.373

@J. M. Glad you like it. I enjoy a lot this kind of solutions, trying to convert a problem into some area where Mma is strong. – Dr. belisarius – 2015-06-03T23:26:33.527