networks: Add print-org-tbfs/state.

This commit is contained in:
Sergiu Ivanov 2020-10-12 00:24:10 +02:00
parent f7ce78363e
commit 7b3b31b211
2 changed files with 46 additions and 1 deletions

View File

@ -939,6 +939,22 @@ tab
(list (tbf/state '#hash((a . 1) (b . 1)) 1) (tbf/state '#hash((a . -2) (b . 1)) 0))
:end:
You can print a list of TBFs in the following way:
#+BEGIN_SRC racket :results table drawer :var simple-tbfs/state=munch-sexp(simple-tbfs/state)
(print-org-tbfs/state (read-org-tbfs/state simple-tbfs/state))
#+END_SRC
#+RESULTS:
:results:
| a | b | θ |
| 1 | 1 | 1 |
| -2 | 1 | 0 |
:end:
All TBFs given to =print-org-tbfs/state= mush have exactly the same
inputs. This function does not check this property.
* Reaction systems
:PROPERTIES:
:header-args:racket: :prologue "#lang racket\n(require graph dds/rs dds/utils)"

View File

@ -87,7 +87,9 @@
[lists->tbfs/state (->* ((listof (listof (or/c number? symbol?))))
(#:headers boolean?)
(listof tbf/state?))]
[read-org-tbfs/state (->* (string?) (#:headers boolean?) (listof tbf/state?))])
[read-org-tbfs/state (->* (string?) (#:headers boolean?) (listof tbf/state?))]
[print-org-tbfs/state (->* ((non-empty-listof tbf/state?)) (#:headers boolean?)
(listof (listof (or/c number? symbol?))))])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)]
@ -1055,5 +1057,32 @@
(tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
(tbf/state '#hash((x0 . 1) (x1 . 1)) 2)))))
;;; Given a list of tbf/state, produces a sexp that Org-mode can
;;; interpret as a table.
;;;
;;; All tbf/state in the list must have the same inputs. The function
;;; does not check this property.
;;;
;;; If #:headers is #f, does not print the names of the inputs of the
;;; TBFs. If #:headers is #t, the output starts by a list giving the
;;; names of the variables, as well as the symbol 'θ to represent the
;;; column giving the thresholds of the TBF.
(define (print-org-tbfs/state tbfs #:headers [headers #t])
(define table (for/list ([tbf (in-list tbfs)])
(append (hash-map (tbf/state-w tbf) (λ (_ w) w) #t)
(list (tbf/state-θ tbf)))))
(append
(if headers
(list (append (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t) '(θ)))
(empty))
table))
(module+ test
(test-case "print-org-tbfs/state"
(define tbfs (list (make-tbf/state '((a . 1) (b . 2)) 3)
(make-tbf/state '((a . -2) (b . 1)) 1)))
(print-org-tbfs/state tbfs)))
;;; A TBN is a network form mapping TBFs to variables.
(define tbn? (hash/c variable? tbf?))