11
$\begingroup$

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

$\endgroup$
13
$\begingroup$

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]
   {}
$\endgroup$
9
$\begingroup$

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]
(* {} *)
$\endgroup$
7
$\begingroup$

Using association-related functions:

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

where lst is the list to examine.

$\endgroup$
6
$\begingroup$

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

$\endgroup$
  • 1
    $\begingroup$ 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. $\endgroup$ – march Oct 12 '15 at 20:48
5
$\begingroup$

Just some variants:

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

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]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.