# 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.

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

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

Thanks to @bmf:

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


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

• 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, 2023 at 9:24
• Thank you very much - I couldn't see the forest for the trees
– eldo
Sep 12, 2023 at 9:33
• It was a very nice answer in any case :-)
– bmf
Sep 12, 2023 at 9:34

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

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[#, {}] &

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