suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

#:key argument to remove-duplicates

Browse Source 
svn: r16587
This commit is contained in:
Eli Barzilay 2009-11-06 22:32:53 +00:00
parent bf911e8c7a
commit 69e90b7ef3
3 changed files with 44 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/scheme/list.ss
View File

@ -188,38 +188,45 @@
;; ls
;; (append l (car ls) (loop (cdr ls))))))]))
(define (remove-duplicates l [=? equal?])
(define (remove-duplicates l [=? equal?] #:key [key #f])
(define-syntax-rule (no-key x) x)
(unless (list? l) (raise-type-error 'remove-duplicates "list" l))
(let ([h (cond [(< (length l) 40) #f]
[(eq? =? eq?) (make-hasheq)]
[(eq? =? equal?) (make-hash)]
[else #f])])
(if h
;; Using a hash table when the list is long enough and a using `equal?'
;; or `eq?'. The length threshold (40) was determined by trying it out
;; with lists of length n holding (random n) numbers.
(let loop ([l l])
(if (null? l)
l
(let ([x (car l)] [l (cdr l)])
(if (hash-ref h x #f)
(loop l)
(begin (hash-set! h x #t) (cons x (loop l)))))))
;; Using a hash table when the list is long enough and when using
;; `equal?' or `eq?'. The length threshold (40) was determined by
;; trying it out with lists of length n holding (random n) numbers.
(let-syntax ([loop
(syntax-rules ()
[(_ getkey)
(let loop ([l l])
(if (null? l)
l
(let* ([x (car l)] [k (getkey x)] [l (cdr l)])
(if (hash-ref h k #f)
(loop l)
(begin (hash-set! h k #t)
(cons x (loop l)))))))])])
(if key (loop key) (loop no-key)))
;; plain n^2 list traversal (optimized for common cases)
(let-syntax ([loop (syntax-rules ()
[(_ search)
(let loop ([l l] [seen null])
(if (null? l)
l
(let ([x (car l)] [l (cdr l)])
(if (search x seen)
(loop l seen)
(cons x (loop l (cons x seen)))))))])])
(cond [(eq? =? equal?) (loop member)]
[(eq? =? eq?) (loop memq)]
[(eq? =? eqv?) (loop memv)]
[else (loop (lambda (x seen)
(ormap (lambda (y) (=? x y)) seen)))])))))
(let ([key (or key (lambda (x) x))])
(let-syntax ([loop (syntax-rules ()
[(_ search)
(let loop ([l l] [seen null])
(if (null? l)
l
(let* ([x (car l)] [k (key x)] [l (cdr l)])
(if (search k seen)
(loop l seen)
(cons x (loop l (cons k seen)))))))])])
(cond [(eq? =? equal?) (loop member)]
[(eq? =? eq?) (loop memq)]
[(eq? =? eqv?) (loop memv)]
[else (loop (lambda (x seen)
(ormap (lambda (y) (=? x y)) seen)))]))))))
(define (filter-map f l . ls)
(unless (and (procedure? f) (procedure-arity-includes? f (add1 (length ls))))

9
collects/scribblings/reference/pairs.scrbl
View File

@ -618,7 +618,10 @@ traversal.
(flatten 'a)
]}
@defproc[(remove-duplicates [lst list?] [same? (any/c any/c . -> . any/c) equal?])
@defproc[(remove-duplicates [lst list?]
[same? (any/c any/c . -> . any/c) equal?]
[#:key extract-key (any/c . -> . any/c)
(lambda (x) x)])
list?]{
Returns a list that has all items in @scheme[lst], but without
@ -627,6 +630,10 @@ of the list are equivalent. The resulting list is in the same order
as @scheme[lst], and for any item that occurs multiple times, the
first one is kept.
The @scheme[#:key] argument @scheme[extract-key] is used to extract a
key value from each list element, so two items are considered equal if
@scheme[(same? (extract-key x) (extract-key y))] is true.
@mz-examples[#:eval list-eval
(remove-duplicates '(a b b a))
(remove-duplicates '(1 2 1.0 0))

5
collects/tests/mzscheme/list.ss
View File

@ -242,11 +242,14 @@
(test '(a b) rd '(a b a b a b))
(test '(a b) rd '(a a a b b b))
(test '(a b) rd '(a b b a)) ; keeps first occurrences
(test '("a" "b") rd '("a" "A" "b" "B" "a") #:key string-downcase)
(let ([long (for/list ([i (in-range 300)]) i)])
(test long rd long)
(test long rd (append long long))
(test long rd (append long (reverse long))) ; keeps first
(test long rd (append* (map (lambda (x) (list x x)) long)))))
(test long rd (append* (map (lambda (x) (list x x)) long)))
(test long rd (append long (map (lambda (x) (- x)) long)) #:key abs)
(test long rd (append long (map (lambda (x) (- x)) long)) = #:key abs)))
;; ---------- filter and filter-not ----------
(let ()