hash.rkt: Add hash-intersect

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"]

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]))

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?))])