utils: Add hash-intersect.

utils.rkt

@@ -50,7 +50,12 @@
                [boolean-power (-> number? (listof (listof boolean?)))]
                [boolean-power/stream (-> number? (stream/c (listof boolean?)))]
                [any->01 (-> any/c (or/c 0 1))]
-               [01->boolean (-> (or/c 0 1) boolean?)])
+               [01->boolean (-> (or/c 0 1) boolean?)]
+               [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?))])
  ;; Contracts
  (contract-out [variable-mapping? contract?]
                [string-variable-mapping? contract?]
@@ -586,6 +591,38 @@
   (test-case "lists-transpose"
     (check-equal? (lists-transpose '((1 2) (a b))) '((1 a) (2 b)))))
 
+;;; Like hash-union, but computes the intersection of hash
+;;; tables.
+;;;
+;;; The intersections are computed by functional update, intersecting
+;;; the first hash table with every other one supplied, one by one.
+;;; The new mappings are computed either using combine or combine/key.
+;;;
+;;; TODO: I submitted this function to the Racket repository.  Remove
+;;; this function from this module when the update gets applied.
+(define (hash-intersect
+         #:combine [combine #f]
+         #:combine/key [combine/key
+                        (if combine
+                            (λ (_ x y) (combine x y))
+                            (error 'hash-intersection))]
+         one . rest)
+  (define common-keys (apply set-intersect (map hash-keys (cons one rest))))
+  (define res (for/hash ([k (in-list common-keys)])
+                (values k (hash-ref one k))))
+  (for*/fold ([res res]) ([hm (in-list rest)]
+                          [(k v) (in-hash res)])
+    (hash-set res k (combine/key k v (hash-ref hm k)))))
+
+(module+ test
+  (test-case "hash-intersect"
+    (define h1 #hash((a . 1) (b . 2) (c . 3)))
+    (define h2 #hash((a . 4) (b . 5)))
+    (define h3 #hash((a . 7) (c . 8)))
+    (check-equal? (hash-intersect h1 h2 h3 #:combine +)
+                  '#hash((a . 12)))
+    (check-equal? (hash-intersect h1 h3 #:combine -)
+                  '#hash((a . -6) (c . -5)))))
 
 ;;; =========
 ;;; Functions