How to find all prime power factorizations of an integer

Question

I want to put in $n$ and get the possible factorizations into prime powers. Let's say for 24 I want {{8,3}, {4,2,3}, {2,2,2,3}}.

The algorithm for doing this on paper is this:

Find the prime factorization of $n$. Example case: $24=2^3 \cdot 3$
Take powers and find their partitions. Example case: $3=2+1=1+1+1$ and $1$.
Construct the different factorizations of $n$. Example case: $24=8\cdot3=4\cdot2\cdot3=2\cdot2\cdot2\cdot3$.

My code is this:

primeFactorsWithPowers = FactorInteger[n];
primeFactorsWithPartitionedPowers = {#[[1]], IntegerPartitions[#[[2]]]} & /@ primeFactorsWithPowers;
primePowerFactors = #[[1]]^#[[2]] & /@ primeFactorsWithPartitionedPowers;
factorizationsIntoPrimePowersRaw = Tuples@primePowerFactors;
factorizationsIntoPrimePowers = Flatten /@ factorizationsIntoPrimePowersRaw

For n = 360 this gives {{8, 9, 5}, {8, 3, 3, 5}, {4, 2, 9, 5}, {4, 2, 3, 3, 5}, {2, 2, 2, 9, 5}, {2, 2, 2, 3, 3, 5}} which is correct. But it seems a bit long and clumsy to have so many obscure operations for this. Being a badass I attempt to wrap it all in a function:

primePowerFactorizations[n_] := Map[Flatten, #[[1]]^#[[2]] & /@ Map[{#[[1]], IntegerPartitions[#[[2]]]} &, FactorInteger[n]] //Tuples]

or maybe:

primePowerFactorizations[n_] :=
 Map[Flatten,
  Tuples[
   #[[1]]^#[[2]] & /@
    Map[{#[[1]], IntegerPartitions[#[[2]]]} &,
     FactorInteger[n]]]]

Either way it looks like something that I will never be able to read again. Can I write this in a nicer way? Maybe you know of a method or function that allows to shorten this?

I don't understand how multiple uses of /@, @, // are supposed to work. For me a nice way to see the order of operations (and unwrap it with my eyes) would seem if I could write it like this:

primePowerFactorizations[n_] :=
 Flatten /@
  Tuples @
   #[[1]]^#[[2]] & /@
    { #[[1]], IntegerPartitions[#[[2]]] } & /@
     FactorInteger[n]

But this doesn't work at all.

Either way it looks like something that I will never be able to read again Well, welcome to programming in Mathemtica :) I once spend one hr trying to understand few lines of code in Mathematia book written by one of the experts in Mathematica. I could not figure how the code works. So I gave up. To make code easier to understand, I would break it in pieces. do not tail-call too many functions. I would keep the limit to 2 calls and at most 3. So instead of f1[f2[f3[f4[x]]]] you would write y=f4[x] and y=f3[y] and y=f2[y] and so it. you get the idea. — Nasser, Mar 24 '17 at 02:08
@Nasser how do you wrap such code into a function while keeping the in-function code written step by step? — Džuris, Mar 24 '17 at 03:06
Look up Module[] and other scoping constructs; see this for some guidance. — J. M.'s missing motivation, Mar 24 '17 at 07:40

score 5 · Accepted Answer · edited Apr 13 '17 at 12:55

Here is one possibility, which I'll decompose into separate steps for your easier perusal:

n = 360;
pow = ConstantArray @@@ FactorInteger[n]
   {{2, 2, 2}, {3, 3}, {5}}

facs = Table[Times @@@ Internal`PartitionRagged[#, part],
             {part, IntegerPartitions[Length[#]]}] & /@ pow
   {{{8}, {4, 2}, {2, 2, 2}}, {{9}, {3, 3}}, {{5}}}

Flatten[Tuples[facs], {{1}, {2, 3}}]
   {{8, 9, 5}, {8, 3, 3, 5}, {4, 2, 9, 5}, {4, 2, 3, 3, 5},
    {2, 2, 2, 9, 5}, {2, 2, 2, 3, 3, 5}}

The first step is to generate the expanded prime factorization from the output of FactorInteger[]. Recall that it returns a list of factors in the format {prime, power}. Using ConstantArray[] with level-1 Apply[] (@@@) performs that expansion by converting, say, {2, 3}, into ConstantArray[2, 3], which evaluates to {2, 2, 2}, and applying that transformation to each prime-power pair.

The second step is a bit tricky, and uses the undocumented function Internal`PartitionRagged[], which you can read about here. For each expanded factor, we generate the set partitions by first partitioning the length with IntegerPartitions[], and then using Internal`PartitionRagged[] to convert these into explicit set partitions. For instance,

Internal`PartitionRagged[{2, 2, 2}, {2, 1}]
   {{2, 2}, {2}}

Following up with Times[] + level-1 Apply[] turns it into explicit factors (for the previous example, {4, 2}).

The final step is a useful blend of Tuples[] and Flatten[]. Tuples[{list1, list2, (* stuff *)}] will explicitly generate tuples whose elements are selected from each of the given inner lists, as noted in its documentation. The final use of Flatten[] is slightly advanced, and is discussed in further detail here; suffice it to say that it rearranges the output of Tuples[] so that you end up with a list of lists of factors.

I learned a lot here! Still it seems that every line of Mathematica code needs a couple lines worth of comments :) Maybe I am saying that just because I couldn't manage to understand flatten-with-matrix thing but isn't that unnecessary? I mean we just need to flatten each of tuples like {{4,2},{3,3},{5}}. Would Flatten/@Tuples[facs] be any worse? — Džuris, Mar 24 '17 at 03:04

score 3 · Answer 2 · answered Mar 24 '17 at 10:05

3

f[m_, n_] := m^# & /@ n
func[n_] := 
 Join @@@ Tuples[
   f @@@ Cases[
     FactorInteger[n], {x_, y_} :> {x, IntegerPartitions[y]}]]

e.g.func[360] yields:

{{8, 9, 5}, {8, 3, 3, 5}, {4, 2, 9, 5}, {4, 2, 3, 3, 5}, {2, 2, 2, 9, 
  5}, {2, 2, 2, 3, 3, 5}}

answered Mar 24 '17 at 10:05

ubpdqn

60,617
3
59
148

2

Slightly shorter: Flatten /@ Tuples[Power @@@ MapAt[IntegerPartitions, FactorInteger[n], {All, 2}]]. – J. M.'s missing motivation Mar 24 '17 at 10:35
@J.M. Nice. I will leave as a constructive comment :) – ubpdqn Mar 24 '17 at 10:36

score 3 · Answer 3 · edited Apr 13 '17 at 12:55

The general problem of multiplicative partitions is discussed on Stack Exchange here and here. Adapting code from the article by Knopfmacher and Mays gives the following function mpp. It is initially slower than the other answers given here but, when used repeatedly, the memoization speeds subsequent solutions.

mpp[1, m_] := {{}}
mpp[n_, 1] := {{}}
mpp[n_?PrimeQ, m_] := If[m < n, {}, {{n}}]

mpp[n_, m_] := mpp[n, m] =
   Flatten[
     Table[Map[Join[{d}, #] &, mpp[n/d, d]],
           {d, Pick[#, UnitStep[m-#], 1] &[Select[Divisors[n],PrimePowerQ]]}],
   1]

mpp[n_] := mpp[n, n]

How to find all prime power factorizations of an integer

3 Answers3