7
$\begingroup$

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.

$\endgroup$
2
3
$\begingroup$

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]
 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}
$\endgroup$
5
  • $\begingroup$ 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 "@*" ? $\endgroup$
    – Yassin
    Aug 5 at 10:03
  • $\begingroup$ @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]] $\endgroup$
    – kglr
    Aug 5 at 10:10
  • $\begingroup$ @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 ? $\endgroup$
    – Bendesarts
    Aug 5 at 12:30
  • $\begingroup$ @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 $\endgroup$
    – Bendesarts
    Aug 5 at 12:34
  • $\begingroup$ @Bendesarts, try Needs["GeneralUtilities`"]; HoldPrettyForm[First@MaximalBy[Length@*Last]@ GroupBy[Position[#, 1 .., All], First, {#[[1, 1]], First@MaximalBy[Length]@Split[#[[2]], #2 == # + 1 &]} &@* Transpose] &] $\endgroup$
    – kglr
    Aug 11 at 21:14
2
$\begingroup$

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}}
   }
*)
$\endgroup$
1
$\begingroup$

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]
$\endgroup$
0
$\begingroup$
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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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