3
$\begingroup$

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:

  1. Find the prime factorization of $n$. Example case: $24=2^3 \cdot 3$
  2. Take powers and find their partitions. Example case: $3=2+1=1+1+1$ and $1$.
  3. 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.

$\endgroup$
3
  • 1
    $\begingroup$ 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. $\endgroup$
    – Nasser
    Mar 24, 2017 at 2:08
  • $\begingroup$ @Nasser how do you wrap such code into a function while keeping the in-function code written step by step? $\endgroup$
    – Džuris
    Mar 24, 2017 at 3:06
  • $\begingroup$ Look up Module[] and other scoping constructs; see this for some guidance. $\endgroup$ Mar 24, 2017 at 7:40

3 Answers 3

5
$\begingroup$

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.

$\endgroup$
2
  • $\begingroup$ 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? $\endgroup$
    – Džuris
    Mar 24, 2017 at 3:04
  • $\begingroup$ Mapping Flatten[] will also work, yes. $\endgroup$ Mar 24, 2017 at 3:16
3
$\begingroup$
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}}
$\endgroup$
2
  • 2
    $\begingroup$ Slightly shorter: Flatten /@ Tuples[Power @@@ MapAt[IntegerPartitions, FactorInteger[n], {All, 2}]]. $\endgroup$ Mar 24, 2017 at 10:35
  • $\begingroup$ @J.M. Nice. I will leave as a constructive comment :) $\endgroup$
    – ubpdqn
    Mar 24, 2017 at 10:36
3
$\begingroup$

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]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.