networks: Add apply-tbf/state.

networks.rkt

@@ -82,6 +82,7 @@
                [tbf/state-w (-> tbf/state? (hash/c variable? number?))]
                [tbf/state-θ (-> tbf/state? number?)]
                [make-tbf/state (-> (listof (cons/c variable? number?)) number? tbf/state?)]
+               [apply-tbf/state (-> tbf/state? (hash/c variable? (or/c 0 1)) (or/c 0 1))]
                [apply-tbf-to-state (-> tbf? state? (or/c 0 1))])
  ;; Predicates
  (contract-out [variable? (-> any/c boolean?)]
@@ -963,5 +964,29 @@
     (check-equal? (tbf/state-w f) #hash((x1 . 1) (x2 . 1)))
     (check-equal? (tbf/state-θ f) 1)))
 
+;;; Applies a state TBF to its inputs.
+;;;
+;;; Applying a TBF consists in multiplying the weights by the
+;;; corresponding inputs and comparing the sum of the products to the
+;;; threshold.
+;;;
+;;; This function is similar to apply-tbf, but applies a state TBF (a
+;;; TBF with explicitly named inputs) to a state whose values are 0
+;;; and 1.
+(define (apply-tbf/state tbf st)
+  (any->01 (> (foldl + 0 (hash-values
+                          (hash-intersect (tbf/state-w tbf)
+                                          st
+                                          #:combine *)))
+              (tbf/state-θ tbf))))
+
+(module+ test
+  (test-case "apply-tbf/state"
+    (define st1 (make-state '((a . 1) (b . 0) (c . 1))))
+    (define st2 (make-state '((a . 1) (b . 1) (c . 0))))
+    (define tbf (make-tbf/state '((a . 2) (b . -2)) 1))
+    (check-equal? (apply-tbf/state tbf st1) 1)
+    (check-equal? (apply-tbf/state tbf st2) 0)))
+
 ;;; A TBN is a network form mapping TBFs to variables.
 (define tbn? (hash/c variable? tbf?))