networks: Add lists->tbfs/state.

networks.rkt

@@ -83,7 +83,10 @@
                [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/state (-> tbf/state? (hash/c variable? (or/c 0 1)) (or/c 0 1))]
+               [lists->tbfs/state (->* ((listof (listof (or/c number? symbol?))))
+                                       (#:headers boolean?)
+                                       (listof tbf/state?))])
  ;; Predicates
  (contract-out [variable? (-> any/c boolean?)]
                [state? (-> any/c boolean?)]
@@ -988,5 +991,42 @@
     (check-equal? (apply-tbf/state tbf st1) 1)
     (check-equal? (apply-tbf/state tbf st2) 0)))
 
+;;; Reads a list of tbf/state from a list of list of numbers.
+;;;
+;;; The last element of each list is taken to be the threshold of the
+;;; TBFs, and the rest of the elements are taken to be the weights.
+;;;
+;;; If headers is #t, the names of the variables to appear as the
+;;; inputs of the TBF are taken from the first list.  The last element
+;;; of this list is discarded.
+;;;
+;;; If headers is #f, the names of the variables are generated as xi,
+;;; where i is the index of the variable.
+(define (lists->tbfs/state lsts #:headers [headers #t])
+  (define-values (var-names rows)
+    (if headers
+        (values (car lsts) (cdr lsts))
+        (values (for/list ([i (in-range (length (car lsts)))])
+                  (string->symbol (format "x~a" i)))
+                lsts)))
+  (for/list ([lst (in-list rows)])
+    (define-values (ws θ) (split-at-right lst 1))
+    (make-tbf/state (for/list ([x (in-list var-names)]
+                               [w (in-list ws)])
+                      (cons x w))
+                    (car θ))))
+
+(module+ test
+  (test-case "lists->tbfs/state"
+    (define tbfs '((1 2 3) (1 1 2)))
+    (check-equal? (lists->tbfs/state tbfs #:headers #f)
+                  (list
+                   (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
+                   (tbf/state '#hash((x0 . 1) (x1 . 1)) 2)))
+    (check-equal? (lists->tbfs/state (cons '(a b f) tbfs))
+                  (list
+                   (tbf/state '#hash((a . 1) (b . 2)) 3)
+                   (tbf/state '#hash((a . 1) (b . 1)) 2)))))
+
 ;;; A TBN is a network form mapping TBFs to variables.
 (define tbn? (hash/c variable? tbf?))