A309859 Irregular table read by rows where row(n) partitions n into distinct integers with maximal product.
1, 2, 3, 4, 3, 2, 4, 2, 4, 3, 5, 3, 4, 3, 2, 5, 3, 2, 5, 4, 2, 5, 4, 3, 6, 4, 3, 5, 4, 3, 2, 6, 4, 3, 2, 6, 5, 3, 2, 6, 5, 4, 2, 6, 5, 4, 3, 7, 5, 4, 3, 6, 5, 4, 3, 2, 7, 5, 4, 3, 2, 7, 6, 4, 3, 2, 7, 6, 5, 3, 2, 7, 6, 5, 4, 2, 7, 6, 5, 4, 3, 8, 6, 5, 4, 3, 7, 6, 5, 4, 3, 2, 8, 6, 5, 4, 3, 2, 8, 7, 5, 4, 3, 2, 8, 7, 6, 4, 3, 2
Offset: 1
Examples
The partitions of 10 into distinct addenda are {{10}, {9, 1}, {8, 2}, {7, 3}, {7, 2, 1}, {6, 4}, {6, 3, 1}, {5, 4, 1}, {5, 3, 2}, {4, 3, 2, 1}}, then the maximal product is attained with 5*3*2 = 30, so row(10) is {5, 3, 2}.
Table begins:
1
2
3
4
3, 2
4, 2
4, 3
5, 3
4, 3, 2
5, 3, 2
...
Links
- Jean-François Alcover, Table of n, a(n) for n = 1..27908
- Tomislav Doslic, Maximum product over partitions into distinct parts, J. of Integer Sequences, Vol. 8 (2005), Article 05.5.8.
- SeqFan, Is a partition with distinct parts and maximum product unique ?, Discussion on SeqFan-mailing list, September 2019.
Crossrefs
Cf. A034893 (row products).
Programs
-
Mathematica
$RecursionLimit = 2000; b[n_, i_] := b[n, i] = If[i (i + 1)/2 < n, 0, If[n == 0, 1, Max[b[n, i - 1], i b[n - i, Min[n - i, i - 1]]]]]; A034893[n_] := b[n, n]; sol[n_, pro_] := Do[If[pro == Product[i, {i, j, m}]/k && n == (m - j + 1)*(j + m)/2 - k , Return[ {j, k, m}]], {j, 2, 3}, {m, Floor[Sqrt[2 n]], Ceiling[Sqrt[2 n]] + 1}, {k, j + 1, m}]; row[1] = {1}; row[4] = {4}; row[n_] := Module[{j, k, m}, {j, k, m} = sol[n, A034893[n]]; DeleteCases[Range[j, m], k] // Reverse]; Array[row, 100] // Flatten (* Jean-François Alcover, Sep 14 2019, after Alois P. Heinz in A034893 *)
Extensions
b-file extended to 1000 rows by Jean-François Alcover, Sep 14 2019
Comments