6
$\begingroup$

I want to find the number of elements in a list in a row that match a certain pattern.

So for this list

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

It should return "4" because there are four 1's in a row and then other stuff. I don't care that there are more 1's later on. I just want to find the number of consecutive integers in a row, starting from the beginning of the list. Is there a simple way of doing this?

Edit: I just realized my question was very poorly worded. I wanted to find the number of elements in a row starting from the beginning, regardless of what that element is.

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ Related: (40213) $\endgroup$
    – Mr.Wizard
    Commented Oct 30, 2014 at 9:16

7 Answers 7

Reset to default
5
$\begingroup$

Regarding the updated description of your problem while Split is very clean it is not optimal unless the overall list is relatively short. As an example consider this data:

SeedRandom[0];
a = RandomChoice[{"a", "b", "c"}, 1*^7];

It begins with:

{"c", "c", "b", "a", . . .}

The method from your answer takes significant time:

Needs["GeneralUtilities`"]  (* v10 package *)

Length[Split[a][[1]]] // AccurateTiming

1.303075

A method that does not process the entire list can be much faster:

LengthWhile[a, MatchQ @ First @ a] // AccurateTiming    (* v10 operator form *)

0.0000185558

For versions before 10 see kguler's Update 2 code.

Sidebar: timings of a pattern-based approach

Michael made the claim that his method is faster than LengthWhile. In the particular test he used, where nearly the entire list consists of the same element it starts with, it is, but elsewhere it performs extremely poorly. For example:

Needs["GeneralUtilities`"]

f1[a_]    := LengthWhile[a, MatchQ @ First @ a]
f2[list_] := Replace[list, {y : Longest@Repeated[x_], ___} :> Length[{y}]]

