Count two or more equal consecutive elements in a list and create histogram

Question

I have a list generated by:

list = RandomInteger[{1}, 100]

it contains only 0's and 1's

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

I'm trying to create a histogram in the following way: I want to look for two or more consecutive 1's e.g. 1,1 or 1,1,1 and so on. In other words I want to count all sequences of two or more consecutive 1's.

I also want to extract the positions of the found sequences in the list.

I tried to approach it with PatternSequence based on the help entry e.g.:

list //. {x___, PatternSequence[1, 1], y___} -> {x, "mypatterns", y}

which seems ok for showing me where the patterns in the list are, but it does not count them or give me the positions :(

Looking for some inspiration :)

Answer 1

Rewritting, after author made clearer what was expected

   list = RandomInteger[{1}, 1000];
   PositionsOfNumeroUno = Flatten[Position[list, 1]];
   PositionOfSequencesOFNumeroUno =Table[{n, {ListOfPositions =Pick[Drop[PositionsOfNumeroUno, n - 1],Differences[PositionsOfNumeroUno, 1, n - 1], n - 1] - n + 1,ListOfPositions + n - 1} // Transpose}, {n, 2, 10, 1}]

This will give a list which will have as a first value how long is the sequences, and then the list of positions where this sequences occurs. Here I done it for up to lenght of 10 entries. To get how many entries there are of each length

HowLongAreSequences = {PositionOfSequencesOFNumeroUno[[All, 1]],   Map[Length[#] &, PositionOfSequencesOFNumeroUno[[All, 2]]]} //Transpose

Below I also plot results of the last command for a bit larger sample (10000 entries long). With blue I shown calculated value, and with orange the expected value (just from probability arguments, how many occuranges of such sequence I would expect in the sample)

Answer 2

list =
  {0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 
   0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 
   0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 
   1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 
   1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1};

Maximum length of consecutive 1's

max = Max @ Map[Length] @ SequenceCases[list, {1 ..}]

8

Counts of consecutive 1's with overlaps

ot = 
  Table[{n, SequenceCount[list, {Repeated[1, {n}]}, Overlaps -> True]}, {n, 2, max}]

{{2, 21}, {3, 9}, {4, 5}, {5, 4}, {6, 3}, {7, 2}, {8, 1}}

Counts of consecutive 1's without overlaps

of = 
 Table[{n, SequenceCount[list, {Repeated[1, {n}]}, Overlaps -> False]}, {n, 2, max}]

{{2, 15}, {3, 5}, {4, 2}, {5, 1}, {6, 1}, {7, 1}, {8, 1}}

ListStepPlot[{ot, of}, Center,
 Frame -> True,
 FrameLabel -> {"Conscutive 1's", "Count"},
 GridLines -> Automatic,
 Mesh -> Full, 
 PlotLegends -> {"Overlaps -> True", "Overlaps -> False"},
 PlotStyle -> {Automatic, Dashed}]

To get the positions we replace SequenceCount with SequencePosition

Table[{n, SequencePosition[list, {Repeated[1, {n}]}, Overlaps -> False]}, {n, 2, max}]

returns

{{2, {{5, 6}, {16, 17}, {19, 20}, {28, 29}, {33, 34}, {37, 38}, {49, 50}, {60, 61}, {65, 66}, {75, 76}, {77, 78}, {79, 80}, {81, 82}, {87, 88}, {99, 100}}},
 {3, {{5, 7}, {65, 67}, {75, 77}, {78, 80}, {87, 89}}},
 {4, {{75, 78}, {79, 82}}},
 {5, {{75, 79}}},
 {6, {{75, 80}}},
 {7, {{75, 81}}},
 {8, {{75, 82}}}}