scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

networks: Add tabulate-network and tabulate-boolean-network.

This commit is contained in:
Sergiu Ivanov 2020-03-22 19:22:54 +01:00
parent 5fd16e4465
commit c823001492
2 changed files with 35 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
networks-tests.rkt
View File

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

29
networks.rkt
View File

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