# Find positions of duplicates that are neighbours

Assuming the following list {1,2,3,3,5,6,3} I would like to get the position of values that are next to each other and are duplicates. That is, the output should be {3,4}.

Thank you for any help.

Cheers, Vaclav

-

Here's a pretty straightforward way:

list = {1, 2, 3, 3, 2, 5, 4, 6, 5, 5};
tf = Position[Table[list[[i]] == list[[i - 1]], {i, 2, Length[list]}], True]


Or one can avoid the Table using the equivalent

Position[Equal[#[[1]], #[[2]]] & /@ Partition[list, 2, 1], True]


Both of these give a list of the positions where all the pairs begin. You can change this to the exact form you are looking for by

Riffle[Flatten[tf], Flatten[tf] + 1]
{3, 4, 9, 10}


If there are triples, then it is somewhat unclear what the desired output is. As Nasser points out, this can be fixed by applying DeleteDuplicates.

-
This does not work for list = {1, 2, 3, 3, 3, 2}; it gives {3, 4, 4, 5} !Mathematica graphics – Nasser Jan 18 '14 at 16:55
The pairs are at 3,4 and 4,5... so it does do what the OP asked for. – bill s Jan 18 '14 at 16:59
Well, ok, but the positions should be {3,4,5} and not {3,4,4,5} I would think. I think all what you need to do is just remove duplicate positions from last list. Good answer any way :) – Nasser Jan 18 '14 at 17:03
The second example can be reduced to Position[Partition[list, 2, 1], {x_, x_}] :) – ybeltukov Jan 18 '14 at 19:34

Another straightforward solution:

DeleteDuplicates@Flatten[{#, # + 1} & /@ Position[Differences[{1, 2, 3, 3, 5, 6, 3}], 0]]

(* Out: {3,4} *)

-

The following should be a fast and robust solution:

ClearAll@neighbouringDuplicates
neighbouringDuplicates[list_] :=
Select[SplitBy[Range@Length[list], list[[#]] &], Length@# > 1 &]

neighbouringDuplicates@{1, 2, 3, 3, 5, 6, 3}
(* {{3, 4}} *)

neighbouringDuplicates@{1, 2, 3, 3, 2, 5, 4, 6, 5, 5}
(* {{3, 4}, {9, 10}} *)


This is an example of the "transform by" pattern that Szabolcs also used in a related question to great effect.

-
\rm-rf For me, your answer is a good and valid answer – Mika Ike Jun 7 '14 at 20:50

Plenty fast (as in orders of magnitude faster than using split). Since question is a bit ambiguous, I treat anything beyond a pair as multiple pairs, e.g., in {1,2,2,2,3,3,4,5,6}, the 2,2,2 is treated as a pair of duplicates. Output is strictly pair positions.

test = {1, 1, 5, 6, 9, 5, 5, 5, 3, 4, 5, 5}

With[{pl = PadLeft[#, Length[#] + 1, Min[#] - 1]},
Replace[Pick[Range[Length[#]], Differences[pl], 0],
a_ :> {a - 1, a}, 1]] &[test]

(* {{1, 2}, {6, 7}, {7, 8}, {11, 12}} *)


Some timings (caveat - on netbook, cigar lounging):

test = RandomInteger[1000000, 5000000];

r1 = neighbouringDuplicates@test; // Timing // First

r4 = With[{pl = PadLeft[#, Length[#] + 1, Min[#] - 1]},
Replace[Pick[Range[Length[#]], Differences[pl], 0],
a_ :> {a - 1, a}, 1]] &[test]; // Timing // First

r1 == r4

(*
116.641948
0.358802
True
*)


So about 300X slower using split here.

-
rasher, would you give me comparative timings for the method I just posted, both with Union and Transpose? (+1 by the way) – Mr.Wizard Jan 28 '14 at 15:37
Pick[Transpose[{Most[#], Rest[#]}] &[Range[Length[#]]], Differences[#], 0] &[test] – Coolwater Jan 28 '14 at 18:39
@Mr.Wizard: Pretty much a wash testing on the lounge-machine with lists up to 10^7 in length. My mess is usually 5-10% less time, but frankly that's in the noise for MM timing trust IMHO. I suppose mine working on arbitrary element types is a plus. – ciao Jan 28 '14 at 22:53
@Coolwater: Clean, pretty quick (~3rd fastest in simple tests), but spits out noise of {} in results. Nice though! – ciao Jan 28 '14 at 22:58
Thanks for confirmation; I'm glad to know Pick is now performing as it should. (You already have my +1.) – Mr.Wizard Jan 28 '14 at 23:48

Here is Pickett's method but using SparseArray Properties as a faster alternative to Position.

fn = Union[#, # + 1] &@
SparseArray[Unitize @ Differences @ #, Automatic, 1]["AdjacencyLists"] &;

fn @ {1, 1, 5, 6, 9, 5, 5, 5, 3, 4, 5, 5}

{1, 2, 6, 7, 8, 11, 12}


If position pairs with duplicates are acceptable (rasher's format), we can save a bit more time by using Transpose[{#, # + 1}] in place of Union[#, # + 1].

This (with Transpose) tests about an order of magnitude faster than rasher's method in version 7, but Pick was optimized in v8. It (with Union) tests two orders of magnitude faster than neighbouringDuplicates.

-