networks: Add tabulate-state* and tabulate-state*/boolean.

This commit is contained in:
Sergiu Ivanov 2020-06-02 21:28:37 +02:00
parent e654123a39
commit 42ffc37eeb

View file

@ -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