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

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.

• mathematica.stackexchange.com/questions/37936/…, then delete all elements that are in both lists. Feb 16 '16 at 16:21
• Welcome to Mathematica.SE! 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour and check the faqs! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign!
– user9660
Feb 16 '16 at 16:23
• There are things to do after your question is answered. It's a good idea to stay vigilant for some time, better approaches may come later improving over previous replies. Experienced users may point alternatives, caveats or limitations. New users should test answers before voting and wait 24 hours before accepting the best one. Participation is essential for the site, please come back to do your part tomorrow Feb 16 '16 at 17:56
• Related: (1290), (15776), (18100), (37936) Feb 16 '16 at 19:07

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}} *)

• 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]]; Feb 19 '16 at 8:51
• @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. Feb 19 '16 at 13:02

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}}

• Also works as Cases[Tally[list], {x_, 1} :> x] Feb 17 '16 at 8:50

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}

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

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}}

• 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. Feb 16 '16 at 17:07
• @Pickett Thank you. It's fixed now in a nicer way I hope.
– gwr
Feb 16 '16 at 17:25

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}}

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

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


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

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