Partitioning an integer into $k$ equal parts

Question

Say I have an integer $M$. Is there a one-line command to create a partition of $M$ into $k$ integers s.t. the difference between any two integers is as small as possible?

For example, with $M = 100$ and $k = 10$, we would create the partition: {10,10,10,10,10,10,10,10,10,10}. However, for $k = 7$, we might have the partition: {14,14,14,14,14,14,16}, or better {14,14,14,14,14,15,15}.

For a partial solution, you can of course write:

M = 100;
k = 7;
BalancedPartition = Array[Floor[M/k] &, k];
BalancedPartition[[k]] += M - k*Floor[M/k];
BalancedPartition

{14, 14, 14, 14, 14, 14, 16}

Answer 1

I like the idea of using IntegerPartitions as that is after all what we are doing. We can use it much more efficiently than Jonathan's answer by restricting the set of integers from which the elements are chosen using the third parameter.

f[m_, k_] := First @ IntegerPartitions[m, {k}, {0,1} + ⌊m/k⌋]

f[100, 7]

{15, 15, 14, 14, 14, 14, 14}

As a fan of terse code I also quite like this fractional carry method using FoldList:

EDIT: I forgot I was using my customized FoldList syntax.. The code below will require it.

EDIT 2: my customized FoldList syntax has been made standard, though undocumented. Hurrah!

f2[m_, k_] := ⌊FoldList[## - ⌊#⌋ &, Table[m/k, {k}]]⌋

f2[100, 7]

 {14, 14, 14, 15, 14, 14, 15}

(Note: ## - ⌊#⌋ is a "clever" way to write # + #2 - ⌊#⌋.)

Or taking a different approach:

f2[m_, k_] := ⌊FoldList[# - ⌊#⌋ + m/k &, m/k, Range[k-1]]⌋

Answer 2

I do not know single command to do this (it does not imply it does not exist:)). But it is two-line command:

dec[val_, par_] :=With[{ip = IntegerPart[val/par], md = Mod[val, par]}, 
                       ConstantArray[ip, par-md]~Join~ConstantArray[ip+1, md]]

dec[100, 10]

{10, 10, 10, 10, 10, 10, 10, 10, 10, 10}

dec[100, 7]

{14, 14, 14, 14, 14, 15, 15}

This is straightforward method: for k-integer components md=Mod[val,k] ε [0, k-1] so it is adding 1 to md last positions of final list.

One could use Quotient[val,par] or Floor[val/par] insted of IntegerPart.

Edit. Also:

ConstantArray in place of Table will make this faster. – Michael E2

So I swapped them.

Answer 3

We need a function that produces a list of k elements equal to Quotient[m,k], and then increments Mod[m,k] of them by 1. This seems to be the rationale underlying Kuba's answer ,by the way.

That can be represented by:

   f[m_, k_] := Table[Quotient[m, k], {k}] + PadLeft[Table[1, {Mod[m, k]}], k]

You can retrieve Quotient and Mod from the function QuotientRemainder. The code is a tad longer, but it shows that the key work is being done by a single function.

   f[m_, k_] := Table[#, {k}] + PadLeft[Table[1, {#2}], k] & @@ QuotientRemainder[m, k]

Testing

f[100, #] & /@ Range[29] // Column

Answer 4

You can use IntegerPartition and set up the following:

With[{x = IntegerPartitions[100, {7}]},With[{y = Max[#] - Min[#] & /@ x}, 
x[[Position[y, Min[y]] // Flatten]]]]

This will take the difference between the max and min values and take those partitions which have the minimum value for that.

Answer 5

An approximate table of k lots of M/k rounded down plus a correction. O(k) in speed I think.

f[M_Integer,k_Integer]:=Apply[#+Table[If[i <= M-Total[#],1,0],{i,1,k}]&,{Table[IntegerPart[M/k],{k}]}];

f[100,7]
{15,15,14,14,14,14,14}

The correction can be done in-line too...

f[M_Integer,k_Integer]:=Table[IntegerPart[M/k]+If[i <= M-k*IntegerPart[M/k],1,0],{i,1,k}];

f[100,7]
{15,15,14,14,14,14,14}

Marginally more compact...

f[M_Integer,k_Integer]:=Apply[Table[If[i<=M-k #,#+1,#],{i,1,k}]&,{IntegerPart[M/k]}];

Answer 6

Using basic math:

f[m_, k_] := Floor[Table[m + i - 1, {i, k}] / k];
f[100, 7]

{14, 14, 14, 14, 14, 15, 15}