Compare commits
7 Commits
74347b5151
...
cd8cada92e
Author | SHA1 | Date |
---|---|---|
Sergiu Ivanov | cd8cada92e | |
Sergiu Ivanov | 76c6bb5745 | |
Sergiu Ivanov | 18c9828a5a | |
Sergiu Ivanov | 738ad858ae | |
Sergiu Ivanov | ab56b64d38 | |
Sergiu Ivanov | 001a12d166 | |
Sergiu Ivanov | b9eb692091 |
|
@ -228,6 +228,34 @@ corresponds to the column giving the thresholds of the TBFs.
|
||||||
(tbf/state (hash 'a -2 'b 1) 1)))
|
(tbf/state (hash 'a -2 'b 1) 1)))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(sbfs/state->lists [sbfs (Listof TBF/State)])
|
||||||
|
(Listof (Listof Real))]{
|
||||||
|
|
||||||
|
Like @racket[tbfs/state->lists], but the thresholds are omitted.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(sbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 0)
|
||||||
|
(tbf/state (hash 'a -2 'b 1) 0)))
|
||||||
|
]
|
||||||
|
|
||||||
|
Note that this function just drops the threshold, without checking
|
||||||
|
whether it is actually 0:
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(sbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 3)))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(sbfs/state->lists+headers [sbfs (Listof TBF/State)])
|
||||||
|
(Pairof (Listof Variable) (Listof (Listof Real)))]{
|
||||||
|
|
||||||
|
Like @racket[sbfs/state->lists], but also shows the names of the
|
||||||
|
variables as column headers.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(sbfs/state->lists+headers (list (tbf/state (hash 'a 1 'b 2) 0)
|
||||||
|
(tbf/state (hash 'a -2 'b 1) 0)))
|
||||||
|
]}
|
||||||
|
|
||||||
@section{Tabulating TBFs and SBFs}
|
@section{Tabulating TBFs and SBFs}
|
||||||
|
|
||||||
@defproc[(tabulate-tbfs/state [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
|
@defproc[(tabulate-tbfs/state [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
|
||||||
|
@ -263,3 +291,73 @@ the list.
|
||||||
(list (tbf/state (hash 'a 1 'b 2) 2)
|
(list (tbf/state (hash 'a 1 'b 2) 2)
|
||||||
(tbf/state (hash 'a -2 'b 2) 1)))
|
(tbf/state (hash 'a -2 'b 2) 1)))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@deftogether[(@defproc[(tabulate-tbf/state [tbf TBF/State])
|
||||||
|
(Listof (Listof Real))]
|
||||||
|
@defproc[(tabulate-tbf/state+headers [tbf TBF/State])
|
||||||
|
(Pairof (Listof Variable) (Listof (Listof Real)))])]{
|
||||||
|
|
||||||
|
Like @racket[tabulate-tbfs/state] and
|
||||||
|
@racket[tabulate-tbfs/state+headers], but only tabulate single TBFs.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(tabulate-tbf/state (tbf/state (hash 'a 1 'b 2) 2))
|
||||||
|
(tabulate-tbf/state+headers (tbf/state (hash 'a 1 'b 2) 2))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@section{TBNs and SBNs}
|
||||||
|
|
||||||
|
@deftype[TBN]{
|
||||||
|
|
||||||
|
The type of a TBN, i.e. a mapping assigning to each variable
|
||||||
|
a @racket[TBF/State].
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(sbn? [tbn TBN]) Boolean]{
|
||||||
|
|
||||||
|
A SBN is a @racket[TBN] in which all @racket[TBF/State]s satisfy
|
||||||
|
@racket[sbf/state?].
|
||||||
|
|
||||||
|
All functions in @racket[tbn] must only reference variables appearing
|
||||||
|
in the network. This function does not check this condition.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(let ([f1 (tbf/state (hash 'a -1 'b 1) 0)]
|
||||||
|
[f2 (tbf/state (hash 'a -1 'b 1) 1)])
|
||||||
|
(values (sbn? (hash 'a f1 'b f1))
|
||||||
|
(sbn? (hash 'a f1 'b f2))))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(tbn->network [tbn TBN]) (Network (U Zero One))]{
|
||||||
|
|
||||||
|
Constructs a @racket[Network] out of the given @racket[tbn].
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(require (only-in "networks.rkt" update))
|
||||||
|
(let* ([tbn-form (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
|
||||||
|
'b (tbf/state (hash 'a -1 'b 1) 1))]
|
||||||
|
[tbn (tbn->network tbn-form)]
|
||||||
|
[s (hash 'a 0 'b 1)])
|
||||||
|
(update tbn s '(a b)))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@section{Miscellaneous utilities}
|
||||||
|
|
||||||
|
@defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])
|
||||||
|
(Listof (Listof (Listof Integer)))]{
|
||||||
|
|
||||||
|
Given the truth table @racket[tt] of a Boolean function, groups the
|
||||||
|
lines by the @italic{N}umber of @italic{A}ctivated @italic{I}nputs—the
|
||||||
|
number of inputs which are 1 in the input vector.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(group-truth-table-by-nai '((0 0 0 1)
|
||||||
|
(0 0 1 1)
|
||||||
|
(0 1 0 0)
|
||||||
|
(0 1 1 1)
|
||||||
|
(1 0 0 0)
|
||||||
|
(1 0 1 0)
|
||||||
|
(1 1 0 1)
|
||||||
|
(1 1 1 0)))
|
||||||
|
]}
|
||||||
|
|
118
tbn.rkt
118
tbn.rkt
|
@ -29,8 +29,14 @@
|
||||||
lists+vars->sbfs/state lists+headers->sbfs/state lists->sbfs/state
|
lists+vars->sbfs/state lists+headers->sbfs/state lists->sbfs/state
|
||||||
read-org-tbfs/state read-org-tbfs/state+headers
|
read-org-tbfs/state read-org-tbfs/state+headers
|
||||||
tbfs/state->lists tbfs/state->lists+headers
|
tbfs/state->lists tbfs/state->lists+headers
|
||||||
|
sbfs/state->lists sbfs/state->lists+headers
|
||||||
|
|
||||||
tabulate-tbfs/state tabulate-tbfs/state+headers
|
tabulate-tbfs/state tabulate-tbfs/state+headers
|
||||||
|
tabulate-tbf/state tabulate-tbf/state+headers
|
||||||
|
|
||||||
|
group-truth-table-by-nai
|
||||||
|
|
||||||
|
TBN sbn? tbn->network
|
||||||
)
|
)
|
||||||
|
|
||||||
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
|
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
|
||||||
|
@ -219,15 +225,31 @@
|
||||||
(: sbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
|
(: sbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
|
||||||
(define (sbfs/state->lists tbfs)
|
(define (sbfs/state->lists tbfs)
|
||||||
(for/list ([tbf (in-list tbfs)])
|
(for/list ([tbf (in-list tbfs)])
|
||||||
(append (hash-map (tbf/state-w tbf) (λ (_ [w : Real]) w) #t)
|
(hash-map (tbf/state-w tbf) (λ (_ [w : Real]) w) #t)))
|
||||||
(list (tbf/state-θ tbf)))))
|
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(test-case "tbfs/state->lists"
|
(test-case "sbfs/state->lists"
|
||||||
(check-equal?
|
(check-equal?
|
||||||
(tbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 3)
|
(sbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 0)
|
||||||
(tbf/state (hash 'a -2 'b 1) 1)))
|
(tbf/state (hash 'a -2 'b 1) 0)))
|
||||||
'((1 2 3) (-2 1 1)))))
|
'((1 2) (-2 1)))))
|
||||||
|
|
||||||
|
(: sbfs/state->lists+headers (-> (Listof TBF/State)
|
||||||
|
(Pairof (Listof Variable)
|
||||||
|
(Listof (Listof Real)))))
|
||||||
|
(define (sbfs/state->lists+headers tbfs)
|
||||||
|
(cons (hash-map (tbf/state-w (car tbfs))
|
||||||
|
(λ ([x : Symbol] _) x) #t)
|
||||||
|
(sbfs/state->lists tbfs)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "sbfs/state->list+headers"
|
||||||
|
(check-equal?
|
||||||
|
(sbfs/state->lists+headers (list (tbf/state (hash 'a 1 'b 2) 0)
|
||||||
|
(tbf/state (hash 'a -2 'b 1) 0)))
|
||||||
|
'((a b)
|
||||||
|
(1 2)
|
||||||
|
(-2 1)))))
|
||||||
|
|
||||||
(: tabulate-tbfs/state (-> (Listof TBF/State) (Listof (Listof Real))))
|
(: tabulate-tbfs/state (-> (Listof TBF/State) (Listof (Listof Real))))
|
||||||
(define (tabulate-tbfs/state tbfs)
|
(define (tabulate-tbfs/state tbfs)
|
||||||
|
@ -262,6 +284,90 @@
|
||||||
(0 1 0 1)
|
(0 1 0 1)
|
||||||
(1 0 0 0)
|
(1 0 0 0)
|
||||||
(1 1 1 0)))))
|
(1 1 1 0)))))
|
||||||
|
|
||||||
|
(: tabulate-tbf/state (-> TBF/State (Listof (Listof Real))))
|
||||||
|
(define (tabulate-tbf/state tbf)
|
||||||
|
(tabulate-tbfs/state (list tbf)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "tabulate-tbf/state"
|
||||||
|
(check-equal? (tabulate-tbf/state (tbf/state (hash 'a 1 'b 2) 2))
|
||||||
|
'((0 0 0)
|
||||||
|
(0 1 0)
|
||||||
|
(1 0 0)
|
||||||
|
(1 1 1)))))
|
||||||
|
|
||||||
|
(: tabulate-tbf/state+headers (-> TBF/State (Pairof (Listof Variable)
|
||||||
|
(Listof (Listof Real)))))
|
||||||
|
(define (tabulate-tbf/state+headers tbf)
|
||||||
|
(tabulate-tbfs/state+headers (list tbf)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "tabulate-tbf/state+headers"
|
||||||
|
(check-equal? (tabulate-tbf/state+headers (tbf/state (hash 'a 1 'b 2) 2))
|
||||||
|
'((a b f1)
|
||||||
|
(0 0 0)
|
||||||
|
(0 1 0)
|
||||||
|
(1 0 0)
|
||||||
|
(1 1 1)))))
|
||||||
|
|
||||||
|
(: group-truth-table-by-nai (-> (Listof (Listof Integer))
|
||||||
|
(Listof (Listof (Listof Integer)))))
|
||||||
|
(define (group-truth-table-by-nai tt)
|
||||||
|
(: sum (-> (Listof Integer) Integer))
|
||||||
|
(define (sum xs) (foldl + 0 xs))
|
||||||
|
(group-by (λ ([row : (Listof Integer)])
|
||||||
|
(drop-right row 1))
|
||||||
|
tt
|
||||||
|
(λ ([in1 : (Listof Integer)] [in2 : (Listof Integer)])
|
||||||
|
(= (sum in1) (sum in2)))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "group-truth-table-by-nai"
|
||||||
|
(check-equal? (group-truth-table-by-nai '((0 0 0 1)
|
||||||
|
(0 0 1 1)
|
||||||
|
(0 1 0 0)
|
||||||
|
(0 1 1 1)
|
||||||
|
(1 0 0 0)
|
||||||
|
(1 0 1 0)
|
||||||
|
(1 1 0 1)
|
||||||
|
(1 1 1 0)))
|
||||||
|
'(((0 0 0 1))
|
||||||
|
((0 0 1 1) (0 1 0 0) (1 0 0 0))
|
||||||
|
((0 1 1 1) (1 0 1 0) (1 1 0 1))
|
||||||
|
((1 1 1 0))))))
|
||||||
|
|
||||||
|
(define-type TBN (HashTable Variable TBF/State))
|
||||||
|
|
||||||
|
(: sbn? (-> TBN Boolean))
|
||||||
|
(define (sbn? tbn) (andmap sbf/state? (hash-values tbn)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "sbn?"
|
||||||
|
(define f1 (tbf/state (hash 'a -1 'b 1) 0))
|
||||||
|
(define f2 (tbf/state (hash 'a -1 'b 1) 1))
|
||||||
|
(check-true (sbn? (hash 'a f1 'b f1)))
|
||||||
|
(check-false (sbn? (hash 'a f1 'b f2))))
|
||||||
|
)
|
||||||
|
|
||||||
|
(: tbn->network (-> TBN (Network (U Zero One))))
|
||||||
|
(define (tbn->network tbn)
|
||||||
|
(make-01-network
|
||||||
|
(for/hash : (VariableMapping (UpdateFunction (U Zero One)))
|
||||||
|
([(x tbfx) (in-hash tbn)])
|
||||||
|
(values x (λ ([s : (State (U Zero One))])
|
||||||
|
(apply-tbf/state tbfx s))))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "tbn->network"
|
||||||
|
(define tbn-form (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
|
||||||
|
'b (tbf/state (hash 'a -1 'b 1) 1)))
|
||||||
|
(define tbn (tbn->network tbn-form))
|
||||||
|
(define s (hash 'a 0 'b 1))
|
||||||
|
(check-equal? (update tbn s '(a b))
|
||||||
|
#hash((a . 1) (b . 0)))
|
||||||
|
(check-equal? (network-domains tbn)
|
||||||
|
#hash((a . (0 1)) (b . (0 1))))))
|
||||||
)
|
)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
|
|
Loading…
Reference in New Issue