Move the functions for reading to TBN and SBN to the section on TBN.
This commit is contained in:
Sergiu Ivanov
parent
78462d5083
commit
f05024e61e
2 changed files with 188 additions and 188 deletions
|
|
@ -217,86 +217,6 @@ is taken to contain the names of the variables, similarly to
|
|||
(read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))")
|
||||
]}
|
||||
|
||||
@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
|
||||
[#:headers headers Boolean #t]
|
||||
[#:func-names func-names Boolean #t])
|
||||
TBN]{
|
||||
|
||||
Reads a TBN from a list of lists of numbers or symbols, which may
|
||||
represent an Org-mode table. As in @racket[lists->tbfs/state], the
|
||||
last element of each list is taken to be the threshold of the TBF, and
|
||||
the rest of the elements are taken to be the weights.
|
||||
|
||||
If @racket[headers] is @racket[#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 (corresponding to the column giving the
|
||||
threshold) is discarded. If @racket[headers] is @racket[#f], the
|
||||
names of the variables are generated as @tt{xi}, where @tt{i} is
|
||||
the index of the variable.
|
||||
|
||||
If @racket[func-names] is @racket[#t], the first element in every row
|
||||
except the first one are taken to be the name of the variable to which
|
||||
the TBF should be associated. If @racket[func-names] is @racket[#f],
|
||||
the functions are assigned to variables in lexicographic order.
|
||||
|
||||
@racket[func-names] cannot be @racket[#t] if @racket[headers] is
|
||||
@racket[#f]. The function does not check this condition.
|
||||
|
||||
This is a helper function for @racket[read-org-tbn] and
|
||||
@racket[read-org-sbn].
|
||||
|
||||
@ex[
|
||||
(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
|
||||
(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
|
||||
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t)
|
||||
]}
|
||||
|
||||
@defproc[(read-org-tbn [str String]
|
||||
[#:headers headers Boolean #t]
|
||||
[#:func-names func-names Boolean #t])
|
||||
TBN]{
|
||||
|
||||
Reads a TBN from an string containing a sexp, containing a list of
|
||||
lists of numbers and possibly symbols. This string may be produced by
|
||||
Org-mode.
|
||||
|
||||
As in @racket[lists->tbfs/state], 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.
|
||||
|
||||
As in @racket[parse-org-tbn], if @racket[headers] is @racket[#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 @racket[headers] is @racket[#f], the names of the variables are
|
||||
generated as @tt{xi}, where @tt{i} is the index of the variable.
|
||||
|
||||
If @racket[func-names] is @racket[#t], the first element in every row
|
||||
except the first one, are taken to be the name of the variable to
|
||||
which the TBF should be associated. If @racket[func-names] is
|
||||
@racket[#f], the functions are assigned to variables in
|
||||
alphabetical order.
|
||||
|
||||
As in @racket[parse-org-tbn], @racket[func-names] cannot be
|
||||
@racket[#t] if @racket[headers] is @racket[#f]. The function does not
|
||||
check this condition.
|
||||
|
||||
@ex[
|
||||
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
|
||||
]}
|
||||
|
||||
@defproc[(read-org-sbn [str String]
|
||||
[#:headers headers Boolean #t]
|
||||
[#:func-names func-names Boolean #t])
|
||||
TBN]{
|
||||
|
||||
Like @racket[read-org-tbn], but reads an SBN from the input string,
|
||||
i.e. all the numbers are taken to be the weights, and the threshold is
|
||||
set to 0.
|
||||
|
||||
@ex[
|
||||
(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
|
||||
]}
|
||||
|
||||
@defproc[(tbfs/state->lists [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
|
||||
|
||||
Given a list of @racket[TBF/State], produces a sexp that Org-mode can
|
||||
|
|
@ -438,6 +358,86 @@ Constructs a @racket[Network] out of the given @racket[tbn].
|
|||
(update tbn s '(a b)))
|
||||
]}
|
||||
|
||||
@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
|
||||
[#:headers headers Boolean #t]
|
||||
[#:func-names func-names Boolean #t])
|
||||
TBN]{
|
||||
|
||||
Reads a TBN from a list of lists of numbers or symbols, which may
|
||||
represent an Org-mode table. As in @racket[lists->tbfs/state], the
|
||||
last element of each list is taken to be the threshold of the TBF, and
|
||||
the rest of the elements are taken to be the weights.
|
||||
|
||||
If @racket[headers] is @racket[#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 (corresponding to the column giving the
|
||||
threshold) is discarded. If @racket[headers] is @racket[#f], the
|
||||
names of the variables are generated as @tt{xi}, where @tt{i} is
|
||||
the index of the variable.
|
||||
|
||||
If @racket[func-names] is @racket[#t], the first element in every row
|
||||
except the first one are taken to be the name of the variable to which
|
||||
the TBF should be associated. If @racket[func-names] is @racket[#f],
|
||||
the functions are assigned to variables in lexicographic order.
|
||||
|
||||
@racket[func-names] cannot be @racket[#t] if @racket[headers] is
|
||||
@racket[#f]. The function does not check this condition.
|
||||
|
||||
This is a helper function for @racket[read-org-tbn] and
|
||||
@racket[read-org-sbn].
|
||||
|
||||
@ex[
|
||||
(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
|
||||
(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
|
||||
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t)
|
||||
]}
|
||||
|
||||
@defproc[(read-org-tbn [str String]
|
||||
[#:headers headers Boolean #t]
|
||||
[#:func-names func-names Boolean #t])
|
||||
TBN]{
|
||||
|
||||
Reads a TBN from an string containing a sexp, containing a list of
|
||||
lists of numbers and possibly symbols. This string may be produced by
|
||||
Org-mode.
|
||||
|
||||
As in @racket[lists->tbfs/state], 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.
|
||||
|
||||
As in @racket[parse-org-tbn], if @racket[headers] is @racket[#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 @racket[headers] is @racket[#f], the names of the variables are
|
||||
generated as @tt{xi}, where @tt{i} is the index of the variable.
|
||||
|
||||
If @racket[func-names] is @racket[#t], the first element in every row
|
||||
except the first one, are taken to be the name of the variable to
|
||||
which the TBF should be associated. If @racket[func-names] is
|
||||
@racket[#f], the functions are assigned to variables in
|
||||
alphabetical order.
|
||||
|
||||
As in @racket[parse-org-tbn], @racket[func-names] cannot be
|
||||
@racket[#t] if @racket[headers] is @racket[#f]. The function does not
|
||||
check this condition.
|
||||
|
||||
@ex[
|
||||
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
|
||||
]}
|
||||
|
||||
@defproc[(read-org-sbn [str String]
|
||||
[#:headers headers Boolean #t]
|
||||
[#:func-names func-names Boolean #t])
|
||||
TBN]{
|
||||
|
||||
Like @racket[read-org-tbn], but reads an SBN from the input string,
|
||||
i.e. all the numbers are taken to be the weights, and the threshold is
|
||||
set to 0.
|
||||
|
||||
@ex[
|
||||
(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
|
||||
]}
|
||||
|
||||
@defproc[(build-tbn-state-graph [tbn TBN]) Graph]{
|
||||
|
||||
Builds the state graph of a @racket[TBN].
|
||||
|
|
|
|||
216
tbn.rkt
216
tbn.rkt
|
|
@ -214,114 +214,6 @@
|
|||
(list (tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||
(tbf/state '#hash((a . 1) (b . 1)) 2)))))
|
||||
|
||||
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
|
||||
(#:headers Boolean
|
||||
#:func-names Boolean)
|
||||
TBN))
|
||||
(define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t])
|
||||
(cond [func-names
|
||||
(define-values (vars rows) (multi-split-at tab 1))
|
||||
(define tbfs (lists->tbfs/state/opt-headers rows #:headers headers))
|
||||
(for/hash : TBN
|
||||
([tbf (in-list tbfs)]
|
||||
[var (in-list (cdr vars))])
|
||||
(values (assert-type (car var) Variable) tbf))]
|
||||
[else
|
||||
(define tbfs (lists->tbfs/state/opt-headers tab #:headers headers))
|
||||
(define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
|
||||
(for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)])
|
||||
(values (assert-type var Variable) tbf))]))
|
||||
|
||||
(module+ test
|
||||
(test-case "parse-org-tbn"
|
||||
(check-equal?
|
||||
(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
|
||||
(hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
|
||||
'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1)))
|
||||
(check-equal?
|
||||
(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
|
||||
(hash
|
||||
'a
|
||||
(tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||
'b
|
||||
(tbf/state '#hash((a . 3) (b . 2)) 1)))
|
||||
(check-equal?
|
||||
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3))
|
||||
#:headers #t
|
||||
#:func-names #t)
|
||||
(hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||
'b (tbf/state '#hash((a . 3) (b . 2)) 1)))))
|
||||
|
||||
(: read-org-tbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
|
||||
(define (read-org-tbn str
|
||||
#:headers [headers #t]
|
||||
#:func-names [func-names #t])
|
||||
(parse-org-tbn (assert-type (read-org-sexp str)
|
||||
(Listof (Listof (U Symbol Real))))
|
||||
#:headers headers
|
||||
#:func-names func-names))
|
||||
|
||||
(module+ test
|
||||
(test-case "read-org-tbn"
|
||||
(check-equal?
|
||||
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . 0) (y . -1)) -1)
|
||||
'y
|
||||
(tbf/state '#hash((x . -1) (y . 0)) -1)))
|
||||
(check-equal?
|
||||
(read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f)
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . -1) (y . 0)) -1)
|
||||
'y
|
||||
(tbf/state '#hash((x . 0) (y . -1)) -1)))
|
||||
(check-equal?
|
||||
(read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f)
|
||||
(hash
|
||||
'x0
|
||||
(tbf/state '#hash((x0 . -1) (x1 . 0)) -1)
|
||||
'x1
|
||||
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
|
||||
|
||||
(: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
|
||||
(define (read-org-sbn str
|
||||
#:headers [headers #t]
|
||||
#:func-names [func-names #t])
|
||||
(define sexp (assert-type (read-org-sexp str)
|
||||
(Listof (Listof (U Symbol Real)))))
|
||||
;; Inject the 0 thresholds into the rows of the sexp we have just read.
|
||||
(: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real)))))
|
||||
(define (inject-0 rows)
|
||||
(for/list : (Listof (Listof (U Symbol Real)))
|
||||
([row (in-list rows)]) (append row '(0))))
|
||||
(define sexp-ready (if headers
|
||||
(cons (append (car sexp) '(θ)) (inject-0 (cdr sexp)))
|
||||
(inject-0 sexp)))
|
||||
(parse-org-tbn sexp-ready #:headers headers #:func-names func-names))
|
||||
|
||||
(module+ test
|
||||
(test-case "read-org-sbn"
|
||||
(check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . 0) (y . -1)) 0)
|
||||
'y
|
||||
(tbf/state '#hash((x . -1) (y . 0)) 0)))
|
||||
(check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f)
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . -1) (y . 0)) 0)
|
||||
'y
|
||||
(tbf/state '#hash((x . 0) (y . -1)) 0)))
|
||||
(check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f)
|
||||
(hash
|
||||
'x0
|
||||
(tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
|
||||
'x1
|
||||
(tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
|
||||
|
||||
(: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
|
||||
(define (tbfs/state->lists tbfs)
|
||||
(for/list ([tbf (in-list tbfs)])
|
||||
|
|
@ -500,6 +392,114 @@
|
|||
(check-equal? (network-domains tbn)
|
||||
#hash((a . (0 1)) (b . (0 1))))))
|
||||
|
||||
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
|
||||
(#:headers Boolean
|
||||
#:func-names Boolean)
|
||||
TBN))
|
||||
(define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t])
|
||||
(cond [func-names
|
||||
(define-values (vars rows) (multi-split-at tab 1))
|
||||
(define tbfs (lists->tbfs/state/opt-headers rows #:headers headers))
|
||||
(for/hash : TBN
|
||||
([tbf (in-list tbfs)]
|
||||
[var (in-list (cdr vars))])
|
||||
(values (assert-type (car var) Variable) tbf))]
|
||||
[else
|
||||
(define tbfs (lists->tbfs/state/opt-headers tab #:headers headers))
|
||||
(define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
|
||||
(for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)])
|
||||
(values (assert-type var Variable) tbf))]))
|
||||
|
||||
(module+ test
|
||||
(test-case "parse-org-tbn"
|
||||
(check-equal?
|
||||
(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
|
||||
(hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
|
||||
'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1)))
|
||||
(check-equal?
|
||||
(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
|
||||
(hash
|
||||
'a
|
||||
(tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||
'b
|
||||
(tbf/state '#hash((a . 3) (b . 2)) 1)))
|
||||
(check-equal?
|
||||
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3))
|
||||
#:headers #t
|
||||
#:func-names #t)
|
||||
(hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||
'b (tbf/state '#hash((a . 3) (b . 2)) 1)))))
|
||||
|
||||
(: read-org-tbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
|
||||
(define (read-org-tbn str
|
||||
#:headers [headers #t]
|
||||
#:func-names [func-names #t])
|
||||
(parse-org-tbn (assert-type (read-org-sexp str)
|
||||
(Listof (Listof (U Symbol Real))))
|
||||
#:headers headers
|
||||
#:func-names func-names))
|
||||
|
||||
(module+ test
|
||||
(test-case "read-org-tbn"
|
||||
(check-equal?
|
||||
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . 0) (y . -1)) -1)
|
||||
'y
|
||||
(tbf/state '#hash((x . -1) (y . 0)) -1)))
|
||||
(check-equal?
|
||||
(read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f)
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . -1) (y . 0)) -1)
|
||||
'y
|
||||
(tbf/state '#hash((x . 0) (y . -1)) -1)))
|
||||
(check-equal?
|
||||
(read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f)
|
||||
(hash
|
||||
'x0
|
||||
(tbf/state '#hash((x0 . -1) (x1 . 0)) -1)
|
||||
'x1
|
||||
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
|
||||
|
||||
(: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
|
||||
(define (read-org-sbn str
|
||||
#:headers [headers #t]
|
||||
#:func-names [func-names #t])
|
||||
(define sexp (assert-type (read-org-sexp str)
|
||||
(Listof (Listof (U Symbol Real)))))
|
||||
;; Inject the 0 thresholds into the rows of the sexp we have just read.
|
||||
(: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real)))))
|
||||
(define (inject-0 rows)
|
||||
(for/list : (Listof (Listof (U Symbol Real)))
|
||||
([row (in-list rows)]) (append row '(0))))
|
||||
(define sexp-ready (if headers
|
||||
(cons (append (car sexp) '(θ)) (inject-0 (cdr sexp)))
|
||||
(inject-0 sexp)))
|
||||
(parse-org-tbn sexp-ready #:headers headers #:func-names func-names))
|
||||
|
||||
(module+ test
|
||||
(test-case "read-org-sbn"
|
||||
(check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . 0) (y . -1)) 0)
|
||||
'y
|
||||
(tbf/state '#hash((x . -1) (y . 0)) 0)))
|
||||
(check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f)
|
||||
(hash
|
||||
'x
|
||||
(tbf/state '#hash((x . -1) (y . 0)) 0)
|
||||
'y
|
||||
(tbf/state '#hash((x . 0) (y . -1)) 0)))
|
||||
(check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f)
|
||||
(hash
|
||||
'x0
|
||||
(tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
|
||||
'x1
|
||||
(tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
|
||||
|
||||
(: build-tbn-state-graph (-> TBN Graph))
|
||||
(define (build-tbn-state-graph tbn)
|
||||
(pretty-print-state-graph
|
||||
|
|
|
|||
Loading…
Reference in a new issue