check-duplicate -> check-duplicates

For consistency with remove-duplicates.
This commit is contained in:
Vincent St-Amour 2015-07-17 15:47:31 -05:00
parent 7700b3d736
commit 1083a31965
3 changed files with 34 additions and 34 deletions

View File

@ -1114,9 +1114,9 @@ traversal.
(flatten 'a)]}
@defproc[(check-duplicate [lst list?]
[same? (any/c any/c . -> . any/c) equal?]
[#:key extract-key (-> any/c any/c) (lambda (x) x)])
@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)]{
Returns the first duplicate item in @racket[lst]. More precisely, it
@ -1129,11 +1129,11 @@ The procedures @racket[equal?], @racket[eqv?], and @racket[eq?] automatically
use a dictionary for speed.
@examples[#:eval list-eval
(check-duplicate '(1 2 3 4))
(check-duplicate '(1 2 3 2 1))
(check-duplicate '((a 1) (b 2) (a 3)) #:key car)
(check-duplicate '(1 2 3 4 5 6)
(lambda (x y) (equal? (modulo x 3) (modulo y 3))))
(check-duplicates '(1 2 3 4))
(check-duplicates '(1 2 3 2 1))
(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))))
]
}

View File

@ -328,17 +328,17 @@
(test `(,@fst ,@r2 ,@lst) add-between l x
#:splice? #t #:before-first fst #:after-last lst #:before-last y)))))
;; ---------- check-duplicate ----------
;; ---------- check-duplicates ----------
(test #f check-duplicate '())
(test 'a check-duplicate '(a a))
(test 'a check-duplicate '(a b a))
(test 'a check-duplicate '(a a b))
(test '(a 3) check-duplicate '((a 1) (b 2) (a 3)) #:key car)
(test 4 check-duplicate '(1 2 3 4 5 6) (lambda (x y) (equal? (modulo x 3) (modulo y 3))))
(err/rt-test (check-duplicate 'a))
(err/rt-test (check-duplicate '(1) #f))
(err/rt-test (check-duplicate '(1) #:key #f))
(test #f check-duplicates '())
(test 'a check-duplicates '(a a))
(test 'a check-duplicates '(a b a))
(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))))
(err/rt-test (check-duplicates 'a))
(err/rt-test (check-duplicates '(1) #f))
(err/rt-test (check-duplicates '(1) #:key #f))
;; ---------- remove-duplicates ----------
(let ()

View File

@ -35,7 +35,7 @@
flatten
add-between
remove-duplicates
check-duplicate
check-duplicates
filter-map
count
partition
@ -424,32 +424,32 @@
(cons x (loop l)))))))])])
(if key (loop key) (loop no-key)))])))
;; check-duplicate : (listof X)
;; [(K K -> bool)]
;; #:key (X -> K)
;; check-duplicates : (listof X)
;; [(K K -> bool)]
;; #:key (X -> K)
;; -> X or #f
(define (check-duplicate items
[same? equal?]
#:key [key values])
(define (check-duplicates items
[same? equal?]
#:key [key values])
(unless (list? items)
(raise-argument-error 'check-duplicate "list?" items))
(raise-argument-error 'check-duplicates "list?" items))
(unless (and (procedure? key)
(procedure-arity-includes? key 1))
(raise-argument-error 'check-duplicate "(-> any/c any/c)" key))
(raise-argument-error 'check-duplicates "(-> any/c any/c)" key))
(cond [(eq? same? equal?)
(check-duplicate/t items key (make-hash))]
(check-duplicates/t items key (make-hash))]
[(eq? same? eq?)
(check-duplicate/t items key (make-hasheq))]
(check-duplicates/t items key (make-hasheq))]
[(eq? same? eqv?)
(check-duplicate/t items key (make-hasheqv))]
(check-duplicates/t items key (make-hasheqv))]
[else
(unless (and (procedure? same?)
(procedure-arity-includes? same? 2))
(raise-argument-error 'check-duplicate
(raise-argument-error 'check-duplicates
"(any/c any/c . -> . any/c)"
same?))
(check-duplicate/list items key same?)]))
(define (check-duplicate/t items key table)
(check-duplicates/list items key same?)]))
(define (check-duplicates/t items key table)
(let loop ([items items])
(and (pair? items)
(let ([key-item (key (car items))])
@ -457,7 +457,7 @@
(car items)
(begin (hash-set! table key-item #t)
(loop (cdr items))))))))
(define (check-duplicate/list items key same?)
(define (check-duplicates/list items key same?)
(let loop ([items items] [sofar null])
(and (pair? items)
(let ([key-item (key (car items))])