Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

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];

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

share|improve this question
up vote 9 down vote accepted

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.

share|improve this answer
(+1). ConstantArray in place of Table will make this faster. – Michael E2 Jul 2 '13 at 20:51
@MichaelE2 thanks for pointing it out. – Kuba Jul 2 '13 at 21:28

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]]⌋
share|improve this answer

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]


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


share|improve this answer
It is the same idea but the shorter the better :) +1 – Kuba Jul 2 '13 at 13:58

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.

share|improve this answer
this will be rather slow for "large" n...? – Pinguin Dirk Jul 2 '13 at 9:07
Yes, you're right, it would be. – Jonathan Shock Jul 2 '13 at 9:26
+1 for inspiration. FWIW this can be made much faster (see my answer). – Mr.Wizard Jul 2 '13 at 16:10
ah, I wasn't really aware of the third argument of IntegerPartions, thanks for pointing that out, @Mr.Wizard! – Pinguin Dirk Jul 2 '13 at 16:17

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}]}];


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}];


Marginally more compact...

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

Using basic math:

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

{14, 14, 14, 14, 14, 15, 15}
share|improve this answer
It is going to be slow but I like the compactness of the code. :) – Kuba Jul 3 '13 at 6:03
Thanks @Kuba. I'm curious about what makes it slow (being a novice at Mathematica). Would it be notably faster with the operations inside the Table? I.e., Table[Floor[(m + i - 1)/k], {i, k}] – xan Jul 3 '13 at 17:21
Very nice! I feel foolish for not seeing this simple solution. You could also write this f = Quotient[# + Range@#2 - 1, #2] & which is shorter and should also be faster. – Mr.Wizard Jul 3 '13 at 18:19

Your Answer


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.