From Newsgroup: comp.lang.lisp

"Pierre R. Mai" wrote:

I believe that remove-duplicates has to assume that the list is not
sorted. Therefore it has to compare each element, element by element
( ~N^2 ). Whereas a side by side goes like 2*N.

The only problem I have is excessive consing which significantly slows
down the algorithm.

(defun uniquify-sorted-list (list &key (key #'identity) (test #'eql))
(loop for element in list
for element-key = (funcall key element)
for last-element-key = (load-time-value (gensym))
then element-key
unless (funcall test element-key last-element-key)
collect element))

Testing under SBCL:

(uniquify-sorted-list '(a b b c d d e f f f g))
===>
(A)

(uniquify-sorted-list '(2 2 3 4 4 4 5 5 6 7))
===>
(2)

(uniquify-sorted-list '(2 2 3 4 4 4 5 5 6 7) :test #'=)
===>
debugger invoked on a SIMPLE-TYPE-ERROR in thread
#<THREAD "main thread" RUNNING {23EAC0D1}>:
Argument Y is not a NUMBER: #:G5


It seems that except in the first pass through the loop
"last-element-key" is always equal to "element-key".

Again we have proof of the unusability of Common Lisp and, in
particular, Loop.

Again we have proof of the mindless arrogance of fans of
Common Lisp. That complex chunk of code was not tested even
once by its author.



Gauche Scheme

"!" is similar to "do".

(define (uniquify-sorted sorted :key (key identity) (test equal?))
(! (r cons x :if (or (null? r) (not (test (key x) (key (car r)))))
x :in sorted)))

(uniquify-sorted '(0 0 2 3 3 4 4 4 5 6 7 8 8))
===>
(0 2 3 4 5 6 7 8)

(uniquify-sorted '(0 0 2 3 3 4 4 4 5 6 7 8 8) :test =)
===>
(0 2 3 4 5 6 7 8)

(uniquify-sorted '(0 0 2 -3 3 4 4 4 5 6 7 8 8) :key abs)
===>
(0 2 -3 4 5 6 7 8)

Given:

(define (!-flatten it)
(if (null? it) '()
(if (pair? it)
(append (!-flatten (car it)) (!-flatten (cdr it)))
(list it))))

(define-syntax !-aux
(syntax-rules (<> @ @@ + - : cons append :meld
cdr :in :across :along
:on :by :pop-or-nothing
:if :if-else ! :also? :also :to :repeat
:till :always :gen :minimize :maximize
->lets :let := )
[(_ specs seen lets @)
(!-aux specs seen lets #f @) ]
[(_ (->lets ((id val) ...) z ...) seen (lets ...) stuff ...)
(!-aux (z ...) seen (lets ... (id val) ...) stuff ...) ]
[(_ (:let id val z ...) stuff ...)
(!-aux (->lets ((id val)) z ...) stuff ...) ]
[(_ (:= id val z ...) stuff ...)
(!-aux (:let id #f dummy #f (set! id val) z ...) stuff ...) ]
;;
[(_ (:also? bool op x z ...) (seen ... (v i update)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool (op x update) update)))
stuff ...) ]
[(_ (:also op x z ...) stuff ...)
(!-aux (:also? #t op x z ...) stuff ...) ]
;;
[(_ ((:pop-or-nothing x xs nil) z ...) stuff ...)
(!-aux (x (if (pair? xs)(pop! xs) nil) <> z ...) stuff ...) ]
;;
[(_ (:always expr z ...) seen lets bool)
(!-aux (ok #t expr
:till (not ok)
z ...)
seen lets bool ok
) ]
[(_ (:always expr z ...) stuff ...)
(!-aux " * * * Bad usage of :always in '!'") ]
[(_ (:till expr z ...) seen lets #f stuff ...)
(!-aux (z ...) seen lets expr stuff ...) ]
[(_ (:till expr z ...) seen lets bool stuff ...)
(!-aux (z ...) seen lets (or expr bool) stuff ...) ]
;;
[(_ (:if bool z ...) (seen ... (v i u)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool u v))) stuff ...) ]
;;
[(_ (:if-else bool z ...) (seen ... (a b c)(d e f)) stuff ...)
(!-aux (:let yes #f z ...)
(seen ... (a b (begin (set! yes bool) (if yes c a)))
(d e (if (not yes) f d))) stuff ...) ]
[(_ (:if bool z ...) stuff ...)
(!-aux
" * * * :if used at bad location in '!'; it's postfix.") ]
[(_ (:if-else bool z ...) stuff ...)
(!-aux
" * * * :if-else used without 2 preceding assignments in '!'") ]
;;
[(_ (w :gen func z ...) stuff ...)
(!-aux (:let fun func
w (fun) (fun)
:till (eof-object? w) z ...) stuff ...) ]
;;
[(_ ((a b ...) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
:let ys #f
dummy (set! ys xs) <>
(:pop-or-nothing a ys #f)
(:pop-or-nothing b ys #f) ...
:till (or (null? xs) (begin (set! xs (kdr xs)) #f))
z ...) stuff ...) ]
[(_ ((a b ...) :on lst z ...) stuff ...)
(!-aux ((a b ...) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ ((y . ys) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
y (if (null? xs) #f (car xs)) <>
ys (if (null? xs) #f (cdr xs)) <>
:till (or (null? xs) (begin (pop! xs) #f))
z ...) stuff ...) ]
[(_ ((y . ys) :on lst z ...) stuff ...)
(!-aux ((y . ys) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ (s :on lst :by kdr z ...) stuff ...)
(!-aux (s lst (kdr s)
:till (null? s) z ...) stuff ...) ]
[(_ (s :on lst z ...) stuff ...)
(!-aux (s :on lst :by cdr z ...) stuff ...) ]
;;
[(_ ((c d ...) :in lst z ...) stuff ...)
(!-aux (->lets ((xs lst) (c #f) (d #f) ...)
dummy (if (pair? xs)
(set!-values (c d ...)(apply values (!-flatten(pop! xs))))
(set! c !-aux)) <>
:till (eq? c !-aux)
z ...) stuff ...) ]
[(_ (x :in lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
x (if (pair? xs)
(begin0 (car xs) (set! xs (kdr xs)))
!-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
[(_ (x :in lst z ...) stuff ...)
(!-aux (x :in lst :by cdr z ...) stuff ...) ]
;;
[(_ (x :across vec z ...) stuff ...)
(!-aux (:let v vec :let i 0
x (if (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))
!-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
[(_ (ch :along str z ...) stuff ...)
(!-aux (:let s str :let i 0
ch (and (< i (string-length s))
(begin0 (string-ref s i) (inc! i))) <>
:till (not ch)
z ...)
stuff ...) ]
[(_ (a b <> z ...) stuff ...)
(!-aux (a b b z ...) stuff ...) ]
;;
[(_ (a b + z ...) stuff ...)
(!-aux (a b (+ 1 a) z ...) stuff ...) ]
[(_ (a + n z ...) stuff ...)
(!-aux (a 0 (+ n a) z ...) stuff ...) ]
[(_ (a b - z ...) stuff ...)
(!-aux (a b (- a 1) z ...) stuff ...) ]
;;
[(_ (mi :minimize u z ...) stuff ...)
(!-aux (mi #f (if mi (min mi u) u) z ...) stuff ...) ]
[(_ (ma :maximize u z ...) stuff ...)
(!-aux (ma #f (if ma (max ma u) u) z ...) stuff ...) ]
;;
[(_ (n lo inc :to hi z ...) stuff ...)
(!-aux (:let step inc :let high hi
n lo (+ n step)
:till (> n high)
z ...) stuff ...) ]
[(_ (n lo :to hi z ...) stuff ...)
(!-aux (n lo 1 :to hi z ...) stuff ...) ]
[(_ (:repeat n z ...) stuff ...)
(!-aux (m 1 :to n z ...) stuff ...) ]
;;
[(_ (v init : kons u z ...) stuff ...)
(!-aux (v init (kons u v) z ...) stuff ...) ]
;;
[(_ (a cons b z ...) stuff ...)
(!-aux (a '() : cons b z ...) stuff ...) ]
[(_ (a append b z ...) stuff ...)
(!-aux (a '() : append (reverse b) z ...) stuff ...) ]
[(_ (a :meld b z ...) stuff ...)
(!-aux (a '()
(if (pair? b) (append (reverse b) a)
(cons b a))
z ...) stuff ...) ]
;;
[(_ (a b cdr z ...) stuff ...)
(!-aux (a b (cdr a) z ...) stuff ...) ]
[(_ (a b c z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b c)) stuff ...) ]
[(_ (a +) (seen ...) stuff ...)
(!-aux (a 0 +) (seen ...) stuff ...) ]
[(_ (a b) (seen ...) stuff ...)
(!-aux () (seen ... (a b)) stuff ...) ]
[(_ (a) (seen ...) stuff ...)
(!-aux () (seen ... (a '())) stuff ...) ]
;; Default action is print first variable.
[(_ () ((a b c) z ...) lets bool !)
(!-aux () ((a b c) z ...) lets bool ! print a) ]
[(_ () seen lets bool ! action ...)
(!-aux () seen lets bool #t (action ...)) ]
;; If result not specified, pick one.
[(_ () ((a b c) z ...) lets bool)
(!-aux () ((a b c) z ...) lets bool
(if (pair? a) (reverse a) a)) ]
[(_ () ((a b c) z ...) lets bool @)
(!-aux () ((a b c) z ...) lets bool (reverse a)) ]
[(_ () seen lets bool @ result stuff ...)
(!-aux () seen lets bool (reverse result) stuff ...) ]
;;
[(_ () seen lets bool @@ (what x ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) ...) stuff ...) ]
[(_ () seen lets bool (what @ x z ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) z ...) stuff ...) ]
[(_ () seen lets bool (what x @ y z ...) stuff ...)
(!-aux () seen lets bool (what x (reverse y) z ...) stuff ...) ]
;;
[(_ () ((a b c) z ...) lets 0 stuff ...)
(!-aux () ((a b c) z ...) lets (= 0 a) stuff ...) ]
[(_ () seen lets bool result stuff ...)
(let lets (do seen (bool result) stuff ...)) ]
))
(define-syntax !
(syntax-rules ()
[(_ specs bool stuff ...)
(!-aux specs () () bool stuff ...) ]
[(_ specs) (! specs #f) ]
))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

"B. Pym" <Nobody447095@here-nor-there.org> writes:

"Pierre R. Mai" wrote:

I believe that remove-duplicates has to assume that the list is not
sorted. Therefore it has to compare each element, element by element
( ~N^2 ). Whereas a side by side goes like 2*N.

The only problem I have is excessive consing which significantly slows
down the algorithm.

(defun uniquify-sorted-list (list &key (key #'identity) (test #'eql))
(loop for element in list
for element-key = (funcall key element)
for last-element-key = (load-time-value (gensym))
then element-key
unless (funcall test element-key last-element-key)
collect element))

Testing under SBCL:

(uniquify-sorted-list '(a b b c d d e f f f g))
===>
(A)

(uniquify-sorted-list '(2 2 3 4 4 4 5 5 6 7))
===>
(2)

(uniquify-sorted-list '(2 2 3 4 4 4 5 5 6 7) :test #'=)
===>
debugger invoked on a SIMPLE-TYPE-ERROR in thread
#<THREAD "main thread" RUNNING {23EAC0D1}>:
Argument Y is not a NUMBER: #:G5

It seems that except in the first pass through the loop
"last-element-key" is always equal to "element-key".

Again we have proof of the unusability of Common Lisp and, in
particular, Loop.

Again we have proof of the mindless arrogance of fans of
Common Lisp. That complex chunk of code was not tested even
once by its author.

The mistake in the LOOP solution is akin to using DO* when
it should use DO. Each time rCylast-element-keyrCO is updated,
it uses the current value of rCyelement-keyrCO when it should
use the previous value of rCyelement-keyrCO. This is fixed by
changing:

"FOR last-element-key ..."

to:

"AND last-element-key..."

See:
http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_6-1-2-1.html

```
(defun uniquify-sorted-list (list &key (key #'identity) (test #'eql))
"Create a list of items from sorted LIST but removing all duplicate
items. (If LIST is not sorted, then duplicates in the list may remain
in the result list.)"
(loop
for element in list
for element-key = (funcall key element)
and last-element-key = nil then element-key
for result = nil
then (funcall test element-key last-element-key)
unless result
collect element))
```

(uniquify-sorted-list '(2 2 3 4 4 4 5 5 6 7) :test #'=)

(2 3 4 5 6 7)

Or, use LOOPrCOs destructuring and stepping by tails of a
list:

```
(defun uniquify-sorted-list (list &key (key #'identity) (test #'eql))
"Create a list of items from sorted LIST but removing all duplicate
items. (If LIST is not sorted, then duplicates in the list may remain
in the result list.)"
(loop
for (one two) on list
if (null two)
collect one
else
unless (funcall test (funcall key one) (funcall key two))
collect one))
```

(uniquify-sorted-list '(5 5 6 7 11.2 11.2 33.4 44.5 44.5 44.5) :test #'=)

(5 6 7 11.2 33.4 44.5)

See:
http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_6-1-1-7.html
and
http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_6-1-2-1-3.html
--
The lyf so short, the craft so long to lerne.
- Geoffrey Chaucer, The Parliament of Birds.
--- Synchronet 3.21a-Linux NewsLink 1.2