scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

networks: Add read-org-tbn.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-10-17 23:51:51 +02:00
parent 7555db41ef
commit 5f80bd0443
1 changed files with 59 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
networks.rkt
View file

@ -103,7 +103,10 @@
(listof (listof (or/c symbol? number?))))]
[make-tbn (-> (listof (cons/c variable? tbf/state?)) tbn?)]
[tbn->network (-> tbn? network?)]
[make-sbn (-> (listof (cons/c variable? tbf/state?)) sbn?)])
[make-sbn (-> (listof (cons/c variable? tbf/state?)) sbn?)]
[read-org-tbn (->* (string?)
(#:headers boolean? #:func-names boolean?)
tbn?)])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)]
@ -1288,3 +1291,58 @@
(define s2 (make-state '((a . 1) (b . 1))))
(check-equal? (update sn s2 '(a b))
(make-state '((a . 0) (b . 1))))))
;;; Reads a TBN from an Org-mode string containing a sexp, containing
;;; a list of lists of numbers. As in 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 read-org-tbfs/state, 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.
;;;
;;; If func-names is #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 func-names is #f, the functions are
;;; assigned to variables in alphabetical order.
;;;
;;; func-names cannot be #t if headers is #f. The function does not
;;; check this condition.
(define (read-org-tbn str
#:headers [headers #t]
#:func-names [func-names #t])
(define sexp (read-org-sexp str))
(cond
[(eq? func-names #t)
(define-values (vars rows) (multi-split-at sexp 1))
(define tbfs (lists->tbfs/state rows #:headers headers))
(for/hash ([tbf (in-list tbfs)] [var (in-list (cdr vars))])
(values (car var) tbf))]
[else
(define tbfs (lists->tbfs/state sexp #:headers headers))
(define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
(for/hash ([tbf (in-list tbfs)] [var (in-list vars)])
(values var tbf))]))
(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)))))