How do I delete all items that occur more than once?

Question

DeleteDuplicates works fine but leaves a single copy of the duplicated item. I need to remove all items that occur more than once i.e. {{1,2},{1,2},{3,4}} -> {3,4}. There must be a one-liner.

http://mathematica.stackexchange.com/questions/37936/how-to-get-list-of-duplicates-when-using-deleteduplicates, then delete all elements that are in both lists. — Baran Cimen, Feb 16 '16 at 16:21

Leonid Shifrin · Answer 1 · 2016-02-16T16:37:49.947

25

Here is a test list:

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

Here is one way then:

GroupBy[Tally[lst], Last][1][[All, 1]]

(* {{3, 4}, {7, 8}} *)

The same idea using purely associations:

Keys[GroupBy[Counts[lst], Identity][1]]

(* {{3, 4}, {7, 8}} *)

A somewhat more efficient method can be this:

Pick[lst, Lookup[Counts[lst], lst], 1]

(* {{3, 4}, {7, 8}} *)

edited Feb 16 '16 at 16:37

answered Feb 16 '16 at 16:24

Leonid Shifrin

114,335
15
329
420

You deserve a medal. I modified your single line to do a real-world job: GroupBy[Tally[shortListNew, #1[[9]] == #2[[9]] &], Last][1][[All, 1]]; – Boris Feb 19 '16 at 08:51
1

@Boris Glad it worked for you. Re: modified - it is often better to describe your original problem, since over-simplification may lead to valid solutions to the toy problem being unusable for a real one. Hope this was not the case for other solutions either. – Leonid Shifrin Feb 19 '16 at 13:02

score 17 · Answer 2 · answered Feb 16 '16 at 16:23

17

Counting the times each element appears and then selecting all the elements that appear only once:

deleteDuplicates[list_] := First /@ Cases[Tally[list], {_, 1}]

deleteDuplicates[{{1, 2}, {1, 2}, {3, 4}, {1, 2}}]

{{3, 4}}

answered Feb 16 '16 at 16:23

C. E.

70,533
6
140
264

7

Also works as Cases[Tally[list], {x_, 1} :> x] – Martin Ender Feb 17 '16 at 08:50

score 10 · Answer 3 · edited Apr 13 '17 at 12:56

This question is the inverse of How to get list of duplicates when using DeleteDuplicates? and in similar manner to my second answer there, if sorting is allowed we may be able to produce a more efficient method.

uniques[p_] :=
  With[{sp = Sort@p},
    Ordering @ Reverse @ sp //
     Unitize @ Subtract[1, Differences @ #] & //
      Pick[sp, Prepend[#, 1]*Append[#, 1], 1] &
  ]

Tested:

{{1, 1}, {3, 1}, {2, 0}, {1, 2}, {1, 2}} // uniques

{{1, 1}, {2, 0}, {3, 1}}

Performance: (oops, forgot to include my test data!)

SeedRandom[1]
lst = RandomInteger[999, {1*^6, 2}];

uniques[lst] // Length // AbsoluteTiming

{0.293465, 368513}

Compared to other methods posted:

First /@ Cases[Tally[lst], {_, 1}]       // Length // AbsoluteTiming
GroupBy[Tally[lst], Last][1][[All, 1]]   // Length // AbsoluteTiming
Keys[GroupBy[Counts[lst], Identity][1]]  // Length // AbsoluteTiming
Pick[lst, Lookup[Counts[lst], lst], 1]   // Length // AbsoluteTiming

{1.17172, 368513}
{1.26163, 368513}
{4.21019, 368513}
{2.83746, 368513}

Finally J.M.'s sort-based method, though I had to substitute my own function for Nothing in version 10.1.0:

Nothing = Sequence[];  (* for versions prior to 10.2 *)

Join @@ Replace[Split[Sort[lst]], v_ /; Length[v] > 1 :> Nothing, 1] // 
  Length // AbsoluteTiming

{0.952435, 368513}

rhermans · Answer 4 · 2016-02-16T17:02:36.320

removeDuplicates[l_List] := 
 Select[Tally[l], Last[#] === 1 &][[All, 1]]

lst = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}};

removeDuplicates[lst]
(* {{3, 4}, {7, 8}} *)

Performances:

lst = RandomInteger[99, {100000, 2}];

First@RepeatedTiming[
  removeDuplicates[lst]
  , 5]

0.0873

First@RepeatedTiming[
  GroupBy[Tally[lst], Last][1][[All, 1]]
  , 5]

0.0826

First@RepeatedTiming[
  Keys[GroupBy[Counts[lst], Identity][1]]
  , 5]

0.111

First@RepeatedTiming[
  Pick[lst, Lookup[Counts[lst], lst], 1]
  , 5]

0.230

deleteDuplicates[list_] := First /@ Cases[Tally[list], {_, 1}]

First@RepeatedTiming[
  deleteDuplicates[lst]
  , 5]

0.089

First@RepeatedTiming[
  Cases[Tally@lst, {{a_, b_}, 1} :> {a, b}]
  , 5]

0.0821

gwr · Answer 5 · 2016-02-16T17:37:21.093

5

Time for some fancy pattern matching it seems:

list = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}}; (* Leonid's test list *)

list // RightComposition[
   Sort,
   ReplaceRepeated[
      #,
      RuleDelayed[
         { f___, Longest @ Repeated [ l:{ _Integer, _Integer }, { 2, Infinity } ], b___ },
         { f, b }
      ]
   ]&
]

{{3, 4}, {7, 8}}

Or indeed simpler and more boringly:

Cases[ Tally @ list, {{a_, b_}, 1} :> {a, b} ]

{{3, 4}, {7, 8}}

edited Feb 16 '16 at 17:37

answered Feb 16 '16 at 16:35

gwr

13,452
2
47
78

2

The first one doesn't work if there are more than two of a kind. With ReplaceRepeated it works if there are an even number of a kind, but not if there is an odd number of a kind. – C. E. Feb 16 '16 at 17:07
1

@Pickett Thank you. It's fixed now in a nicer way I hope. – gwr Feb 16 '16 at 17:25

score 4 · Answer 6 · answered Feb 16 '16 at 17:38

4

A caveat of the following solution is the need to sort, but it does well otherwise:

list = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}};
Join @@ Replace[Split[Sort[list]], v_ /; Length[v] > 1 :> Nothing, 1]
   {{3, 4}, {7, 8}}

answered Feb 16 '16 at 17:38

J. M.'s missing motivation

124,525
11
401
574

kglr · Answer 7 · 2017-06-26T18:55:05.170

4

lst = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}};

