# Unique Element in List

I have a list a, and want to find out whether there is a unique element in the list.

For instance a={x,y,z,y,x} has an unique element (z), while a={1,2,3,4,5,1,2,3,4,5} has no unique element.

There are several brute-force ways (such as going through the list element by element and using First and Last), but I wonder whether there are more clever ways (I was trying to play with Complement, but it also required a loop).

One way:

Cases[Tally[{x, y, z, y, x}], {x_, 1} :> x]
{z}

Cases[Tally[{1, 2, 3, 4, 5, 1, 2, 3, 4, 5}], {x_, 1} :> x]
{}


This function uses Tally and select the elements that are repeated once.

UniqueElements[lst_]:= Select[Tally[lst], #[[2]] == 1 &][[All, 1]]

a = {x, y, z, y, x}
b = {1, 2, 3, 4, 5, 1, 2, 3, 4, 5}
UniqueElements[a]
(* {z} *)
UniqueElements[b]
(* {} *)


Using association-related functions:

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


where lst is the list to examine.

This method is slightly evil.

g[input_List] := Module[{f},
f[item_] := {Sow[item, "Once"]; f[item] := Sow[item, "Twice"]};
Complement @@ Reap[f /@ input][[2]]
]


There should be a faster way to extract the "only once defined fs" using Select[] and DownValues[f] instead of Sow/Reap/Complement, but I'm too tired to figure that out right now. (I.e., the solution should look like

g[input_List] := Module[{f},
f[item_] := f[item] := f[item] := {};
Select[Downvalues[f], (* something tricky *)]
]


.)

Edit 13 October 2015: @march's comments led me to revisit this.

g[input_List] := Module[{f},
f[item_] := f[item] := f[item] := {};
f /@ input;
(* To see what's going on, uncomment the next line. *)
(* Print[DownValues[f]; *)
Select[DownValues[f],
And[#[[2]] === Null, #[[1, 1, 1]] =!= item$_] & ][[All, 1, 1, 1]] ]  This uses delayed evaluation to re-define f the first and second times an expression is its argument from "something that is not {}" to "{}", then scan through the downvalues of f finding the arguments for which it is still defined to be "something that is not {}". Why would one do this? It's related to an old hack for RemoveDuplicates[] from before that function existed: remDupes[x_] := Module[{f}, f[y_] := (f[y] = Sequence[]; y); f /@ x]  (We can't do this directly for the OP's problem because the second time we see an input we can't travel back in time undo the output of it the first time we saw it. We have to wait until the end of the list to determine which inputs were never seen a second time.) We expect this function to run in time$O(n \log n)$for$n$the length of the input, where manipulation of the items in the list is assumed to take constant time. (It's really$O(n \log n + m)$where$m\$ is the length of the output, but the output is not longer than the input...)

• I believe this works, if you'd like to add it to your answer in the place of Select[...]: f /@ input; With[{k = #}, Cases[DownValues[f], Verbatim[HoldPattern[f[k]] :> (f[k] := {})] :> k]] & /@ DeleteDuplicates@input // Flatten. And yes: slightly evil. It took me some time to unravel what was happening. Commented Oct 12, 2015 at 20:48

This is guaranteed to be slower than the other versions above, but just for the purposes of demonstrating other Mathematica functionality (and perhaps also useful if the list is sorted to begin with):

DeleteDuplicates /@ Select[Split@Sort@list, Length@# == 1 &]
Cases[Split@Sort@list, a_ /; Length@a == 1 :> First@a]


Just some variants:

Cases[Gather[a], {w_} :> w]
1 /. Last@Reap[Sow[1, a], _, Total@#2 -> #1 &]
Cases[Times @@ (Unique[] /@ a), _[x_] :> x]

list = {x, y, z, y, x, a, x};


Using UniqueElements (new in 13.1)

Join @@ UniqueElements[List /@ list]


{z, a}

If the order of the returned unique elements doesn't matter:

Cases[{a_} :> a] @ Split @ Sort @ list


{a, z}

or

Flatten @ SequenceSplit[Sort @ list, {a_, a_ ..}]


{a, z}

Grabbing the @eldo's list and using SubsetCases:

list = {x, y, z, y, x, a, x};

Union @@ Cases[{_}]@SubsetCases[list, s : {a_ ..} :> s]

(*{a, z}*)


Update: According to the comments of @march and @eldo, it's redundant to place Repeated if we use GatherBy, so the corrected version is simply:

Union @@ Cases[{_}]@GatherBy[list]

(*{a, z}*)


However, if we use GroupBy, then using Repeated is correct, as I show below:

Catenate@GroupBy[list, Repeated, If[Length@# > 1, {}, #] &]

(*{a, z}*)


Finally, another way to accomplish this is to use GroupBy and Count:

GroupBy[list, Count[list, #] == 1 &][True]

(*{a, z}*)


I especially thank @march and @eldo for correcting this important detail.

• I added GatherBy[list, Repeated] to my "Collection of useful things" - very neat!
– eldo
Commented Dec 29, 2023 at 8:21
• Thanks, @eldo! :-) Commented Dec 29, 2023 at 8:42
• @eldo How is GatherBy[{x, y, z, y, x, a, x}, Repeated] different than GatherBy[{x, y, z, y, x, a, x}]? They result in the same thing for me. Commented Dec 30, 2023 at 18:11
• I assumed the Repeated would place repeated elements in front, but that's not the case. You are right, march, the Repeated is absolutely redundant.
– eldo
Commented Dec 30, 2023 at 18:19
• @eldo See the update, please! Commented Dec 30, 2023 at 20:11

Using PositionIndex:

list = {x, y, z, y, x, a, x};

PositionIndex[list] // KeyValueMap[If[Length@#2 == 1, #1, Nothing] &]


{z, a}

First @eldo, then @E. Chan-López, and now @Syed, now I'm jealous

Grabbing the list from @eldo

list = {x, y, z, y, x, a, x};


I suggest

list //. {OrderlessPatternSequence[Repeated[x_, {2, Infinity}],
a__]} :> {a}


or

Sort[list] // Split // Select[Length[#] == 1 &] // Flatten[#, 1] &


{a, z}

list = {x, y, z, y, x, a, x};


Three more solutions with Tally

Using SequenceSplit

First /@ Catenate @ SequenceSplit[Tally @ list, {{_, Except[1]}]


Using ReplaceAll

First /@ ReplaceAll[Tally @ list, {_, Except[1]} :> Nothing]


Using Extract

Extract[First /@ #, Position[#, {_, 1}]] & [Tally @ list]


All return

{z, a}