diff --git a/networks.rkt b/networks.rkt index b690510..8bce423 100644 --- a/networks.rkt +++ b/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?))