Find the identical rows in a matrix
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