15
$\begingroup$

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}

$\endgroup$
10
$\begingroup$

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.

$\endgroup$
  • 1
    $\begingroup$ (+1). ConstantArray in place of Table will make this faster. $\endgroup$ – Michael E2 Jul 2 '13 at 20:51
  • $\begingroup$ @MichaelE2 thanks for pointing it out. $\endgroup$ – Kuba Jul 2 '13 at 21:28
11
$\begingroup$

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]]⌋
$\endgroup$
5
$\begingroup$

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

$\endgroup$
  • $\begingroup$ It is the same idea but the shorter the better :) +1 $\endgroup$ – Kuba Jul 2 '13 at 13:58
4
$\begingroup$

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.

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

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]}];
$\endgroup$
4
$\begingroup$

Using basic math:

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

{14, 14, 14, 14, 14, 15, 15}
$\endgroup$
  • $\begingroup$ It is going to be slow but I like the compactness of the code. :) $\endgroup$ – Kuba Jul 3 '13 at 6:03
  • $\begingroup$ 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}] $\endgroup$ – xan Jul 3 '13 at 17:21
  • $\begingroup$ 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. $\endgroup$ – Mr.Wizard Jul 3 '13 at 18:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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