Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2000
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2000

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: JLink
  • Next by Date: Re: Newbie Q: Referencing Auto-number Cells
  • Previous by thread: Re: programming DeleteRepetitions
  • Next by thread: Re: Command to get a notebook's directory?