diff --git a/networks-tests.rkt b/networks-tests.rkt index 2dacb7a..23b5764 100644 --- a/networks-tests.rkt +++ b/networks-tests.rkt @@ -216,7 +216,12 @@ (check-equal? (tabulate/boolean (lambda (x y) (and x y))) '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))) (let ([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)))) + (let ([bn (nn #hash((a . (not a)) (b . b)))]) + (check-equal? (tabulate-boolean-network bn) + '((a b f-a f-b) (#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t))) + (check-equal? (tabulate-boolean-network bn #:headers #f) + '((#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t))))) (test-case "Constructing functions" (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t))) diff --git a/networks.rkt b/networks.rkt index f7229a7..1df35b4 100644 --- a/networks.rkt +++ b/networks.rkt @@ -63,6 +63,10 @@ (listof (listof any/c)))] [tabulate-state/boolean (->* (procedure? (listof variable?)) (#:headers boolean?) (listof (listof any/c)))] + [tabulate-network (->* (network? domain-mapping/c) (#:headers boolean?) + (listof (listof any/c)))] + [tabulate-boolean-network (->* (network?) (#:headers boolean?) + (listof (listof any/c)))] [table->function (-> (listof (*list/c any/c any/c)) procedure?)] [table->function/list (-> (listof (*list/c any/c any/c)) procedure?)] [boolean-power (-> number? (listof (listof boolean?)))] @@ -446,6 +450,31 @@ (define (tabulate-state/boolean func args #:headers [headers #t]) (tabulate-state func (make-boolean-domains args) #:headers headers)) +;;; Tabulates a given network. +;;; +;;; For a Boolean network with n variables, returns a table with 2n +;;; columns and 2^n rows. The first n columns correspond to the +;;; different values of the variables of the networks. The last n +;;; columns represent the values of the n update functions of the +;;; network. If headers is #t, prepends a list of variable names and +;;; update functions (f-x, where x is the name of the corresponding +;;; variable) to the result. +(define (tabulate-network network domains #:headers [headers #t]) + (define funcs (hash-map network (λ (x y) y) #t)) + (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 network (λ (x y) x) #t)) + (define func-names (for/list ([x var-names]) (string->symbol (format "f-~a" x)))) + (cons (append var-names func-names) tab)] + [else tab])) + +;;; Like tabulate-network, but assumes all the variables are Boolean. +(define (tabulate-boolean-network bn #:headers [headers #t]) + (tabulate-network bn (make-boolean-domains (hash-map bn (λ (x y) x) #t)) + #:headers headers)) ;;; ====================== ;;; Constructing functions