3
$\begingroup$

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 :)

$\endgroup$
4
  • 1
    $\begingroup$ Split is you friend here :-) $\endgroup$
    – Szabolcs
    Jul 9, 2015 at 11:42
  • 1
    $\begingroup$ Histogram: Histogram[Length /@ Select[Split[list], First[#] == 1 &]]. Positions: pos = Accumulate[Length /@ Split[list]]. Positions of the ones having 1s: Pick[pos, First/@Split[list], 1]. $\endgroup$
    – Szabolcs
    Jul 9, 2015 at 12:04
  • $\begingroup$ Thanks. Using Select and Split is actually very nice :), the histogram works for me here although it includes the patterns with only one 1. I don't understand the Positions code since I want e.g. the positions of the pattern with two 1's, three 1's in the original list, i.e. when does the pattern start and when does it end. $\endgroup$
    – holistic
    Jul 9, 2015 at 12:24
  • $\begingroup$ See this similar post for the counting problem. $\endgroup$
    – SquareOne
    Jul 9, 2015 at 12:50

2 Answers 2

4
$\begingroup$

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)

enter image description here

$\endgroup$
1
  • $\begingroup$ Great, thank you :) $\endgroup$
    – holistic
    Jul 10, 2015 at 12:15
0
$\begingroup$
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}]

enter image description here

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}}}}
$\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.