g = (SeedRandom[0]; Clip @ RandomInteger[100, #]) &;   (* first zero at position 78 *)

BenchmarkPlot[{f1, f2}, g, 2^Range[20],
 "IncludeFits" -> True, TimeConstraint -> 30]

enter image description here

In this test the first differing element occurs at position 78 but the length of the list past that grows. We see that LengthWhile correctly handles this in constant time whereas Replace explodes which should not happen if the pattern engine were well optimized.

Let us examine the pattern behavior by adding a PatternTest to x_:

SeedRandom[0]
list = Clip @ RandomInteger[100, 1000];

inc = (i++; True) &;

i = 0;
Replace[list, {y : Longest@Repeated[x_?inc], ___} :> Length[{y}]]
i

77

71148

Observe that despite there being only 77 ones at the start of the list, and the list in its entirety being only 1000 elements long, Replace performs over 71 thousand element tests. This makes no sense but it is an old problem that I have complained about before.

Improve this answer
$\endgroup$
3
$\begingroup$ 
l = {0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1}
LengthWhile[l[[LengthWhile[l, # != 1 &] + 1 ;;]], # == 1 &]
(* 4 *)

Edit:

and this is dedicated to that special person:

k = LengthWhile;
l[[l~k~(# != 1 &) + 1 ;;]]~k~(# == 1 &)
(* 4 *)
Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ And it's not even Christmas! :o) $\endgroup$
    – Mr.Wizard
    Commented Oct 30, 2014 at 10:35
3
$\begingroup$

For what it's worth, a much better pattern (time complexity of order n instead of n^2), but still with a similar problem that Mr. Wizard pointed out. It is perhaps interesting to wonder about the difference between these two patterns.

Replace[list, {x__, Except[First[list]], ___} :> Length[{x}]] /. y_List :> Length[y]

First version (time complexity of order n^2):

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

Replace[list, {y : Longest@Repeated[x_], ___} :> Length[{y}]]
(* 4 *)

Mr. Wizard's comparison:

Needs["GeneralUtilities`"]

f1[a_] := LengthWhile[a, MatchQ@First@a]
f2[list_] := Replace[list, {y : Longest@Repeated[x_], ___} :> Length[{y}]]
f3[list_] := Replace[list, {x__, Except[First[list]], ___} :> Length[{x}]] /. y_List :> Length[y]

g = (SeedRandom[0]; Clip @ RandomInteger[100, #]) &;  (*first zero at position 78*)

BenchmarkPlot[{f1, f2, f3}, g, 2^Range[20],
  "IncludeFits" -> True, TimeConstraint -> 30]

Mathematica graphics

It is interesting that Longest is super-fast when the list is shorter than 77 and consists of all ones. It's too bad that a final BlankNullSequence[] does not short-circuit the pattern-matching.

Improve this answer
$\endgroup$
8
  • $\begingroup$ Michael, I see that you added timings to your post. In your example your method is faster but on other simple tests I found it to be extremely slow. For example with SeedRandom[0]; list = RandomInteger[1, 5*^4]; Replace takes 8.9 seconds where LengthWhile takes 0.000136 seconds. I need to explore this further but I believe it is another exhibit of the poorly optimized nature of patterns in Mathematica. $\endgroup$
    – Mr.Wizard
    Commented Oct 31, 2014 at 20:53
  • $\begingroup$ Please see the addendum to my question. I believe that your method would be just as fast as mine (if not faster) if the pattern engine worked properly but sadly it does not. $\endgroup$
    – Mr.Wizard
    Commented Oct 31, 2014 at 21:22
  • $\begingroup$ @Mr.Wizard Oh gee, and here I thought I making a fair comparison by making it count high. I had a nagging feeling that there was something wrong about patterns & speed, but I couldn't recall. I just didn't do the right tests. $\endgroup$
    – Michael E2
    Commented Oct 31, 2014 at 21:43
  • $\begingroup$ @Mr.Wizard Since the community hasn't found the answer useful anyway, I'll probably delete. I suppose it's list-manipulation fatigue. Originally I just thought here's different a way. When the original was ignored, I had to decide whether to respond to the change in the question. I did the timings to see how bad it was and was surprised. $\endgroup$
    – Michael E2
    Commented Oct 31, 2014 at 22:07
  • 1
    $\begingroup$ @Mr.Wizard I found a better pattern but the problem with pattern matching remains. Please see update, if you're interested. $\endgroup$
    – Michael E2
    Commented Nov 2, 2014 at 14:28
2
$\begingroup$

Update 2: Based on OP's latest clarification:

lfF = With[{x = First@#}, LengthWhile[#, # == x &]] &

lfF@{1, 1, 1, 1, 0, 0, 0, 1, 1, 1}
(* 4 *)

lfF@{0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1}
(* 2 *)

or

lfF2 = Length@First@Split@# &;

lfF2@{1, 1, 1, 1, 0, 0, 0, 1, 1, 1}
(* 4 *)

lfF2@{0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1}
(* 2*)

Update: Per comments on the original version, revised to account for lists that do not start with 1:

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

Length@First@Select[Split[list], First@# == 1 &, 1]
(* 4 *)

Length@First@Split[Flatten[Position[list, 1]], #2 - #1 <= 1 &]
(* 4 *)

First@Cases[list, {Except[1] ... , x : Longest[1 ..], ___} :> Length[{x}], {0}]
(* 4 *)

Original post:

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

Length@First@Split[list]
(* 4 *)

LengthWhile[list, # == 1 &]
(* 4 *)
Improve this answer
$\endgroup$
0
1
$\begingroup$

I want to thank everybody for their answers! I wanted to post an answer I saw in another question here on MSE but I can't seem to find it right now, but this was the solution that worked the simplest:

Length[Split[LIST][[1]]]

So Using Split partitions the list as I wanted, and then I can just take the first element of that partitioned list, and find the length of it. So here is a sample:

list = {1, 1, 1, 1, 1, 2, 4, 5, 5, 5, 5, 1, 1, 1, 1, 1}

Length[Split[list][[1]]]

gives

{1, 1, 1, 1, 1, 2, 4, 5, 5, 5, 5, 1, 1, 1, 1, 1}

5

As desired. Again I didn't come up with this; I saw it somewhere else and I would like to link to it, but cannot find it.

Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ This is clean and concise but be aware that it is quite inefficient on long lists as it splits the entire list even if you are only interested in a few elements at the beginning. $\endgroup$
    – Mr.Wizard
    Commented Oct 30, 2014 at 9:32
  • $\begingroup$ You're absolutely right. I just wanted something I could put into one line as minimally as possible so I could use it in a recursive function I was making. $\endgroup$
    – Sultan of Swing
    Commented Oct 30, 2014 at 9:49
  • $\begingroup$ It doesn't take much more code to "do it right" -- please see my just-posted answer. $\endgroup$
    – Mr.Wizard
    Commented Oct 30, 2014 at 9:50
1
$\begingroup$

... If your list 

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

was a String :

mystring = (StringJoin @@ ToString /@ list)
(* 1111000111 *)

you could also do :

StringCases[mystring, s : (StartOfString ~~ (x_) ..) :> StringLength@s][[1]]
(* 4 *)

or

StringPosition[mystring, (StartOfString ~~ (x_) ..)][[1, -1]]
(* 4 *)

It is also fast because it just searchs the "start of the string".

Edit: Benchmarking 

Needs["GeneralUtilities`"];
f1s[st_] := StringCases[st, s : (StartOfString ~~ (x_) ..) :> StringLength@s][[1]];
f2s[st_] := StringPosition[st, (StartOfString ~~ (x_) ..)][[1, -1]];
gs = (SeedRandom[0]; StringJoin @@ ToString /@ Clip@RandomInteger[100, #]) &;

then

BenchmarkPlot[{f1s, f2s}, gs, 2^Range[15], "IncludeFits" -> True, TimeConstraint -> 30]

gives a log(n) behaviour

enter image description here

whereas for longer lists ...

BenchmarkPlot[{f1s, f2s}, gs, 2^Range[20], "IncludeFits" -> True, TimeConstraint -> 30]

enter image description here

For relative time comparison here is what I get for the benchmarking of the other posts :

enter image description here

Update : for integers > 9

In the original post, I did not take into account (as remarked in the comment) that the list could contain integers >9 ... (however all the benchmarking and examples in the proposed answers do not treat this case).

Anyway, let's take the proposed list in the comment :

list = {1, 1, 111, 1111, 11111, 2, 3};

and transform it into a "useful" string

mystring = " " <> StringDrop[ToString@list, 1]
(* 1, 1, 111, 1111, 11111, 2, 3}*)

(*you could also test directly :*)
(*mystring="1,1,111,1111,11111,2,3"*)

then

StringCases[mystring, a : (StartOfString ~~ Shortest[(x__) ~~ ","] ..) :> 
StringLength@a/(StringLength@x + 1)][[1]]
(*2*)

does the job and should be fast because it focuses on the start of the string.

Of course, the question was not about strings, but I thought it was interesting to extend and test ;)

Improve this answer
$\endgroup$
5
  • $\begingroup$ What if my list is {1, 1, 111, 1111, 11111, 2, 3}? $\endgroup$
    – rm -rf ♦
    Commented Oct 31, 2014 at 4:04
  • $\begingroup$ @rm-rf ? What do you mean ? What result would you expect here ? $\endgroup$
    – SquareOne
    Commented Oct 31, 2014 at 9:25
  • $\begingroup$ He is pointing out the fact that you cannot simply concatenate numbers while preserving their individual identity. If you were to concatenate {1, 1, 111, 1111, 11111, 2, 3} you would get a result of fourteen when the actual result should be two. $\endgroup$
    – Mr.Wizard
    Commented Oct 31, 2014 at 21:23
  • $\begingroup$ @rm-rf please see my update $\endgroup$
    – SquareOne
    Commented Nov 2, 2014 at 1:17
  • $\begingroup$ @Mr.Wizard Please, see my update and benchmarking. $\endgroup$
    – SquareOne
    Commented Nov 3, 2014 at 2:26
0
$\begingroup$ 
list = {0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1};

Using RotateLeftUntil by Sander Huisman

RotateLeftUntil = ResourceFunction["RotateLeftUntil"];

LengthWhile[
 RotateLeftUntil[list, EqualTo[1]],
 EqualTo[1]]

4

Using SequenceSplit (new in 11.3)

Length @ First @ SequenceSplit[list, {Except[1] ..}]

4

Improve this answer
$\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.