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.
$\begingroup$
$\endgroup$
8
asked Jun 3, 2015 at 11:52
1 Answer
$\begingroup$
$\endgroup$
2
A graph representation:
opts = {VertexLabels -> "Name", ImagePadding -> 10};
g[n_] := Graph[Flatten[Thread[DirectedEdge[#, Most@Divisors@#]] & /@ Divisors@n], opts]
aa = g[30]
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)
]
answered Jun 3, 2015 at 16:16
-
$\begingroup$ Looks great! I think your use of an abundant number is a good example… $\endgroup$ Commented Jun 3, 2015 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$ Commented Jun 3, 2015 at 23:26
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$Join @@ (Join[{DivisorSigma[0, #]}, Tally[Length /@ allChains[#]][[All, 2]]] & /@ Table[Times @@ Prime[Range[m]], {m, 1, 7}]).But I think it's slower! $\endgroup$Timing[Join @@ (Join[{DivisorSigma[0, #]}, Tally[Length /@ allChains[#]][[All, 2]]] & /@ Table[Times @@ Prime[Range[m]], {m, 1, 5}])]$\endgroup$