Count number of balls in each bin, given a two-element sequence of balls and bins

Question

If I have a list:

{ball,ball,BINDIVIDER,ball,ball,ball,BINDIVIDER,BINDIVIDER,ball,BINDIVIDER,ball}

The balls and bins can be in any permutation.

Then, the following is clear: in bin one I have 2 balls, in bin two I have 3 balls, in bin three I have 0 balls, in bin four I have 1 ball, and in bin five I have 1 ball.

Can I put a list like this (above) into Mathematica, and get the counts of the balls in each bin? So, in this case I would put in {1,1,2,1,1,1,2,2,1,2,1}, and get out {2,3,0,1,1}.

Each output is a list with as many entries as bindividers, plus 1 (so just the number of bins).

I have tried using SequenceSplit, but this does not understand that empty gaps between two bins contain zero balls, instead splitting the list into concurrent sequences.

Answer 1

If we were to use 0 instead of 2 as the bin divider...

list = {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1} /. 2 -> 0

(* {1, 1, 0, 1, 1, 1, 0, 0, 1, 0, 1} *)

... then we could write:

Total /@ Split[list, # != 0 &]

(* {2, 3, 0, 1, 1} *)

Update

Taking account of subsequent comments and the updated question...

count[list_] := Total /@ Split[Append[list, 0], # != 0 &]

count[{0, 1, 1, 0}]
(* {0, 2, 0} *)

and

# -> count[#] & /@ Tuples[{0, 1}, 5] // Column

Answer 2

It works if the data are given as a string instead of as a list:

StringLength /@ StringSplit["11211122121", "2"]
(*    {2, 3, 0, 1, 1}    *)

The conversion to string, if required, can be done with

StringJoin @@ ToString /@ {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1}
(*    "11211122121"    *)

To address @ciao's concern, add the All option:

StringLength /@ StringSplit["11211122121", "2", All]
(*    {2, 3, 0, 1, 1}    *)

StringLength /@ StringSplit["11211122112", "2", All]
(*    {2, 3, 0, 2, 0}    *)

Answer 3

I do not believe the current answers correctly produce the result you appear to be after (which seems to be a "stars and bars" representation).

This would be one way to do this:

bincnts = (Join[{0}, PositionIndex[#][0], {Length[#] + 1}] // 
     Rest[#] - 1 - Most[#] &) &;

To illustrate the difference, I'll use the currently most upvoted answer (though a spot check on another answer yields the same):

All possible configurations with two dividers (hence 3 bins) (N.B.: I've used zero instead of 2 as the divider):

test = Permutations[{0, 0, 1, 1, 1, 1, 1}]

{{0,0,1,1,1,1,1},{0,1,0,1,1,1,1},{0,1,1,0,1,1,1},{0,1,1,1,0,1,1},{0,1,1,1,1,0,1},{0,1,1,1,1,1,0},{1,0,0,1,1,1,1},{1,0,1,0,1,1,1},{1,0,1,1,0,1,1},{1,0,1,1,1,0,1},{1,0,1,1,1,1,0},{1,1,0,0,1,1,1},{1,1,0,1,0,1,1},{1,1,0,1,1,0,1},{1,1,0,1,1,1,0},{1,1,1,0,0,1,1},{1,1,1,0,1,0,1},{1,1,1,0,1,1,0},{1,1,1,1,0,0,1},{1,1,1,1,0,1,0},{1,1,1,1,1,0,0}}

Current answer results:

Table[StringLength /@ StringSplit[l, "0"], {l, 
  StringJoin @@@ (Map[ToString, test, {2}])}]

{{5},{1,4},{2,3},{3,2},{4,1},{5},{1,0,4},{1,1,3},{1,2,2},{1,3,1},{1,4},{2,0,3},{2,1,2},{2,2,1},{2,3},{3,0,2},{3,1,1},{3,2},{4,0,1},{4,1},{5}}

bincnts results:

bincnts /@ test

{{0,0,5},{0,1,4},{0,2,3},{0,3,2},{0,4,1},{0,5,0},{1,0,4},{1,1,3},{1,2,2},{1,3,1},{1,4,0},{2,0,3},{2,1,2},{2,2,1},{2,3,0},{3,0,2},{3,1,1},{3,2,0},{4,0,1},{4,1,0},{5,0,0}}

Note that the latter correctly accounts for the actual number of bins that must logically be present.

Compared to using stringsplit or total on list split, this is quite performant:

with considerable advantage on large cases:

Answer 4

Not directly.

{1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 
     1} //. {x___, 2, 2, y___} :> {x, 2, 3, 2, y} // 
   SequenceSplit[#, {2}] & // # /. {3} :> 0 & // Map[Length]

Answer 5

Split[{1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1}, SameQ] /.
  {x : {1 ..} :> Length[x]} /.
  {x : {2 ..} :> Sequence @@ ConstantArray[0, Length[x] - 1]}

Note: your example has no divider as the first or last element. If an initial or final sequence of 1s can be empty -- that is, if the first or last element can be a bin divider -- the answer changes

Answer 6

 list = {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1} /. 2 -> 0;

A variation on ciao's approach for integer input with 0 as bin divider:

ClearAll[binCounts1]
binCounts1 = Differences @ Random`Private`PositionsOf[ArrayPad[#, {1, 1}], 0] - 1 &;

binCounts1[list]

 {2, 3, 0, 1, 1}

A much slower alternative using SequenceCases:

ClearAll[binCounts2]
binCounts2 = SequenceCases[ArrayPad[#, {1, 1}], 
  {0, a : Except[0] ..., 0} :> Length[{a}], Overlaps -> True] &;

binCounts2[list]

 {2, 3, 0, 1, 1}

Using ciao's test:

binCounts1 /@ test == binCounts2 /@ test == bincnts /@ test

True