Splitting balls over sized bins

Question

This is strongly related to Splitting a set of integers over a set of bins, but a much simpler case.

If we have $N$ indistinguishable balls and $k$ arbitrarily large distinguishable bins, we know the number of ways to distribute the balls over the bins (allowing for empty bins) is given by a binomial coeffcient

binCounts[balls_, bins_] :=
  Binomial[balls + bins - 1, balls];

and if we want the actual splits, those are given by taking all permutations of integer partitions of $N$ of length $k$

binSplits[balls_, bins_] :=
  Apply[
   Join,
   Permutations[PadRight[#, bins]] & /@
    IntegerPartitions[balls, bins]
   ];

Just to show this indeed works

Table[
   Length[binSplits[n, k]] == binCounts[n, k],
   {n, 1, 20},
   {k, 1, 10}
   ] // Flatten // Apply[And]

True

This breaks down, though, when we have sized bins, i.e. each of our $k$ bins has some max number of allowed balls $c_i$. From this math.SE question I'm not expecting there to be a nice closed-form solution for the number of partitions. That doesn't mean we can't write an algorithm to generate them.

The naive approach would be to just filter our prior list of solutions

binSplitsSized[balls_, binSizes_] :=
 Block[{bins = Length[binSizes], splits},
  splits = Apply[
    Join,
    Permutations[PadRight[#, bins]] & /@
     IntegerPartitions[balls, bins]
    ];
  Select[splits, Min[binSizes - #] >= 0 &]
  ]

binSplitsSized[10, ConstantArray[3, 5]]

{{3, 3, 3, 1, 0}, {3, 3, 3, 0, 1}, {3, 3, 1, 3, 0}, {3, 3, 1, 0, 3}, {3, 3, 0, 
  3, 1}, {3, 3, 0, 1, 3}, {3, 1, 3, 3, 0}, {3, 1, 3, 0, 3}, {3, 1, 0, 3, 3}, {3,
   0, 3, 3, 1}, {3, 0, 3, 1, 3}, {3, 0, 1, 3, 3}, {1, 3, 3, 3, 0}, {1, 3, 3, 0, 
  3}, {1, 3, 0, 3, 3}, {1, 0, 3, 3, 3}, {0, 3, 3, 3, 1}, {0, 3, 3, 1, 3}, {0, 3,
   1, 3, 3}, {0, 1, 3, 3, 3}, {3, 3, 2, 2, 0}, {3, 3, 2, 0, 2}, {3, 3, 0, 2, 
  2}, {3, 2, 3, 2, 0}, {3, 2, 3, 0, 2}, {3, 2, 2, 3, 0}, {3, 2, 2, 0, 3}, {3, 2,
   0, 3, 2}, {3, 2, 0, 2, 3}, {3, 0, 3, 2, 2}, {3, 0, 2, 3, 2}, {3, 0, 2, 2, 
  3}, {2, 3, 3, 2, 0}, {2, 3, 3, 0, 2}, {2, 3, 2, 3, 0}, {2, 3, 2, 0, 3}, {2, 3,
   0, 3, 2}, {2, 3, 0, 2, 3}, {2, 2, 3, 3, 0}, {2, 2, 3, 0, 3}, {2, 2, 0, 3, 
  3}, {2, 0, 3, 3, 2}, {2, 0, 3, 2, 3}, {2, 0, 2, 3, 3}, {0, 3, 3, 2, 2}, {0, 3,
   2, 3, 2}, {0, 3, 2, 2, 3}, {0, 2, 3, 3, 2}, {0, 2, 3, 2, 3}, {0, 2, 2, 3, 
  3}, {3, 3, 2, 1, 1}, {3, 3, 1, 2, 1}, {3, 3, 1, 1, 2}, {3, 2, 3, 1, 1}, {3, 2,
   1, 3, 1}, {3, 2, 1, 1, 3}, {3, 1, 3, 2, 1}, {3, 1, 3, 1, 2}, {3, 1, 2, 3, 
  1}, {3, 1, 2, 1, 3}, {3, 1, 1, 3, 2}, {3, 1, 1, 2, 3}, {2, 3, 3, 1, 1}, {2, 3,
   1, 3, 1}, {2, 3, 1, 1, 3}, {2, 1, 3, 3, 1}, {2, 1, 3, 1, 3}, {2, 1, 1, 3, 
  3}, {1, 3, 3, 2, 1}, {1, 3, 3, 1, 2}, {1, 3, 2, 3, 1}, {1, 3, 2, 1, 3}, {1, 3,
   1, 3, 2}, {1, 3, 1, 2, 3}, {1, 2, 3, 3, 1}, {1, 2, 3, 1, 3}, {1, 2, 1, 3, 
  3}, {1, 1, 3, 3, 2}, {1, 1, 3, 2, 3}, {1, 1, 2, 3, 3}, {3, 2, 2, 2, 1}, {3, 2,
   2, 1, 2}, {3, 2, 1, 2, 2}, {3, 1, 2, 2, 2}, {2, 3, 2, 2, 1}, {2, 3, 2, 1, 
  2}, {2, 3, 1, 2, 2}, {2, 2, 3, 2, 1}, {2, 2, 3, 1, 2}, {2, 2, 2, 3, 1}, {2, 2,
   2, 1, 3}, {2, 2, 1, 3, 2}, {2, 2, 1, 2, 3}, {2, 1, 3, 2, 2}, {2, 1, 2, 3, 
  2}, {2, 1, 2, 2, 3}, {1, 3, 2, 2, 2}, {1, 2, 3, 2, 2}, {1, 2, 2, 3, 2}, {1, 2,
   2, 2, 3}, {2, 2, 2, 2, 2}}

but if the number of bins or balls get even moderately large, this quickly becomes unworkable, since we're generating the entire Binomial[balls + bins - 1, balls] solution set.

So how can we do better? The easiest initial approach is to just filter our IntegerPartitions off the bat to exclude any unworkable solutions

binSplitsSized2[balls_, binSizes_] :=
 Block[{bins = Length[binSizes], max = Max[binSizes], splits},
  splits = Apply[
    Join,
    Permutations[PadRight[#, bins]] & /@
     
     Select[IntegerPartitions[balls, bins], Max[#] <= max &]
    ];
  Select[splits, Min[binSizes - #] >= 0 &]
  ]

and this can give a significant boost

binSplitsSized[10, ConstantArray[3, 5]] // Length // RepeatedTiming

{0.0018, 101}

binSplitsSized2[10, ConstantArray[3, 5]] // Length // RepeatedTiming

{0.00022, 101}

but can also be very easily stymied

binSplitsSized[10, ConstantArray[10, 1]~Join~ConstantArray[1, 4]] // 
  Length // RepeatedTiming

{0.0019, 16}

binSplitsSized2[10, ConstantArray[10, 1]~Join~ConstantArray[1, 4]] // 
  Length // RepeatedTiming

{0.0018, 16}

So what good approaches are there do better?

Answer 1

Given that Reduce is able to solve some related problems, like can internally do what FrobeniusSolve is doing (according to Properties & Relations), I decided to see if it could do something smart to solve this problem. It seems that it can't because it is a bit slower than binSplitsSized2. I'm sharing it here so that others who are looking into this problem can know that this has been done.

constructEqualities[nrOfBalls_, binSizes_] := Prepend[
  MapThread[
   0 <= Symbol[StringTemplate["x``"][#]] <= #2 &,
   {Range@Length[binSizes], binSizes}
   ],
  Plus @@ Map[Symbol@*StringTemplate["x``"], Range@Length[binSizes]] == nrOfBalls
  ]

equalitiesToList[eqts_] := Module[{x},
  x = List @@ eqts;
  x = List @@@ x;
  x[[All, All, 2]]
  ]

split[nrOfBalls_, binSizes_] := equalitiesToList@Reduce[
   constructEqualities[nrOfBalls, binSizes],
   Integers
   ]

split[10, {10, 2, 1, 5, 1, 1, 4, 3}] // Length // RepeatedTiming
(* Out: {0.1, 2185} *)

binSplitsSized2[10, {10, 2, 1, 5, 1, 1, 4, 3}] // Length
(* Out: {0.055, 2185} *)