From 4e864a538723855c33be052536d9d63a14f8a8c8 Mon Sep 17 00:00:00 2001 From: Huma Zafar Date: Sun, 8 Oct 2017 22:38:34 +0000 Subject: [PATCH] Adds optional keyword argument to check-duplicates to determine returned value when no duplicate found. --- .../scribblings/reference/pairs.scrbl | 18 ++++++- pkgs/racket-test-core/tests/racket/list.rktl | 3 ++ racket/collects/racket/list.rkt | 52 ++++++++++--------- 3 files changed, 47 insertions(+), 26 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/pairs.scrbl b/pkgs/racket-doc/scribblings/reference/pairs.scrbl index 1eac38b42b..3156439381 100644 --- a/pkgs/racket-doc/scribblings/reference/pairs.scrbl +++ b/pkgs/racket-doc/scribblings/reference/pairs.scrbl @@ -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"]{} } diff --git a/pkgs/racket-test-core/tests/racket/list.rktl b/pkgs/racket-test-core/tests/racket/list.rktl index ed1a67da9e..a8a3cf845d 100644 --- a/pkgs/racket-test-core/tests/racket/list.rktl +++ b/pkgs/racket-test-core/tests/racket/list.rktl @@ -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)) diff --git a/racket/collects/racket/list.rkt b/racket/collects/racket/list.rkt index 3993c77937..6034cdaf6d 100644 --- a/racket/collects/racket/list.rkt +++ b/racket/collects/racket/list.rkt @@ -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,