networks: Add tabulate-state* and tabulate-state*/boolean.
This commit is contained in:
parent
e654123a39
commit
42ffc37eeb
1 changed files with 30 additions and 0 deletions
30
networks.rkt
30
networks.rkt
|
@ -735,6 +735,36 @@
|
||||||
(define func (λ (st) (not (hash-ref st 'a))))
|
(define func (λ (st) (not (hash-ref st 'a))))
|
||||||
(check-equal? (tabulate-state/boolean func '(a)) '((a f) (#f #t) (#t #f)))))
|
(check-equal? (tabulate-state/boolean func '(a)) '((a f) (#f #t) (#t #f)))))
|
||||||
|
|
||||||
|
;;; Like tabulate-state, but takes a list of functions over the same
|
||||||
|
;;; domain. If headers is #t, the first list of the result enumerates
|
||||||
|
;;; the variable names, and then contains a symbol 'fi for each of the
|
||||||
|
;;; functions, where i is replaced by the number of the function in
|
||||||
|
;;; the list.
|
||||||
|
(define/contract (tabulate-state* funcs domains #:headers [headers #t])
|
||||||
|
(->* ((non-empty-listof procedure?) domain-mapping/c) (#:headers boolean?)
|
||||||
|
(listof (listof any/c)))
|
||||||
|
(define tab (for/list ([st (build-all-states domains)])
|
||||||
|
(append (hash-map st (λ (x y) y) #t)
|
||||||
|
(for/list ([f funcs]) (f st)))))
|
||||||
|
(cond
|
||||||
|
[headers
|
||||||
|
(define var-names (hash-map domains (λ (x y) x) #t))
|
||||||
|
(define func-names (for/list ([_ funcs] [i (in-naturals 1)]) (string->symbol (format "f~a" i))))
|
||||||
|
(cons (append var-names func-names) tab)]
|
||||||
|
[else tab]))
|
||||||
|
|
||||||
|
;;; Like tabulate-state/boolean, but takes a list of functions.
|
||||||
|
(define/contract (tabulate-state*/boolean funcs args #:headers [headers #t])
|
||||||
|
(->* ((non-empty-listof procedure?) (listof variable?)) (#:headers boolean?)
|
||||||
|
(listof (listof any/c)))
|
||||||
|
(tabulate-state* funcs (make-boolean-domains args) #:headers headers))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "tabulate-state*/boolean"
|
||||||
|
(define f1 (λ (st) (and (hash-ref st 'a) (hash-ref st 'b))))
|
||||||
|
(define f2 (λ (st) (or (hash-ref st 'a) (hash-ref st 'b))))
|
||||||
|
(tabulate-state*/boolean (list f1 f2) '(a b))))
|
||||||
|
|
||||||
;;; Tabulates a given network.
|
;;; Tabulates a given network.
|
||||||
;;;
|
;;;
|
||||||
;;; For a Boolean network with n variables, returns a table with 2n
|
;;; For a Boolean network with n variables, returns a table with 2n
|
||||||
|
|
Loading…
Reference in a new issue