From 73756d89741eef5959eb7f2eaccb4d6351fb5140 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sat, 31 Oct 2020 00:19:38 +0100
Subject: [PATCH] utils: Add hash-filter.

---
 utils.rkt | 35 ++++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/utils.rkt b/utils.rkt
index 3fa859c..3d9bcce 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -55,7 +55,11 @@
                                     [#:combine (-> any/c any/c any/c)
                                      #:combine/key (-> any/c any/c any/c any/c)]
                                     #:rest (listof hash?)
-                                    (and/c hash? immutable?))])
+                                    (and/c hash? immutable?))]
+               [hash-filter (->* (hash?)
+                                 (#:predicate (-> any/c boolean?)
+                                  #:predicate/key (-> any/c any/c boolean?))
+                                 hash?)])
  ;; Contracts
  (contract-out [variable-mapping? contract?]
                [string-variable-mapping? contract?]
@@ -624,6 +628,35 @@
     (check-equal? (hash-intersect h1 h3 #:combine -)
                   '#hash((a . -6) (c . -5)))))
 
+;;; Functionally filters a hash table: only keeps the key-value pairs
+;;; that satisfy a given criterion.
+;;;
+;;; The filtering criterion should be specified either via #:predicate
+;;; or #:predicate/key.  #:predicate should be a function returning
+;;; a Boolean result given a value of the hash value.  #:predicate
+;;; should be a function taking a key and the corresponding value.
+(define (hash-filter
+         ht
+         #:predicate [predicate #f]
+         #:predicate/key [predicate/key
+                          (if predicate
+                              (λ (_ v) (predicate v))
+                              (error 'hash-filter))])
+  (for/fold ([filtered-pairs (hash-clear ht)])
+            ([(k v) (in-hash ht)])
+    (if (predicate/key k v)
+        (hash-set filtered-pairs k v)
+        filtered-pairs)))
+
+(module+ test
+  (test-case "hash-filter"
+    (check-equal? (hash-filter (hash 'a 0 'b 1 'c 0)
+                               #:predicate (compose not zero?))
+                  #hash((b . 1)))
+    (check-equal? (hash-filter (hash 'a 0 'b 1 'c 0) #:predicate/key
+                               (λ (k v) (and (eq? k 'b) (not (zero? v)))))
+                  '#hash((b . 1)))))
+
 ;;; =========
 ;;; Functions
 ;;; =========