Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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], 
     If[Head[seen[#1]] === List, AppendTo[tags, #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 *)
share|improve this question
    
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

5 Answers 5

up vote 38 down vote accepted

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&]

share|improve this answer
1  
Smart. I don't think this can be beaten. –  Sjoerd C. de Vries Mar 15 '13 at 6:53
3  
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
3  
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
2  
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

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.

share|improve this answer
1  
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 at 0:31
    
@Michael Don't miss: (54853) –  Mr.Wizard Jul 15 at 0:33
1  
WTH? Wolfram seems to have screwed the pooch on a few things... I think I'll hold off updating until .01... –  rasher Jul 15 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...

share|improve this answer
    
Thanks. I've updated the timings in the question. –  Michael E2 Apr 11 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... –  rasher Apr 11 at 10:44
    
Yeah, it's about 4+ times faster than Szabolcs'. –  Michael E2 Apr 11 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.

share|improve this answer

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.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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