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.

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

share|improve this question

5 Answers 5

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.

share|improve this answer
    
\rm-rf For me, your answer is a good and valid answer –  Mika Ike Jun 7 at 20:50

Another straightforward solution:

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

(* Out: {3,4} *)
share|improve this answer

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.

share|improve this answer
    
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 at 15:37
    
Pick[Transpose[{Most[#], Rest[#]}] &[Range[Length[#]]], Differences[#], 0] &[test] –  Coolwater Jan 28 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. –  rasher Jan 28 at 22:53
    
@Coolwater: Clean, pretty quick (~3rd fastest in simple tests), but spits out noise of {} in results. Nice though! –  rasher Jan 28 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 at 23:48

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.

share|improve this answer
    
This does not work for list = {1, 2, 3, 3, 3, 2}; it gives {3, 4, 4, 5} !Mathematica graphics –  Nasser Jan 18 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 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 at 17:03
    
The second example can be reduced to Position[Partition[list, 2, 1], {x_, x_}] :) –  ybeltukov Jan 18 at 19:34

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.

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.