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

Adds optional keyword argument to check-duplicates to determine returned value when no duplicate found.

Browse Source
This commit is contained in:
Huma Zafar 2017-10-08 22:38:34 +00:00 committed by Vincent St-Amour
parent f214ea761a
commit 4e864a5387
3 changed files with 47 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/racket-doc/scribblings/reference/pairs.scrbl
View File

@ -1173,13 +1173,26 @@ traversal.
@defproc[(check-duplicates [lst list?]
[same? (any/c any/c . -> . any/c) equal?]
[#:key extract-key (-> any/c any/c) (lambda (x) x)])
(or/c any/c #f)]{
[#:key extract-key (-> any/c any/c) (lambda (x) x)]
[#:default failure-result (failure-result/c any/c) (lambda () #f)])
any]{
Returns the first duplicate item in @racket[lst]. More precisely, it
returns the first @racket[_x] such that there was a previous
@racket[_y] where @racket[(same? (extract-key _x) (extract-key _y))].
If no duplicate is found, then @racket[failure-result] determines the
result:
@itemize[
@item{If @racket[failure-result] is a procedure, it is called
(through a tail call) with no arguments to produce the result.}
@item{Otherwise, @racket[failure-result] is returned as the result.}
]
The @racket[same?] argument should be an equivalence predicate such as
@racket[equal?] or @racket[eqv?] or a dictionary.
The procedures @racket[equal?], @racket[eqv?], and @racket[eq?] automatically
@ -1191,6 +1204,7 @@ use a dictionary for speed.
(check-duplicates '((a 1) (b 2) (a 3)) #:key car)
(check-duplicates '(1 2 3 4 5 6)
(lambda (x y) (equal? (modulo x 3) (modulo y 3))))
(check-duplicates '(1 2 3 4) #:default "no duplicates")
]
@history[#:added "6.3"]{}
}

3
pkgs/racket-test-core/tests/racket/list.rktl
View File

@ -336,6 +336,9 @@
(test 'a check-duplicates '(a a b))
(test '(a 3) check-duplicates '((a 1) (b 2) (a 3)) #:key car)
(test 4 check-duplicates '(1 2 3 4 5 6) (lambda (x y) (equal? (modulo x 3) (modulo y 3))))
(test #f check-duplicates '(#t #f #f) #:default "no dups")
(test "no dups" check-duplicates '(#t #f) #:default "no dups")
(test "no dups" check-duplicates '(#t #f) #:default (lambda () "no dups"))
(err/rt-test (check-duplicates 'a))
(err/rt-test (check-duplicates '(1) #f))
(err/rt-test (check-duplicates '(1) #:key #f))

52
racket/collects/racket/list.rkt
View File

@ -440,41 +440,45 @@
;; -> X or #f
(define (check-duplicates items
[same? equal?]
#:key [key values])
#:key [key values]
#:default [failure-result (λ () #f)])
(unless (list? items)
(raise-argument-error 'check-duplicates "list?" 0 items))
(unless (and (procedure? key)
(procedure-arity-includes? key 1))
(raise-argument-error 'check-duplicates "(-> any/c any/c)" key))
(cond [(eq? same? equal?)
(check-duplicates/t items key (make-hash))]
[(eq? same? eq?)
(check-duplicates/t items key (make-hasheq))]
[(eq? same? eqv?)
(check-duplicates/t items key (make-hasheqv))]
[else
(unless (and (procedure? same?)
(procedure-arity-includes? same? 2))
(raise-argument-error 'check-duplicates
"(any/c any/c . -> . any/c)"
1 items same?))
(check-duplicates/list items key same?)]))
(define (check-duplicates/t items key table)
(let ([fail-k (if (procedure? failure-result) failure-result (λ () failure-result))])
(cond [(eq? same? equal?)
(check-duplicates/t items key (make-hash) fail-k)]
[(eq? same? eq?)
(check-duplicates/t items key (make-hasheq) fail-k)]
[(eq? same? eqv?)
(check-duplicates/t items key (make-hasheqv) fail-k)]
[else
(unless (and (procedure? same?)
(procedure-arity-includes? same? 2))
(raise-argument-error 'check-duplicates
"(any/c any/c . -> . any/c)"
1 items same?))
(check-duplicates/list items key same? fail-k)])))
(define (check-duplicates/t items key table fail-k)
(let loop ([items items])
(and (pair? items)
(let ([key-item (key (car items))])
(if (hash-ref table key-item #f)
(if (pair? items)
(let ([key-item (key (car items))])
(if (hash-ref table key-item #f)
(car items)
(begin (hash-set! table key-item #t)
(loop (cdr items))))))))
(define (check-duplicates/list items key same?)
(loop (cdr items)))))
(fail-k))))
(define (check-duplicates/list items key same? fail-k)
(let loop ([items items] [sofar null])
(and (pair? items)
(let ([key-item (key (car items))])
(if (for/or ([prev (in-list sofar)])
(if (pair? items)
(let ([key-item (key (car items))])
(if (for/or ([prev (in-list sofar)])
(same? key-item prev))
(car items)
(loop (cdr items) (cons key-item sofar)))))))
(loop (cdr items) (cons key-item sofar))))
(fail-k))))
;; Eli: Just to have a record of this: my complaint about having this
;; code separately from `remove-duplicates' still stands. Specifically,