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.

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}

share|improve this question
add comment

6 Answers 6

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  
(+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
add comment

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
add comment

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

table

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

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  
+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
add comment

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]}];
share|improve this answer
add comment

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
add comment

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.