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
6 Answers
$\begingroup$
$\endgroup$
1
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.
-
$\begingroup$ \rm-rf For me, your answer is a good and valid answer $\endgroup$Mika Ike– Mika Ike2014-06-07 20:50:30 +00:00Commented Jun 7, 2014 at 20:50
$\begingroup$
$\endgroup$
Another straightforward solution:
DeleteDuplicates@Flatten[{#, # + 1} & /@ Position[Differences[{1, 2, 3, 3, 5, 6, 3}], 0]]
(* Out: {3,4} *)
$\begingroup$
$\endgroup$
6
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.
-
$\begingroup$ rasher, would you give me comparative timings for the method I just posted, both with
UnionandTranspose? (+1 by the way) $\endgroup$Mr.Wizard– Mr.Wizard2014-01-28 15:37:03 +00:00Commented Jan 28, 2014 at 15:37 -
$\begingroup$ Pick[Transpose[{Most[#], Rest[#]}] &[Range[Length[#]]], Differences[#], 0] &[test] $\endgroup$Coolwater– Coolwater2014-01-28 18:39:15 +00:00Commented Jan 28, 2014 at 18:39
-
$\begingroup$ @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. $\endgroup$ciao– ciao2014-01-28 22:53:26 +00:00Commented Jan 28, 2014 at 22:53
-
$\begingroup$ @Coolwater: Clean, pretty quick (~3rd fastest in simple tests), but spits out noise of
{}in results. Nice though! $\endgroup$ciao– ciao2014-01-28 22:58:16 +00:00Commented Jan 28, 2014 at 22:58 -
$\begingroup$ Thanks for confirmation; I'm glad to know
Pickis now performing as it should. (You already have my +1.) $\endgroup$Mr.Wizard– Mr.Wizard2014-01-28 23:48:32 +00:00Commented Jan 28, 2014 at 23:48
$\begingroup$
$\endgroup$
4
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.
-
$\begingroup$ This does not work for
list = {1, 2, 3, 3, 3, 2};it gives{3, 4, 4, 5}!Mathematica graphics $\endgroup$Nasser– Nasser2014-01-18 16:55:57 +00:00Commented Jan 18, 2014 at 16:55 -
$\begingroup$ The pairs are at 3,4 and 4,5... so it does do what the OP asked for. $\endgroup$bill s– bill s2014-01-18 16:59:01 +00:00Commented Jan 18, 2014 at 16:59
-
$\begingroup$ 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 :) $\endgroup$Nasser– Nasser2014-01-18 17:03:49 +00:00Commented Jan 18, 2014 at 17:03 -
$\begingroup$ The second example can be reduced to
Position[Partition[list, 2, 1], {x_, x_}]:) $\endgroup$ybeltukov– ybeltukov2014-01-18 19:34:42 +00:00Commented Jan 18, 2014 at 19:34
$\begingroup$
$\endgroup$
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.
$\begingroup$
$\endgroup$
In versions 10.1+, you can use SequencePosition
neighborPositions = SequencePosition[#, {a_, a_}]&;
Examples:
l1 = {1, 2, 3, 3, 5, 6, 3} ;
l2 = {1, 2, 3, 3, 3, 2, 5, 4, 6, 5, 5};
{#, posF @ #} & /@ {l1, l2} // Grid[Prepend[#, {"list", "positions"}], Dividers -> All] &
