Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Let $p_n\#\equiv\prod_{k=1}^{n}p_k$ (primorial):

p[n_] := Times @@ Prime[Range[n]]

then the multiplicative partitions of $p_{1,2,3,4}\#$ are

$$ \{\{2\}\},$$$$ \{\{6\},\{2,3\}\},$$$$ \{\{30\},\{2,15\},\{3,10\},\{5,6\},\{2,3,5\}\},$$$$ \{\{210\},\{2,105\},\{3,70\},\{5,42\},\{6,35\},\{7,30\},\{10,21\},\{14,15\},\{2,3,35\},\{2,5,21\},\{2,7,15\},\{3,5,14\},\{3,7,10\},\{5,6,7\},\{2,3,5,7\}\}$$ computed with

g[lst_, p_] := 
Module[{t, i, j}, Union[Flatten[Table[t = lst[[i]]; t[[j]] = p*t[[j]];
Sort[t], {i, Length[lst]}, {j, Length[lst[[i]]]}], 1], 
Table[Sort[Append[lst[[i]], p]], {i, Length[lst]}]]];

z[n_] := Module[{i, j, p, e, lst = {{}}}, {p, e} = 
Transpose[FactorInteger[n]];
Do[lst = g[lst, p[[i]]], {i, Length[p]}, {j, e[[i]]}]; lst];

Table[z[p[n]], {n, 1, 4}]

What is the best way to turn this into a symbolic function, so the output of the above becomes $$\{\{a\}\}$$$$ \{\{ab\}\},\{\{a,b\}\}$$$$ \{\{abc\}\},\{\{a,bc\},\{b,ac\},\{c,ab\}\},\{\{a,b,c\}\}$$$$ \{\{abcd\},\{a,bcd\},\{b,acd\},\{c,abd\},\{d,abc\},\{ab,cd\},\{ac,bd\},\{ad,bc\}, \{a,b,cd\},\{a,c,bd\},\{a,d,bc\},\{b,c,ad\},\{b,d,ac\},\{c,d,ab\},\{a,b,c,d\}\}$$ ?

The primorial example above is given for combinatorial simplicity. I would ideally like the function to be applicable to any number, e.g.: $72$ ($2^3\cdot 3^2$) would be tackled as $a^3\cdot b^2$.

Of course, it is possible to take this approach:

n = 4; ColumnForm[Map[FactorInteger[z[p[n]]][[#]] &, Range[Length[z[p[n]]]]]
/. 2 -> a /. 3 -> b /. 5 -> c /. 7 -> d]

... etc., but I wondered whether there was a more direct route?

NB - This question is an extension of this one.

Update

Have got this far:

n = p[4];
m = ColumnForm[Map[FactorInteger[z[n]][[#]] &, Range[w[n]]] 
/. 2 -> a /. 3 -> b /. 5 -> c /. 7 -> d];
ColumnForm[Table[Table[Map[m[[1, k]][[v]][[#]][[1]]^m[[1, k]][[v]][[#]][[2]] &, 
Range[Length[m[[1, k]][[v]]]]], {v, 1, Length[m[[1, k]]]}], {k, 1, w[n]}]]

BTW, is there an easier way of doing

/. 2 -> a /. 3 -> b /. 5 -> c /. 7 -> d /. 11 -> e /. 13 -> f /.                     
17 -> g /. 19 -> h /.

...etc.?

share|improve this question
    
I see - sorry - misread - will give that a go - thanks. –  martin May 27 at 13:18

1 Answer 1

up vote 4 down vote accepted
<< Combinatorica`
SetPartitions[{a, b, c, d}]
ru = Thread[{a, b, c, d} -> {2, 3, 5, 7}]
Apply[Times, SetPartitions[{a, b, c, d}] /. ru, {2}]

should do what you asked.

share|improve this answer
    
Ha! I have been somewhat over-complicating things then!! - except this is only applicable to primorials ... I can live with that though :) –  martin May 27 at 15:15
    
@Wouter, that's nice. –  alancalvitti Oct 12 at 17:15

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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