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

networks: Add table->network.

This commit is contained in:
Sergiu Ivanov 2020-03-24 00:18:39 +01:00
parent f1514fffe3
commit ac8c999272
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
networks-tests.rkt
View File

@ -238,6 +238,22 @@
[negation/list (table->function/list '((#t #f) (#f #t)))])
(check-true (negation #f)) (check-false (negation #t))
(check-true (negation/list '(#f))) (check-false (negation/list '(#t))))
(let* ([n (table->network '((x1 x2 f1 f2)
(#f #f #f #f)
(#f #t #f #t)
(#t #f #t #f)
(#t #t #t #t)))]
[f1 (hash-ref n 'x1)]
[f2 (hash-ref n 'x2)])
(check-false (f1 (st '((x1 . #f) (x2 . #f)))))
(check-false (f1 (st '((x1 . #f) (x2 . #t)))))
(check-true (f1 (st '((x1 . #t) (x2 . #f)))))
(check-true (f1 (st '((x1 . #t) (x2 . #t)))))
(check-false (f2 (st '((x1 . #f) (x2 . #f)))))
(check-true (f2 (st '((x1 . #f) (x2 . #t)))))
(check-false (f2 (st '((x1 . #t) (x2 . #f)))))
(check-true (f2 (st '((x1 . #t) (x2 . #t))))))
(let ([f1 (stream-first (enumerate-boolean-functions 1))]
[f1/list (stream-first (enumerate-boolean-functions/list 1))])
(check-false (f1 #f)) (check-false (f1 #t))

38
networks.rkt
View File

@ -71,6 +71,7 @@
(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?)]
[table->network (->* ((listof (*list/c any/c any/c))) (#:headers boolean?) network?)]
[boolean-power (-> number? (listof (listof boolean?)))]
[boolean-power/stream (-> number? (stream/c (listof boolean?)))]
[enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
@ -541,6 +542,43 @@
(let-values ([(x fx) (split-at-right line 1)])
(values x (car fx))))))
;;; Given a table like the one produced by tabulate-network,
;;; constructs a Boolean network having this behaviour. If headers is
;;; #t, considers that the first element of the list are the headers
;;; and reads the names of the variables from them. Otherwise
;;; generates names for variables of the form xi, where 0 ≤ i < number
;;; of variables, and treats all rows in the table as defining the
;;; behaviour of the functions of the network. The columns defining
;;; the functions are taken to be in the same order as the variables
;;; in the first half of the function. The headers of the columns
;;; defining the functions are therefore discarded.
;;;
;;; This function relies on table->function, so the same caveats
;;; apply.
(define (table->network table #:headers [headers #t])
(define n (/ (length (car table)) 2))
;; Get the variable names from the table or generate them, if
;; necessary.
(define var-names (cond [headers (take (car table) n)]
[else (for ([i (in-range n)])
(symbol->string (format "x~a" i)))]))
;; Drop the headers if they are present.
(define tab (cond [headers (cdr table)]
[else table]))
;; Split the table into the inputs and the outputs of the functions.
(define-values (ins outs) (multi-split-at tab n))
;; Transpose outs to have functions define by lines instead of by
;; columns.
(define func-lines (lists-transpose outs))
;; Make states out of inputs.
(define st-ins (for/list ([in ins]) (make-state (map cons var-names in))))
;; Construct the functions.
(define funcs (for/list ([out func-lines])
(table->function (for/list ([in st-ins] [o out])
(list in o)))))
;; Construct the network.
(make-network-from-functions (map cons var-names funcs)))
;;; Returns the n-th Cartesian power of the Boolean domain: {0,1}^n.
(define (boolean-power n) (apply cartesian-product (make-list n '(#f #t))))