diff --git a/networks.rkt b/networks.rkt index 0354534..1f7524e 100644 --- a/networks.rkt +++ b/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