diff --git a/pkgs/racket-doc/scribblings/reference/hashes.scrbl b/pkgs/racket-doc/scribblings/reference/hashes.scrbl index 1be175bcbd..5e691f94fa 100644 --- a/pkgs/racket-doc/scribblings/reference/hashes.scrbl +++ b/pkgs/racket-doc/scribblings/reference/hashes.scrbl @@ -758,4 +758,41 @@ h } +@defproc[(hash-intersect [h0 (and/c hash? (not/c immutable?))] + [h hash?] ... + [#:combine combine + (-> any/c any/c any/c) + (lambda _ (error 'hash-intersect ...))] + [#:combine/key combine/key + (-> any/c any/c any/c any/c) + (lambda (k a b) (combine a b))]) + (and/c hash? immutable?)] { + +Constructs the hash table which is the intersection of @racket[h0] +with every hash table @racket[h]. In the resulting hash table, a key +@racket[k] is mapped to a combination of the values to which +@racket[k] is mapped in each of the hash tables. The final values are +computed by stepwise combination of the values appearing in each of +the hash tables by applying @racket[(combine/key k v vi)] or +@racket[(combine v vi)], where @racket[vi] is the value to which +@racket[k] is mapped in the i-th hash table @racket[h], and +@racket[v] is the accumulation of the values from the previous steps. +The comparison predicate of the first argument (@racket[eq?], +@racket[eqv?], @racket[equal?]) determines the one for the result. + +@examples[ +#:eval the-eval +(hash-intersect (make-immutable-hash '((a . 1) (b . 2) (c . 3))) + (make-immutable-hash '((a . 4) (b . 5))) + #:combine +) +(hash-intersect (make-immutable-hash '((a . 1) (b . 2) (c . 3))) + (make-immutable-hash '((a . 4) (b . 5))) + #:combine/key + (lambda (k v1 v2) (if (eq? k 'a) (+ v1 v2) (- v1 v2)))) +] + +} + @(close-eval the-eval) + +@history[#:added "7.8.0.11"] diff --git a/pkgs/racket-test-core/tests/racket/hash.rktl b/pkgs/racket-test-core/tests/racket/hash.rktl index 8875631331..3edabb9e81 100644 --- a/pkgs/racket-test-core/tests/racket/hash.rktl +++ b/pkgs/racket-test-core/tests/racket/hash.rktl @@ -65,6 +65,20 @@ hash-union #hash([one . 1] [two . 1]) #hash([three . 3] [four . 4] [two . 1]) #:combine +) +(test #hash((a . 5) (b . 7)) + hash-intersect #hash((a . 1) (b . 2) (c . 3)) #hash((a . 4) (b . 5)) + #:combine +) +(test #hash((a . 5) (b . -3)) + hash-intersect #hash((a . 1) (b . 2) (c . 3)) #hash((a . 4) (b . 5)) + #:combine/key + (lambda (k v1 v2) (if (eq? k 'a) (+ v1 v2) (- v1 v2)))) + +;; Does hash-intersect preserve the kind of the hash? +(test (hasheq "a" 11) + hash-intersect (hasheq "a" 1 (string #\a) 2 (string #\a) 3) + (hasheq "a" 10 (string #\a) 20) + #:combine +) + (let () (define h (make-hash)) (hash-union! h #hash([1 . one] [2 . two])) diff --git a/racket/collects/racket/hash.rkt b/racket/collects/racket/hash.rkt index 961ec1b71b..db517a514e 100644 --- a/racket/collects/racket/hash.rkt +++ b/racket/collects/racket/hash.rkt @@ -28,6 +28,31 @@ (combine/key k (hash-ref one k) v) v)))) +(define (hash-intersect + #:combine [combine #f] + #:combine/key [combine/key + (if combine + (λ (_ x y) (combine x y)) + (hash-duplicate-error 'hash-intersect))] + . hashes) + (define one (car hashes)) + (define rest (cdr hashes)) + (define empty-h (hash-clear one)) ;; empty hash of same type as one + (define (argmin f lst) ;; avoid racket/list to improve loading time + (for/fold ([best (car lst)] [fbest (f (car lst))] + #:result best) + ([x lst]) + (define fx (f x)) + (if (< fx fbest) (values x fx) (values best fbest)))) + (for/fold ([res empty-h]) + ([k (in-hash-keys (argmin hash-count hashes))]) + (if (for/and ([h (in-list hashes)]) (hash-has-key? h k)) + (hash-set res k + (for/fold ([v (hash-ref one k)]) + ([hm (in-list rest)]) + (combine/key k v (hash-ref hm k)))) + res))) + (provide/contract [hash-union (->* [(and/c hash? immutable?)] [#:combine @@ -42,4 +67,11 @@ #:combine/key (-> any/c any/c any/c any/c)] #:rest (listof hash?) - void?)]) + void?)] + [hash-intersect (->* [(and/c hash? immutable?)] + [#:combine + (-> any/c any/c any/c) + #:combine/key + (-> any/c any/c any/c any/c)] + #:rest (listof hash?) + (and/c hash? immutable?))])