15
$\begingroup$

How it is possible to find the length of the longest sequence of zeros in list

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

which is equal to 4 in the sample list above

Improve this question
$\endgroup$
1
  • 2
    $\begingroup$ Another way: SequenceCases[seq, {p : Repeated[0]} :> Length[{p}]] // Max (too similar to others, and to docs, to post as answer). $\endgroup$
    – user1066
    Jul 30, 2018 at 9:29

8 Answers 8

Reset to default
15
$\begingroup$

Assuming it is a binary sequence, one way is to look at all the differences in the positions of the 1s and take the largest:

seq = {1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1};
Max[Differences[Position[seq, 1]]] - 1
4

As pointed out in the comments by jkuczm and Hector, this will fail if the longest sequence of zeros occurs at either the start or the end. This can be fixed by surrounding the sequence with 1s:

Max[Differences[Position[Flatten@{1, seq, 1}, 1]]] - 1
Improve this answer
$\endgroup$
4
  • 3
    $\begingroup$ I must say this is an awful lot faster than using patterns! 0.000115 seconds for this vs 0.221 for my implementation of patterns in a list of 500 integers. $\endgroup$
    – Carl Lange
    Jul 29, 2018 at 23:20
  • 2
    $\begingroup$ There are more assumptions for this to work. You need at least two 1s and longest sequence of zeros can't start at first element. So it'll fail e.g. for {1, 0, 0, 0} or {0, 0, 0, 1, 0, 1}. $\endgroup$
    – jkuczm
    Jul 30, 2018 at 9:40
  • $\begingroup$ The assumptions are easy to satisfy: Max[Differences[Position[Join[{1,1},seq], 1]]] - 1 $\endgroup$
    – Hector
    Jul 30, 2018 at 10:50
  • $\begingroup$ @Hector it still fails for {1, 0, 0, 0}. I guess that correct assumption is not that "longest sequence of zeros can't start at first element" as I've written before, but that sequence of zeros, to be counted, should be surrounded by 1s. So 1 should be added at beginning and at end as in current version of answer by kglr: Max[Differences[Position[Join[{1}, seq, {1}], 1]]] - 1. $\endgroup$
    – jkuczm
    Jul 30, 2018 at 14:38
