# Find the longest sequence of "1" in a matrix row, and its position

I would like to find the longest sequence of "1" (consecutive ones) in rows of a matrix; moreover, I would like to know the position of this sequence in the matrix .

Example:

Input :

M ={{1, 1, 0, 0, 1}, {1, 0, 0, 0, 1}, {0, 1, 0, 1, 0},
{0, 0, 0, 1, 0}, {0, 0, 1, 0, 0}, {0, 1, 1, 0, 0},
{1, 0, 1, 1, 1}}


Output expected

row : 7 Column: 3 to 5

Or a similar result with the same information.

• Aug 3 at 20:01
• Also related: Find longest sequence of zeros in list ((SequenceCases[#, {p : Repeated[1]} :> Length[{p}]])&/@m//Max gives max value (see documentation for SequenceCases)) Aug 3 at 20:38

Update: Yet another way:

ClearAll[pos]
pos = First @ MaximalBy[Length@*Last] @
GroupBy[Position[#, 1 .., All], First,
{#[[1, 1]], First@MaximalBy[Length]@Split[#[[2]], #2 == # + 1 &]} & @* Transpose] &;

pos @ M

{7, {3, 4, 5}}

MapThread[Row[{##}, ": "] &, {{"row", "columns"}, pos @ M}]

{"row": 7, "columns": {3,4,5}}

Extract[M, {First @ pos @ M}]

{1, 0, 1, 1, 1}


m = First @ MaximalBy[Max @* Cases[a : {1 ..} :> Length @ a] @* Split] @ M

{1, 0, 1, 1, 1}

mrow = First @ Flatten @ Position[M, m]

 7

mcols = First @ MaximalBy[Length] @ Split[#, #2 == # + 1 &] & @ Flatten[Position[m, 1]]

{3, 4, 5}


Alternatively,

ClearAll[f1, f2]
f1 = First @* MaximalBy[Differences @* Last] @*
Map[{#, First @ MaximalBy[Differences] @
First @ LongestCommonSequencePositions[#, ConstantArray[1, Length@#]]} &];

f2 = {First @ #, First @ Flatten @ Position[M, First @ #], Span @@ #[[2]]} &;

f1 @ M

{{1, 0, 1, 1, 1}, {3, 5}}

f2 @ f1 @ M

{{1, 0, 1, 1, 1}, 7, 3 ;; 5}

• Thank you @kglr for your answer. I would like to avoid the notations "@" "@*". Is it possible for you to send me the line : m = First @ MaximalBy[Max @* Cases[a : {1 ..} :> Length @ a] @* Split] @ M Without the "@" and "@*" ? Aug 5 at 10:03
• @Yassin, try m = First[ MaximalBy[Max[Cases[a : {1 ..} :> Length[a]][Split[#]]] &][M]] or m = First[ MaximalBy[Composition[Max, Cases[a : {1 ..} :> Length[a]], Split]][M]]
– kglr
Aug 5 at 10:10
• @kglr a small question I m still impressed when I see as much of nested or composed functions. How do you think about it when you are looking for the solution ? Do you get this solution immediately or do you test little part by little part and once it is working you combine it a single line. Personally, I like the fonction which is more readable as I am a beginner. Moreover it is easyier for me to understand again the code when I need to do it later after. Another point, would it be possible for you to decompose again the solution you have just suggested to Yassin ? Aug 5 at 12:30
• @kglr i would have appreciated if you can suggest your solution with your function writing on several lines with one operation done by line and some Print function for each line so that I can manage to understand all the steps which are conducted Aug 5 at 12:34
• @Bendesarts, try Needs["GeneralUtilities"]; HoldPrettyForm[First@MaximalBy[Length@*Last]@ GroupBy[Position[#, 1 .., All], First, {#[[1, 1]], First@MaximalBy[Length]@Split[#[[2]], #2 == # + 1 &]} &@* Transpose] &]
– kglr
Aug 11 at 21:14

The following gives a list of solutions, since there may be more than one maximal run. A solution has the form of the positions of a maximal run. Assumes a 0/1 matrix.

mat = {{1, 1, 0, 0, 1}, {1, 0, 0, 0, 1}, {0, 1, 0, 1, 0}, {0, 0, 0, 1, 0},
{0, 0, 1, 0, 0}, {0, 1, 1, 0, 0}, {1, 0, 1, 1, 1}};

SparseArray[mat]["NonzeroPositions"] //
Split[#, #2 - #1 == {0, 1} &] & //
MaximalBy[Length]
% // #[[All, {1, -1}]] & (* cut out middle (optional) *)

(*
{
{{7, 3}, {7, 4}, {7, 5}}
}
{ {{7, 3}, {7, 5}} }
*)


Example with two maximal runs:

mat = {{1, 1, 0, 0, 1}, {1, 0, 0, 0, 1}, {0, 1, 0, 1, 0}, {0, 0, 0, 1, 0},
{0, 0, 1, 0, 0}, {0, 1, 1, 1, 0}, {1, 0, 1, 1, 1}};

(* output of same code as above:
{
{{6, 2}, {6, 3}, {6, 4}},
{{7, 3}, {7, 4}, {7, 5}}
}
*)


To find all the lengths

Split /@ M
Length[Select[#, Total@# == 0 &]] & /@ %


position of each

Split /@ M
Select[#, Total@# == 0 &] & /@ %
SequencePosition[M[[#]], Flatten[%[[1]]]] & /@ Range[Length[M]]


For larger lists you might be able to speed it up with SpareArray

SparseArray[M - 1]["NonzeroPositions"]
Split[%, First]

m = {{1,1,0,0,1},{1,0,0,0,1},{0,1,0,1,0},{0,0,0,1,0},{0,0,1,0,0},{0,1,1,0,0},{1,0,1,1,1}};

row = First@Position[#, Max[#]] &@
Map[Max[SequenceCases[#, {p : Repeated[1]} :> Length[{p}]]]&, m]
cols = TakeLargestBy[SequencePosition[Extract[m, row], {Repeated[1]},
Overlaps -> False], Norm, 1];
TemplateApply["Row :  Column :  to ", Flatten[{row, cols}]]
`

row: 7 Column : 3 to 5