7
$\begingroup$

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.

$\endgroup$
6
  • $\begingroup$ From some of the answers that differ when BINDIVIDER is found at the beginning and/or end of the list, you should state if you are assuming that there are always "invisible" BINDIVIDER's at the beginning and end of the list. Or, if true, (and I think equivalently) that $n$ BINDIVIDER's means that there are $n+1$ bins. $\endgroup$
    – JimB
    Commented Apr 20, 2021 at 15:59
  • $\begingroup$ There is no condition, so indeed the BINDIVIDER can be at any position. $\endgroup$
    – apg
    Commented Apr 20, 2021 at 16:35
  • 1
    $\begingroup$ Understood. But does that mean that {BINDIVIDER,ball,ball,BINDIVIDER} should result in {2} or {0,2,0} ? $\endgroup$
    – JimB
    Commented Apr 20, 2021 at 16:39
  • $\begingroup$ {0,2,0} is the correct output in this case $\endgroup$
    – apg
    Commented Apr 20, 2021 at 16:41
  • $\begingroup$ You might want to edit the question with that additional information. $\endgroup$
    – JimB
    Commented Apr 20, 2021 at 16:42

10 Answers 10

6
$\begingroup$

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

combinations

$\endgroup$
5
$\begingroup$

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}    *)
$\endgroup$
5
$\begingroup$

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:

enter image description here

with considerable advantage on large cases: enter image description here

$\endgroup$
1
  • 2
    $\begingroup$ +1 To resolve the differences in the answers, it seems the the OP needs to give more information about the structure of the lists. Specifically, bincnts and the "Current answer" result in the same thing when BINDIVIDER is not the first or last element. And given that the OP knows about combinatorics (from the profile), I'd say your approach and comment about stars and bars are right on the money. One of the other answers matches yours except when BINDIVIDER is the last element. $\endgroup$
    – JimB
    Commented Apr 20, 2021 at 3:00
4
$\begingroup$

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]
$\endgroup$
2
  • $\begingroup$ Ok, so add 3's where there are no 1s, then replace them with the count 0 at the end. Thank you. $\endgroup$
    – apg
    Commented Apr 19, 2021 at 15:02
  • $\begingroup$ Very nice. If you insert /. {2, x___} :> {3, 2, x} /. {x___, 2} :> {x, 2, 3} just before SequenceSplit, then I think you'll get the answer that matches that of @ciao. $\endgroup$
    – JimB
    Commented Apr 21, 2021 at 4:41
4
$\begingroup$
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

$\endgroup$
2
$\begingroup$
 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
$\endgroup$
2
$\begingroup$
list = {ball, ball, BINDIVIDER, ball, ball, ball, BINDIVIDER, 
  BINDIVIDER, ball, BINDIVIDER, ball};

f = ({0}~Join~(PositionIndex[#][BINDIVIDER] /. _Missing :> {})~
       Join~{Length@# + 1} // Differences) - 1 &;

f@list

{2, 3, 0, 1, 1}


To test with an example similar to @WReach's:

t = Tuples[{BINDIVIDER, 1}, 5];
{#, f@#} & /@ t /. BINDIVIDER -> 0 // Grid

enter image description here

$\endgroup$
0
1
$\begingroup$
list = {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1};

Count[1] /@ SequenceCases[Append[2] @ list, {1...,2}]

{2, 3, 0, 1, 1}

$\endgroup$
1
$\begingroup$
list = {1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 1};

Using SequenceReplace:

SequenceReplace[list /. 2 -> 0, s : {1 ..., 0} :> Count[s, 1]]

(*{2, 3, 0, 1, 1}*)
$\endgroup$
1
$\begingroup$

use Position then Differences

Clear["Global`*"];
list = {"ball", "ball", "BINDIVIDER", "ball", "ball", "ball", 
   "BINDIVIDER", "BINDIVIDER", "ball", "BINDIVIDER", "ball"};
On[Assert];
AllTrue[list, MemberQ[{"ball", "BINDIVIDER"}, #] &] // Assert
output = Differences[
   Flatten[{0, Position[list, "BINDIVIDER"], Length[list] + 1}]] - 1
{2, 3, 0, 1, 1}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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