# How to efficiently find positions of duplicates?

Is there an efficient way to find the positions of the duplicates in a list?

I would like the positions grouped according to duplicated elements. For instance, given

list = RandomInteger[15, 20]

{3, 3, 6, 11, 13, 13, 11, 1, 2, 3, 12, 8, 9, 9, 4, 15, 5, 6, 9, 12}


the output should be

positionDuplicates[list]

{{{1}, {2}, {10}}, {{3}, {18}}, {{4}, {7}}, {{5}, {6}}, {{11}, {20}}, {{13}, {14}, {19}}}


Here's my first naive thought:

positionDuplicates1[expr_] :=
Position[expr, #, 1] & /@ First /@ Select[Gather[expr], Length[#] > 1 &]


And my second:

positionDuplicates2[expr_] := Module[{seen, tags = {}},
MapIndexed[
If[seen[#1] === True, Sow[#2, #1],
Sow[seen[#1], #1]; Sow[#2, #1]; seen[#1] = True,
seen[#1] = #2]] &, expr]
]


The first works as desired but is horrible on long lists. In the second, Reap does not return positions in order, so if necessary, one can apply Sort. I feel the work done by Gather is about what it should take for this task; DeleteDuplicates is (and should be) faster.

Here is a summary of timings on a big list.

list = RandomInteger[10000, 5 10^4];
positionDuplicates1[list]; // AbsoluteTiming
positionDuplicates2[list] // Sort; // AbsoluteTiming
Sort[Map[{#[[1, 1]], Flatten[#[[All, 2]]]} &, Reap[MapIndexed[Sow[{#1, #2}, #1] &, list]][[2, All, All]]]] // AbsoluteTiming (* Daniel Lichtblau *)
Select[Last@Reap[MapIndexed[Sow[#2, #1] &, list]], Length[#] > 1 &]; // AbsoluteTiming
positionOfDuplicates[list] // Sort; // AbsoluteTiming (* Leonid Shifrin *)
Module[{a, o, t}, Composition[o[[##]] &, Span] @@@ Pick[Transpose[{Most[ Prepend[a = Accumulate[(t = Tally[#[[o = Ordering[#]]]])[[All, 2]]], 0] + 1], a}], Unitize[t[[All, 2]] - 1], 1]] &[list]; // AbsoluteTiming (* rasher *)
GatherBy[Range@Length[list], list[[#]] &]; // AbsoluteTiming (* Szabolcs *)
Gather[list]; // AbsoluteTiming
DeleteDuplicates[list]; // AbsoluteTiming

{40.186208, Null} (* my #1)
{0.681758, Null} (* my #2)
{0.214085, Null} (* Daniel Lichtblau *)
{0.115021, Null} (* Szabolcs's suggested improvement of my #2 *)
{0.041038, Null} (* Leonid Shifrin *)
{0.027409, Null} (* rasher *)
{0.010322, Null} (* Szabolcs's answer *)
{0.007948, Null} (* Gather - for comparison purposes *)
{0.000199, Null} (* DeleteDuplicates *)

-
Isn't this easier for the Sow/Reap solution? Why is seen necessary? Last@Reap[MapIndexed[Sow[#2, #1] &, list]] – Szabolcs Mar 14 '13 at 19:58
I wanted only the duplicated elements -- I suppose I could delete the singletons afterwards. – Michael E2 Mar 14 '13 at 20:04
Yes, that's probably faster too. Select[result, Length[#] > 1&] or similar. – Szabolcs Mar 14 '13 at 20:05
@Szabolcs Yes, a little more than a 1/3 the time. Thanks. – Michael E2 Mar 14 '13 at 20:07

You can use GatherBy for this. You can map List onto Range[...] first if you wish to have exactly the same output you showed.

positionDuplicates[list_] := GatherBy[Range@Length[list], list[[#]] &]

list = {3, 3, 6, 11, 13, 13, 11, 1, 2, 3, 12, 8, 9, 9, 4, 15, 5, 6, 9, 12}

positionDuplicates[list]

(* ==> {{1, 2, 10}, {3, 18}, {4, 7}, {5, 6}, {8}, {9},
{11, 20}, {12}, {13, 14, 19}, {15}, {16}, {17}} *)


If you prefer a Sow/Reap solution, I think this is simpler than your version (but slower than GatherBy):

positionDuplicates[list_] := Last@Reap[MapIndexed[Sow[#2, #1] &, list]]


If you need to remove the positions of non-duplicates, I'd suggest doing that as a post processing step, e.g. Select[result, Length[#] > 1&]

-
Smart. I don't think this can be beaten. – Sjoerd C. de Vries Mar 15 '13 at 6:53
Your method is faster than the standard decorate method I've been using: GatherBy[{#, Range@Length@#}\[Transpose], First][[All, All, 2]] &. One to add to the toolbox. Thanks! – Mr.Wizard Mar 15 '13 at 11:59
One thing: why not get rid of Module? positionDuplicates[list_] := GatherBy[Range @ Length @ list, list[[#]] &] – Mr.Wizard Mar 15 '13 at 12:01
Thanks. I did look at GatherBy. Gathering the positions somehow seems natural, but I didn't think of it. – Michael E2 Mar 16 '13 at 0:02
Actually, it's not. I've never seen it before, and it didn't occur to me to try it, because for some reason it seemed semantically more complex even if syntactically simpler (so I figured it would be slower). In many cases the best ideas are simple in appearance. The "injector pattern" is very simple yet also very powerful. The step function I worked long to figure out has, IMHO, extensive implications for how we may handle expressions and definitions and is perhaps my best contribution to this site so far, yet it is a couple of lines of code. I give credit where it's due. – Mr.Wizard Mar 16 '13 at 3:26

While reflecting on the method I used for How to get list of duplicates when using DeleteDuplicates? (second answer) it occurred to me that I had the elements for a solution to this question that might be faster than Szabolcs's magnificently clean solution. Indeed I found that in some cases I can beat his function, though in general the common bottleneck of partitioning a list ultimately holds this back.

My code as well as Szabolcs's function again for comparative testing:

diffPos[a_List] := SparseArray[Differences@a, Automatic, 1]["AdjacencyLists"]

posDupsRaw[a_List] := {#, diffPos @ Ordering @ Reverse @ a[[#]]} & @ Ordering @ a

posDups[a_List] :=
posDupsRaw[a] /. {o_, p_} :>
MapThread[Take[o, {##}] &, {Prepend[p + 1, 1], Append[p, -1]}]

positionDuplicates[a_] := GatherBy[Range @ Length @ a, a[[#]] &]


An example of the outputs:

a = {0, 3, 2, 2, 2, 3, 2, 4};
positionDuplicates[a]
posDups[a]
posDupsRaw[a]

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

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

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


We can see that the output of posDups is not in order of first appearance, but otherwise the result is the same; a SortBy[First] would align them. The output of posDupsRaw contains the same information; the first sublist is to be partitioned according to the second, which is exactly what posDups actually does.

Now some timings on a basic integer vector:

SeedRandom[1]
big1 = RandomInteger[1*^6, 1*^6];

positionDuplicates[big1] // Length // RepeatedTiming
posDups[big1]            // Length // RepeatedTiming
posDupsRaw[big1] // Last // Length // RepeatedTiming

{0.706, 632355}

{0.778, 632355}

{0.169, 632354}


In this particular case posDups is reasonably competitive and posDupsRaw is much faster, clearly demonstrating that partitioning is the bottleneck here.

With the right balance of duplication posDups actually beats positionDuplicates:

SeedRandom[1]
big1 = RandomInteger[3*^5, 1*^6];

positionDuplicates[big1] // Length // RepeatedTiming
posDups[big1]            // Length // RepeatedTiming
posDupsRaw[big1] // Last // Length // RepeatedTiming

{0.480, 289165}

{0.445, 289165}

{0.1609, 289164}


My function does even better when the list elements are themselves lists:

SeedRandom[1]
big1 = RandomInteger[500, {1*^6, 2}];

positionDuplicates[big1] // Length // RepeatedTiming
posDups[big1]            // Length // RepeatedTiming
posDupsRaw[big1] // Last // Length // RepeatedTiming

{1.10, 246302}

{0.513, 246302}

{0.2699, 246301}


Unfortunately in a simple list with heavy duplication my method falls well behind:

SeedRandom[1]
big1 = RandomInteger[999, 1*^6];

positionDuplicates[big1] // Length // RepeatedTiming
posDups[big1]            // Length // RepeatedTiming
posDupsRaw[big1] // Last // Length // RepeatedTiming

{0.0524, 1000}

{0.1265, 1000}

{0.1241, 999}

-

In version 10 there is a new function PositionIndex that could be the go-to method for this operation:

a = {3, 3, 6, 11, 13, 13, 11, 1, 2, 3, 12, 8, 9, 9, 4, 15, 5, 6, 9, 12};

Values @ PositionIndex @ a

{{1, 2, 10}, {3, 18}, {4, 7}, {5, 6}, {8}, {9}, {11, 20},
{12}, {13, 14, 19}, {15}, {16}, {17}}


Sadly, as currently implemented its performance is very poor, so it is NOT the go-to method:

positionDuplicates[list_] := GatherBy[Range @ Length @ list, list[[#]] &]

test = RandomInteger[999, 5*^5];

positionDuplicates[test]     // Timing // First

Values @ PositionIndex[test] // Timing // First

0.015600

2.215214


Perhaps in future release this function will live up to its potential.

Update: In 10.0.1 it is indeed far more useful but still not a match for positionDuplicates:

Values @ PositionIndex[test] // Timing // First

0.0524

-
PositionIndex seems to be slightly slower on test2 = Association @ Thread[Range[5*^5] -> test]. (I thought it might be optimized for associations.) +1 for testing out the new function. – Michael E2 Jul 15 '14 at 0:31
@Michael Don't miss: (54853) – Mr.Wizard Jul 15 '14 at 0:33
WTH? Wolfram seems to have screwed the pooch on a few things... I think I'll hold off updating until .01... – ciao Jul 15 '14 at 1:17

Prompted by a comments conversation with Mr. Wizard, a method I use often.

list = RandomInteger[1000, 100];

Module[{a, o, t},
Composition[o[[##]] &, Span] @@@
Pick[Transpose[{Most[Prepend[a = Accumulate[(t = Tally[#[[o = Ordering[#]]]])
[[All, 2]]], 0] + 1], a}], Unitize[t[[All, 2]] - 1], 1]] &[list]

list[[#]] & /@ %

(*
{{47, 53}, {72, 89}, {18, 58}, {20, 56}}

{{699, 699}, {738, 738}, {829, 829}, {962, 962}}
*)


Searches are at the top-level of the list, and only duplicate positions are returned so no need for further parsing.

Smallish lists with mostly duplicates / dense duplicates sees GatherBy with similar or somewhat faster performance, but as soon as the data tends toward distinctness and/or large lists (more typical than not for my work), it clobbers GatherBy by a factor of 5-10. In addition, it is much cheaper on memory than gatherhog, which at times is like watching Oprah at a buffet when in comes to eating RAM...

-
Thanks. I've updated the timings in the question. – Michael E2 Apr 11 '14 at 10:32
@MichaelE2: Cool. Too small a test size though, mine's optimized for the other side of hard. Curious what say RandomInteger[10000000, 100000] does in your environment... – ciao Apr 11 '14 at 10:44
Yeah, it's about 4+ times faster than Szabolcs'. – Michael E2 Apr 11 '14 at 10:49

If you wanted to retain each value as well as its positions, this works.

Sort[
Map[{#[[1, 1]], Flatten[#[[All, 2]]]} &,
Reap[MapIndexed[Sow[{#1, #2}, #1] &, list]][[2, All, All]]]]

(* Out[178]= {{0, {14}}, {1, {17, 19}}, {4, {4,
20}}, {5, {12}}, {7, {10}}, {9, {13}}, {10, {2,
6}}, {11, {3}}, {12, {7, 15}}, {13, {8, 9, 11}}, {14, {1, 16,
18}}, {15, {5}}} *)


It's maybe 20x slower than the GatherBy though.

-

Here is a version based on sorting, and using Mr. Wizard's dynP function:

dynP[l_, p_] :=
MapThread[l[[# ;; #2]] &, {{0}~Join~Most@# + 1, #} &@Accumulate@p]

positionOfDuplicates[list_] :=
With[{ord = Ordering[list]},
SortBy[dynP[ord, Length /@ Split[list[[ord]]]], First]
]


so that

positionOfDuplicates[list]

(* {{1,2,10},{3,18},{4,7},{5,6},{8},{9},{11,20},{12},{13,14,19},{15},{16},{17}} *)


It is also fast enough, although not as fast as the one based on GatherBy.

-