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

Question

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.

Related: https://mathematica.stackexchange.com/questions/171114/runs-of-negative-values — Michael E2, Aug 03 '21 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)) — user1066, Aug 03 '21 at 20:38

kglr · Accepted Answer · 2021-08-03T19:34:42.887

3

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}

Original answer:

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

{1, 0, 1, 1, 1}

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

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}

edited Aug 03 '21 at 19:34

answered Aug 03 '21 at 16:59

kglr

394,356
18
477
896

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 "@*" ? – Yassin Aug 05 '21 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 05 '21 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 ? – Bendesarts Aug 05 '21 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 – Bendesarts Aug 05 '21 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 '21 at 21:14

score 2 · Answer 2 · answered Aug 03 '21 at 19:59

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}}
   }
*)

score 1 · Answer 3 · answered Aug 03 '21 at 20:04

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]

score 0 · Answer 4 · answered Aug 03 '21 at 18:34

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

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

4 Answers4