Hcfyk

Suppose I have the following matrix:

M = 

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

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

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

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

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

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

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

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



TableForm[M, TableHeadings -> {{S1, S2, S3, S4, S5, S6, S7, S8}}]

In this case, it turns out that rows (S1, S8), (S2, S3, S4), (S5, S6, S7) have equal element values in identical column positions. I have a 1000 x 1000 matrix to examine and would appreciate any assistance in coding this problem.

I'd use GroupBy.

First the names of the rows: can be anything you like, for example

rownames = Array[ToExpression["S" <> ToString[#]] &, Length[M]]

{S1, S2, S3, S4, S5, S6, S7, S8}

Next the grouping:

groups = GroupBy[Thread[rownames -> M], Last -> First]

<|{0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} -> {S1, S8},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0} -> {S2, S3, S4},
{0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0} -> {S5, S6, S7}|>

If all you need are the names:

Values[groups]

{{S1, S8}, {S2, S3, S4}, {S5, S6, S7}}

idx = DeleteDuplicates[Sort /@ Nearest[M -> Automatic, M, {∞, 0}]]

{{1, 8}, {2, 3, 4}, {5, 6, 7}}

In order to obtain the labels of the rows, you may use the following:

labels = {S1, S2, S3, S4, S5, S6, S7, S8};

Map[labels[[#]] &, idx, {2}]

{{S1, S8}, {S2, S3, S4}, {S5, S6, S7}}

The function positionDuplicates from How to efficiently find positions of duplicates? does the job, faster than Nearest.

(* Henrik's method *)

posDupes[M_] := DeleteDuplicates[Sort /@ Nearest[M -> Automatic, M, {∞, 0}]]



SeedRandom[0];  (* to make a reproducible 1000 x 1000 matrix *)

foo = Nest[RandomInteger[1, {1000, 1000}] # &, 1, 9];



d1 = Cases[positionDuplicates[foo], dupe_ /; Length[dupe] > 1]; // RepeatedTiming

(*  {0.017, Null}  *)



d2 = Cases[posDupes[foo], dupe_ /; Length[dupe] > 1]; // RepeatedTiming

(*  {0.060, Null}  *)



d1 == d2

(*  True  *)



d1

(*

  {{25, 75, 291, 355, 356, 425, 475, 518, 547, 668, 670, 750, 777},

   {173, 516}, {544, 816}, {610, 720}}

*)

While this question repeats a previous query about finding DuplicatePositions, the duplicates here are amongst a list of binary vectors in contrast to the original duplicates occurring amongst a list of numbers. As illustrated in an answer to the original query however, the type, depth and distribution of inputs can significantly impact efficiency so there may well be further optimizations specific to this case of finding duplicates amongst binary vectors. The following summarises timings of the "superfunction" DuplicatePositions (collected and defined from answers to the original question - in particular Szabolcs, Carl Woll and Mr.Wizard), postionDuplicates (the fastest solutions for numbers from Szabolcs) and a tweeking in the "UseGatherByLocalMap" Method option (from Carl Woll), the accepted groupBy answer (by Roman) and the nearest answer (by Henrik Schumacher) for various types of binary vectors. I've contributed the "UseOrdering" Method in DuplicatePositions.

duplicatePositionsByOrdering[ls_]:= SplitBy[Ordering@ls, ls[[#]] &] // SortBy[First]

which seems to do well for sparse vectors (a more succinct version of similar ideas used by Mr.Wizard and Leonid Shifrin in their anwers). Note that a random 1000x1000 binary matrix is very likely to be sparse to the point of no (row) duplicates occurring so presumably in the OP's situation the authentic data is not randomly generated and instead includes manufactured repeats. To the timings (the tag function just puts in the S1, S2 ... tags as originally requested and the tick indicates identical output):

Obviously timings aren't everything as short-clear functions can often be preferable (as well as potentially being more efficient for different inputs) but it can also sometimes be illuminating--here for example, indicating that GroupBy seems to recognize order for ragged vectors unlike GatherBy.

The code for the above output is below

SetAttributes[benchmark, HoldAll];



benchmark[functions_, opts : OptionsPattern] := 

  Function[input, benchmark[functions, input, opts], HoldAll];



benchmark[functions_, input_, OptionsPattern] := Module[{

    tm = Function[fn, 

      Function[x, <|ToString[fn] -> RepeatedTiming@fn@x|>]],

    timesOutputs, times},

   SeedRandom@0;

   timesOutputs = Through[(tm /@ functions)@input];

   times = 

    SortBy[Query[All, All, First]@timesOutputs, Last] // Dataset;

   If[OptionValue@"CheckOutputs", 

    Labeled[times, 

     Row[{ToString@Unevaluated@input, Spacer@80, 

       If[SameQ @@ (Query[All, Last, 2]@timesOutputs), 

        Style["[Checkmark]", Green, 20], Style["x", Red, 20]]}], 

     Top], times]

   ];



Options[benchmark] = {"CheckOutputs" -> True};



Options[DuplicatePositions] = {Method -> Automatic};



DuplicatePositions[ls_, OptionsPattern] := 

  With[{method = OptionValue[Method]},

   Switch[method,

    "UseGatherBy", GatherBy[Range@Length@ls, ls[[#]] &],

    "UsePositionIndex", Values@PositionIndex@ls,

    "UseOrdering", SplitBy[Ordering@ls, ls[[#]] &] // SortBy[First],

    "UseGatherByLocalMap", Module[{func}, func /: Map[func, _] := ls;

     GatherBy[Range@Length@ls, func]],

    Automatic, Which[

     ArrayQ[ls, 1, NumericQ], 

     DuplicatePositions[ls, "Method" -> "UseGatherBy" ],

     ArrayQ[ls, 2, NumericQ], DuplicatePositionsBy[ls, FromDigits],

     MatchQ[{{_?IntegerQ ..} ..}]@ls, 

     DuplicatePositionsBy[ls, FromDigits],

     True, DuplicatePositions[ls, Method -> "UsePositionIndex" ]

     ]]];



DuplicatePositionsBy[ls_, fn_, opts : OptionsPattern] := 

  DuplicatePositions[fn /@ ls, opts];



tag = Map["S" <> ToString@# &, #, {-1}] &;

positionDuplicates[ls_] := GatherBy[Range@Length@ls, ls[[#]] &];

groupBy[M_] := With[

   {rownames = Array["S" <> ToString[#] &, Length[M]]},

   Values@GroupBy[Thread[rownames -> M], Last -> First]];

nearest[M_] := 

  DeleteDuplicates[

   Sort /@ Nearest[M -> Automatic, M, {[Infinity], 0}]];

n = 10^4;

binaryVectors50k = 

  IntegerDigits[#, 2, 13] & /@ RandomInteger[n, 5*n];

fns = {

   groupBy,

   (nearest@# // tag) &,

   (DuplicatePositions@# // tag) &,

   (DuplicatePositionsBy[#, FromDigits[#, 2] &, 

       Method -> "UseGatherByLocalMap"] // tag) &,

   (positionDuplicates@# // tag) &

   };

benchmark[fns]@binaryVectors50k

n = 10^3;

binaryVectorsRagged5k = IntegerDigits[#, 2] & /@ RandomInteger[n, 5*n];

fns = {

   groupBy,

   (DuplicatePositions@# // tag) &,

   (DuplicatePositionsBy[#, FromDigits[#, 2] &, 

       Method -> "UseGatherByLocalMap"] // tag) &,

   (positionDuplicates@# // tag) &

   };

benchmark[fns]@binaryVectorsRagged5k



n = 10^4;

binaryVectorsSparse10k := RandomInteger[1, {n, n}];

fns = {

   (DuplicatePositions@# // tag) &,

   (positionDuplicates@# // tag) &,

   (DuplicatePositions[#, Method -> "UseOrdering"] // tag) &,

   groupBy};

benchmark[fns]@binaryVectorsSparse10k