Pick[#[[All, 1]], Length /@ #, 1] & @ Gather[lst]

{{3, 4}, {7, 8}}

edited Jun 26 '17 at 18:55

answered Jun 26 '17 at 18:42

kglr

394,356
18
477
896

eldo · Answer 8 · 2023-09-12T09:31:57.823

4

lst = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}};


Keys @ DeleteCases[Except @ 1] @ Merge[Length] @ MapApply[{##} -> {##} &] @ lst

or

Keys @ Select[Length @ Last @ # == 1 &] @ Normal @ PositionIndex[lst]

Both give

{{3, 4}, {7, 8}}

Addendum

Thanks to @bmf:

Keys @ Select[Counts[list], # == 1 &]

{{3, 4}, {7, 8}}

edited Sep 12 '23 at 09:31

answered Sep 12 '23 at 08:18

eldo

67,911
5
60
168

Nicely done and it's a (+1) from me. For completeness, maybe you could add Keys@Select[Counts[list], # == 1 &] since you used Keys – bmf Sep 12 '23 at 09:24
1

Thank you very much - I couldn't see the forest for the trees – eldo Sep 12 '23 at 09:33
It was a very nice answer in any case :-) – bmf Sep 12 '23 at 09:34

andre314 · Answer 9 · 2016-02-16T20:17:07.587

For completeness, a old fashion way to do it :

list = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}};

{listCopied, listOfDuplicates} = 
 Fold[{
      Append[#1[[1]], #2], 
      If[MemberQ[#1[[1]], #2],Append[#1[[2]], #2], #1[[2]]]
      } &,
      {{}, {}},
      list] 

Select[list, ! MemberQ[listOfDuplicates, #] &]

{{3, 4}, {7, 8}}

While scanning list , Fold[...] constructs two lists :
- one which is the list of the elements seen (Append[#1[[1]], #2])
- one with the duplicates elements (If[MemberQ[#1[[1]], #2],Append[#1[[2]], #2], #1[[2]]])

score 2 · Answer 10 · edited Sep 12 '23 at 09:38

Some extra fun stuff.

With

list = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}};

we have

1.

Reap[Sow[1, #], _, Pick[#1, #2, {1}] &][[2]] &@list // 
 DeleteCases[#, {}] &

list //. {OrderlessPatternSequence[Repeated[x_, {2, Infinity}], y___]} :> {y}

The above return

{{3, 4}, {7, 8}}

3.

ArrayReshape[
 Cases[Split[
   Sort[list]], {_}], {(Length /@ list)[[1]], (Length /@ list)[[1]]}]

{{3, 4}, {7, 8}}

How do I delete all items that occur more than once?

10 Answers10

Performances:

Linked

Related