6
$\begingroup$

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.

$\endgroup$
8
  • 1
    $\begingroup$ As 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… ;) $\endgroup$ – J. M.'s torpor Jun 3 '15 at 13:38
  • $\begingroup$ 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. $\endgroup$ – Dr. belisarius Jun 4 '15 at 0:48
  • 1
    $\begingroup$ @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 $\endgroup$ – Geoffrey Critzer Jun 4 '15 at 15:08
  • 1
    $\begingroup$ @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! $\endgroup$ – Dr. belisarius Jun 4 '15 at 16:12
  • 1
    $\begingroup$ with Timing[Join @@ (Join[{DivisorSigma[0, #]}, Tally[Length /@ allChains[#]][[All, 2]]] & /@ Table[Times @@ Prime[Range[m]], {m, 1, 5}])] $\endgroup$ – Dr. belisarius Jun 4 '15 at 19:39
11
$\begingroup$

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)
  ]
$\endgroup$
2
  • $\begingroup$ Looks great! I think your use of an abundant number is a good example… $\endgroup$ – J. M.'s torpor Jun 3 '15 at 23:07
  • $\begingroup$ @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. $\endgroup$ – Dr. belisarius Jun 3 '15 at 23:26

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.