networks: Add lists->tbfs/state.
This commit is contained in:
parent
e85cfd9f0f
commit
82c1849660
1 changed files with 41 additions and 1 deletions
42
networks.rkt
42
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?))
|
||||
|
|
Loading…
Reference in a new issue