15
$\begingroup$ 
Max@FoldList[If[#2 == 0, #1 + 1, 0] &, 0, seq]
Improve this answer
$\endgroup$
12
$\begingroup$

If you need speed and are only using packable arrays you could use a compiled function. Function generator returning compiled functions, performing desired operation can look like this:

compileLongestSeqLen // ClearAll
compileLongestSeqLen[
  {type_, rank_Integer /; rank >= 1}, inSeqQ_, opts : OptionsPattern@Compile
] := Compile[{{list, type, rank}},
  Module[{len = 0, longest = 0},
    Do[
      If[inSeqQ@x,
        ++len;
      (* else *),
        If[len > longest, longest = len];
        len = 0;
      ]
      ,
      {x, list}
    ];
    If[len > longest, longest = len];
    longest
  ],
  opts
]

Let's compile function finding length of longest sequence of zeros in list of integers:

jkuczm = compileLongestSeqLen[{_Integer, 1}, # === 0 &,
  RuntimeOptions -> "Speed", CompilationTarget -> "C",
  RuntimeAttributes -> {Listable}, Parallelization -> True
]

To compare efficiency let's define functions from other answers:

alan = Max@FoldList[If[#2 == 0, #1 + 1, 0] &, 0, #] &;
billSHect1 = Max[Differences[Position[Flatten@{1, #, 1}, 1]]] - 1 &;
billSHect2 = Max[Differences[Position[Join[{1}, #, {1}], 1]]] - 1 &;
carlL = # /. {___, a : Longest[Repeated[0]], ___} :> Length[{a}] &;
chyanog1 = GroupBy[Split[#], First -> Length, Max][0] &;
chyanog2 = (# // Split // Select[MemberQ[0]] // Map[Length] // Max) &;
joe = (SortBy[Split[#], Length] // Last // Length) &;
kglr1 = Max[Differences@PositionIndex[Join[{1}, #, {1}]][1]] - 1 &;
kglr2 = Max[Length /@ Split@Accumulate[Join[{1}, #, {1}]]] - 1 &;
maxZeros[a_List] := Max[Append[# - 1, Length@a] - Prepend[#, 0]] &@SparseArray[a]["AdjacencyLists"]
okkes = (Length /@ Split[#] // Max) &;

Timings for single large list:

SeedRandom@0
test = RandomInteger[{0, 1}, 10^6];

(*carlLRes = carlL@test; // MaxMemoryUsed // RepeatedTiming*)   (*too slow*)
chyanog2Res = chyanog2@test; // MaxMemoryUsed // RepeatedTiming (*{0.62,  44510360}*)
(*joeRes = joe@test; // MaxMemoryUsed // RepeatedTiming*)       (*incorrect results*)
chyanog1Res = chyanog1@test; // MaxMemoryUsed // RepeatedTiming (*{0.36,  64019000}*)
billSRes1 = billSHect1@test; // MaxMemoryUsed // RepeatedTiming (*{0.33, 119935248}*)
billSRes2 = billSHect2@test; // MaxMemoryUsed // RepeatedTiming (*{0.31, 119934952}*)
kglr2Res = kglr2@test; // MaxMemoryUsed // RepeatedTiming       (*{0.26,  75941464}*)
(*okkesRes = okkes@test; // MaxMemoryUsed // RepeatedTiming*)   (*incorrect results*)
kglr1Res = kglr1@test; // MaxMemoryUsed // RepeatedTiming       (*{0.11,  44568024}*)
alanRes = alan@test; // MaxMemoryUsed // RepeatedTiming         (*{0.063, 40008744}*)
mrWizRes = maxZeros@test; // MaxMemoryUsed // RepeatedTiming    (*{0.0273 17126232}*)
jkuczmRes = jkuczm@test; // MaxMemoryUsed // RepeatedTiming     (*{0.0047,      56}*)

(*carlLRes ===*) chyanog2Res === (*joeRes ===*) chyanog1Res === billSRes1 === billSRes2 === kglr2Res === (*okkesRes ===*) kglr1Res === alanRes === mrWizRes === jkuczmRes
(* True *)

Timings for multiple lists:

SeedRandom@0
test = RandomInteger[{0, 1}, {100, 10^5}];

(*carlLRes=carlL/@test;//MaxMemoryUsed//RepeatedTiming*)           (*too slow*)
chyanog2Res = chyanog2 /@ test; // MaxMemoryUsed // RepeatedTiming (*{6.3,  84491416}*)
(*joeRes = joe /@ test; // MaxMemoryUsed // RepeatedTiming*)       (*incorrect results*)
chyanog1Res = chyanog1 /@ test; // MaxMemoryUsed // RepeatedTiming (*{3.46, 86460488}*)
billSRes1 = billSHect1 /@ test; // MaxMemoryUsed // RepeatedTiming (*{3.29, 92106568}*)
kglr2Res = kglr2 /@ test; // MaxMemoryUsed // RepeatedTiming       (*{2.68, 87630888*)
(*okkesRes = okkes /@ test; // MaxMemoryUsed // RepeatedTiming*)   (*incorrect results*)
kglr1Res = kglr1 /@ test; // MaxMemoryUsed // RepeatedTiming       (*{1.12, 84780440}*)
alanRes = alan /@ test; // MaxMemoryUsed // RepeatedTiming         (*{0.379, 2409680}*)
billSRes2 = billSHect2 /@ test; // MaxMemoryUsed // RepeatedTiming (*{0.24,  2400320}*)
mrWizRes = maxZeros /@ test; // MaxMemoryUsed // RepeatedTiming    (*{0.22, 81755512}*)
jkuczmRes = jkuczm@test; // MaxMemoryUsed // RepeatedTiming        (*{0.030, 1602456}*)

(*carlLRes ===*) chyanog2Res === (*joeRes ===*) chyanog1Res === billSRes1 === kglr2Res === (*okkesRes ===*) kglr1Res === alanRes === billSRes2 === mrWizRes === jkuczmRes
(* True *)
Improve this answer
$\endgroup$
8
$\begingroup$

This is relatively straightforward using patterns.

l /. {___, a : Longest[Repeated[0]], ___} :> Length[{a}]

That is, name list a the Longest list of Repeated zeroes bounded on either side by anything not a zero (the ___ matches none or more of anything), and then get the Length of that list a.

The Patterns documentation will help you a lot here.

Improve this answer
$\endgroup$
6
$\begingroup$ 
GroupBy[Split[seq], First -> Length, Max][0]

or

seq // Split // Select[MemberQ[0]] // Map[Length] // Max
Improve this answer
$\endgroup$
4
$\begingroup$ 
f1 = Max[Differences @ PositionIndex[Join[{1}, #, {1}]][1]] - 1&;
f2 = Max[Length /@ Split @ Accumulate[Join[{1}, #, {1}]]] - 1 &;


list1 = {1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1};
list2 = {0, 0, 0, 0,  0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1};

f1 @ list1

4

f1 @ list2

6

f2 @ list1

4

f2 @ list2

6

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ First implementation, as in bill s answer, will fail if there are less than two 1s. Both will fail if longest sequence of zeros starts with first element. $\endgroup$
    – jkuczm
    Jul 30, 2018 at 9:47
  • $\begingroup$ Thank you again @jkuczm. Was able to salvage both with a minor tweak. $\endgroup$
    – kglr
    Jul 30, 2018 at 10:54
  • 1
    $\begingroup$ I think that f1 is now correct. f2 fails if there's 0 as first element, but it's not part of longest sequence of 0s, e.g. f2@{0, 1, 0, 0} (* 3 *). $\endgroup$
    – jkuczm
    Jul 30, 2018 at 14:47
3
$\begingroup$

I'm not a Mathematica user, but in several other languages I generalized this to (run-length encoding)

rle(x==0)

which eliminates the requirement that x be only 1 or zero.

(EDIT by corey979)

As per Karsten's comment, the rle can be implemented in MMA as

RunLengthEncode[x_List] := {First[#], Length[#]}& /@ Split[x]
Improve this answer
$\endgroup$
2
3
$\begingroup$

At least in Mathematica 10.1 we can improve on bill s's solution by an order of magnitude using SparseArray Properties as I did for Find subsequences of consecutive integers inside a list.

My proposal:

maxZeros[a_List] := 
  Max[Append[# - 1, Length@a] - Prepend[#, 0]] & @ SparseArray[a]["AdjacencyLists"]

Timings:

Needs["GeneralUtilities`"]

f1[a_] := Max[Differences[Position[Flatten@{1, a, 1}, 1]]] - 1

BenchmarkPlot[{f1, maxZeros}, RandomInteger[1, #] &]

enter image description here

Improve this answer
$\endgroup$

Your Answer

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

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