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))))
|
||||
(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.
|
||||
;;;
|
||||
;;; For a Boolean network with n variables, returns a table with 2n
|
||||
|
|
Loading…
Reference in a new issue