Re: programming DeleteRepetitions
- To: mathgroup at smc.vnet.net
- Subject: [mg23708] Re: [mg23662] programming DeleteRepetitions
- From: BobHanlon at aol.com
- Date: Mon, 29 May 2000 22:05:41 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
In a message dated 5/28/2000 11:37:53 PM, pnichols at wittenberg.edu writes:
>Below I give a function which removes duplicates from a list (as Union
>does), but without sorting the result (as Union also does). More
>specifically, it extracts, in order, the first instance of each distinct
>element of the list.
>
>Is there any simpler way to do this? It's a simple idea, but I seem to
>need seven different list-manipulation functions, including 3 uses of Map!
>
>DeleteRepetitions[X_] :=
> Take[X, #] & /@
> Sort[First /@
> (Position[X, #] & /@
> Union[X])] // Flatten
>
>For example,
>
>In[2] := DeleteRepetitions[{3,1,2,3,3,2,4,1}]
>
>Out[2] = {3,1,2,4}
>
>In[3] := DeleteRepetitions[{b,a,b,a,c,a}]
>
>Out[3] = {b,a,c}
>
>I don't need to use this function on lists longer that 20 or so elements,
>so speed is not a critical concern.
>
>Also, my version happens to work on expressions with heads other than List
>(because Take, Position, Union, and Flatten all do so), but I don't really
>need that feature.
>
>How would you implement this function?
>
DeleteRepetitions1[x_List] :=
Take[x, #] & /@
Sort[First /@
(Position[x, #] & /@
Union[x])] //
Flatten
DeleteRepetitions2[x_List] := Module[{uniq = {}},
If[Not[MemberQ[uniq, #]], (uniq = Append[uniq, #])] & /@ x;
uniq]
DeleteRepetitions3[x_List] :=
Transpose[
Union[Transpose[Join[{Range[Length[x]]}, {x}]],
SameTest -> (#1[[2]] == #2[[2]] &)]][[2]]
DeleteRepetitions4[x_List] := x //. {a___, b_, c___, b_, d___} -> {a, b, c, d}
DeleteRepetitions5[x_List] :=
Module[{uniq = Union[x], n, portion},
n = Length[uniq]; While[(Union[portion = Take[x, n]]) != uniq, n++];
portion //. {a___, b_, c___, b_, d___} -> {a, b, c, d}]
DeleteRepetitions6[x_List] :=
Module[{uniq = Union[x], n, portion},
n = Length[uniq]; While[(Union[portion = Take[x, n]]) != uniq, n++];
Take[portion, #] & /@
Sort[First /@
(Position[portion, #] & /@
uniq)] // Flatten]
testList = Table[Random[Integer, {1, 10}], {400}];
funcs = ToExpression[Names["DeleteRep*"]];
Demonstrating the equivalence of the functions
Equal[Sequence @@ (#[testList] & /@ funcs)]
True
Comparing their timings
Timing[#[testList]][[1]] & /@ funcs
{0.01666666666665151*Second, 0.049999999999954525*Second,
0.10000000000002274*Second, 2.2999999999999545*Second,
0.016666666666765195*Second, 0.*Second}
The fourth method is very slow for long lists. The fifth method speeds this
up provided that the list is highly redundant. The sixth method applies this
potential speed up to the first (original) method.
Bob
BobHanlon at aol.com