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

networks: Add read-org-sbn.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-10-22 00:59:58 +02:00
parent a3f3a5616d
commit 2dd38fa4dc
1 changed files with 41 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
networks.rkt
View file

@ -112,6 +112,9 @@
(#:headers boolean? #:func-names boolean?) (#:headers boolean? #:func-names boolean?)
tbn?)] tbn?)]
[read-org-tbn (->* (string?) [read-org-tbn (->* (string?)
(#:headers boolean? #:func-names boolean?)
tbn?)]
[read-org-sbn (->* (string?)
(#:headers boolean? #:func-names boolean?) (#:headers boolean? #:func-names boolean?)
tbn?)]) tbn?)])
;; Predicates ;; Predicates
@ -1415,23 +1418,51 @@
(tbf/state '#hash((x0 . -1) (x1 . 0)) -1) (tbf/state '#hash((x0 . -1) (x1 . 0)) -1)
'x1 'x1
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1))))) (tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
;;; Like read-org-tbn, but reads an SBN from an Org-mode string
;;; containing a sexp, containing a list of lists of numbers.
;;;
;;; As in read-org-sbfs/state, if headers is #t, the names of the
;;; variables to appear as the inputs of the SBF 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-sbn str
#:headers [headers #t]
#:func-names [func-names #t])
(define sexp (read-org-sexp str))
;; Inject the 0 thresholds into the rows of the sexp we have just read.
(define (inject-0 rows) (for/list ([row (in-list rows)]) (append row '(0))))
(define sexp-ready (if headers
(cons (car sexp) (inject-0 (cdr sexp)))
(inject-0 sexp)))
(parse-org-tbn sexp-ready #:headers headers #:func-names func-names))
(module+ test (module+ test
(test-case "read-org-tbn" (test-case "read-org-sbn, parse-org-tbn"
(check-equal? (read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))") (check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
(hash (hash
'x 'x
(tbf/state '#hash((x . 0) (y . -1)) -1) (tbf/state '#hash((x . 0) (y . -1)) 0)
'y 'y
(tbf/state '#hash((x . -1) (y . 0)) -1))) (tbf/state '#hash((x . -1) (y . 0)) 0)))
(check-equal? (read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f) (check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f)
(hash (hash
'x 'x
(tbf/state '#hash((x . -1) (y . 0)) -1) (tbf/state '#hash((x . -1) (y . 0)) 0)
'y 'y
(tbf/state '#hash((x . 0) (y . -1)) -1))) (tbf/state '#hash((x . 0) (y . -1)) 0)))
(check-equal? (read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f) (check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f)
(hash (hash
'x0 'x0
(tbf/state '#hash((x0 . -1) (x1 . 0)) -1) (tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
'x1 'x1
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1))))) (tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))