6
$\begingroup$

I have nested lists which consist of a series of 1s followed by a series of 0s.

p = Table[PerfectNumber[n], {n, 5}];
i = IntegerDigits[p, 2]

which results in:

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

Now I want a list which gives me the maximum number of consecutive 1s in each of the lists (yes, I realize that in the given example they're all consecutive, but I'm interested in a more generic solution):

{2, 3, 5, 7, 13}

How can I achieve this?

$\endgroup$

5 Answers 5

4
$\begingroup$

Using LongestCommonSubsequence

(* borrowing eldo's list *)

list =
  {{1, 1, 2, 1},
   {1, 1, 1, 0, 3, 1},
   {4, 1, 1, 1, 1, 1, 0, 1, 1}};

Length@LongestCommonSubsequence[#, Cases[1]@#] & /@ list 

{2, 3, 5}

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

Count[1] /@ list

{2, 3, 5, 7, 13}

To answer the appended question: Maximum number of consecutive 1s in each of the lists

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

ones = SequenceSplit[#, {0}] & /@ list

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

Max /@ Map[Length, ones, {2}]

{2, 3, 5}

A more general solution using Except

list =
  {{1, 1, 2, 1},
   {1, 1, 1, 0, 3, 1},
   {4, 1, 1, 1, 1, 1, 0, 1, 1}};

  Max /@ Map[Length, SequenceSplit[#, {Except[1]}] & /@ list, {2}]

{2, 3, 5}

$\endgroup$
1
  • 1
    $\begingroup$ Please see the updated answer $\endgroup$
    – eldo
    Commented May 18 at 6:26
5
$\begingroup$

You could also split on the 1-sequences:

Max[SequenceSplit[#, ones : {1 ..} :> Length[ones]]] & /@ list

Or SequenceCases:

Max[SequenceCases[#, ones : {1 ..} :> Length[ones]]] & /@ list

Or use a reducing pattern:

GroupBy[Split[#], First -> Length, Max][1] & /@ list
$\endgroup$
5
$\begingroup$
Max /@ Total[(Split /@ lst), {3}]

(* {2, 3, 5, 7, 13} *)
lst = {{1, 1, 0}, {1, 1, 1, 0, 0}, {1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 
   1}, {1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 
   1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 
   1}}
$\endgroup$
3
$\begingroup$

If we look at your problem in a simplistic manner, we could see a function that increments by receiving 1 and resets by receiving 0 (like multiplying but with an increment). Since we need the result of the previous calculation the Fold family should come to mind:

p = Table[PerfectNumber[n], {n, 5}];
i = IntegerDigits[p, 2];

Function[x, Max[FoldList[(#1 + 1) * #2 &, x]]] /@ i

(* Out: {2, 3, 5, 7, 13} *)

If we enlarge the input, we could compare different solutions. Here we'll create 1000 lists of zeros and ones with variable lengths:

SeedRandom[4567];
i = Table[RandomInteger[1, RandomInteger[{10, 100}]], 1000];

(* Verifying each list has at least one 1 - some algorithm fail in the absence *)
Min[Total /@ i]
(* Out: 3 *)
Repeated Timing Max Memory Usage
FoldList[ ... 0.038378 66472
vindobona's Length[ LongestCommonSubsequence[ ... 0.018285 69088
user1066's Max /@ Total[ .... 0.046171 2110792
lericr's Max[ SequenceSplit[ ... 4.27892 279952
lericr's Max[ SequenceCases[ ... 4.553 350896
lericr's GroupBy[ Split[ ... 0.022229 70200
eldo's Max /@ Map[ ... 0.217163 3346872

All produce the same result.

Since we are using primitive operations, one would be tempted to see the possibilities of the new compiler (Version 12.0+ is required):

fn = FunctionCompile[
   Function[Typed[x, "NumericArray"::["Integer64", 1]], 
    Max@FoldList[(#1 + 1)*#2 &, x]]];


fn /@ i; // MaxMemoryUsed // RepeatedTiming

(* Out: {0.00088907, 66240} *)

It's around 20 times faster than the previous fastest solution!

Benchmark was done on Mathematica 14.0.0 on Windows 11.

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