Unique Element in List

Question

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

Answer 1

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

Answer 2

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]
(* {} *)

Answer 3

Using association-related functions:

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

where lst is the list to examine.

Answer 4

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

Answer 5

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]

Answer 6

Just some variants:

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

Answer 7

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}

Answer 8

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.

Answer 9

Using PositionIndex:

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

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

{z, a}

Answer 10

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}

Answer 11

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}