networks: Factor out purely function-related code into functions.
This commit is contained in:
Sergiu Ivanov
parent
90bebbded9
commit
8421d89629
2 changed files with 173 additions and 148 deletions
172
functions.rkt
172
functions.rkt
|
|
@ -6,3 +6,175 @@
|
|||
;;; tabulating, (re)constructing from tables, generating random
|
||||
;;; functions, etc. Some definitions of particular kinds of functions
|
||||
;;; are also provided (threshold Boolean functions, etc.).
|
||||
|
||||
(require "utils.rkt")
|
||||
|
||||
(provide
|
||||
;; Functions
|
||||
(contract-out
|
||||
[tabulate/domain-list (-> procedure? (listof generic-set?) (listof list?))]
|
||||
[tabulate (->* (procedure?) () #:rest (listof generic-set?) (listof list?))]
|
||||
[tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))]
|
||||
[table->function (-> (listof (*list/c any/c any/c)) procedure?)]
|
||||
[table->function/list (-> (listof (*list/c any/c any/c)) procedure?)]
|
||||
[enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
|
||||
[enumerate-boolean-functions (-> number? (stream/c procedure?))]
|
||||
[enumerate-boolean-functions/list (-> number? (stream/c procedure?))]
|
||||
[random-boolean-table (-> number? (listof (*list/c boolean? boolean?)))]
|
||||
[random-boolean-function (-> number? procedure?)]
|
||||
[random-boolean-function/list (-> number? procedure?)]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit))
|
||||
|
||||
|
||||
;;; ==========
|
||||
;;; Tabulating
|
||||
;;; ==========
|
||||
|
||||
;;; Given a function and a list of domains for each of its arguments,
|
||||
;;; in order, produces a list of lists giving the values of arguments
|
||||
;;; and the value of the functions for these inputs.
|
||||
(define (tabulate/domain-list func doms)
|
||||
(for/list ([xs (apply cartesian-product doms)])
|
||||
(append xs (list (apply func xs)))))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate/domain-list"
|
||||
(check-equal? (tabulate/domain-list (λ (x y) (and x y)) '((#f #t) (#f #t)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
;;; Like tabulate, but the domains are given as a rest argument.
|
||||
(define (tabulate func . doms) (tabulate/domain-list func doms))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate"
|
||||
(check-equal? (tabulate (λ (x y) (and x y)) '(#f #t) '(#f #t))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
;;; Like tabulate, but assumes the domains of all variables of the
|
||||
;;; function are Boolean. func must have a fixed arity. It is an
|
||||
;;; error to supply a function of variable arity.
|
||||
(define (tabulate/boolean func)
|
||||
(tabulate/domain-list func (make-list (procedure-arity func) '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate/boolean"
|
||||
(check-equal? (tabulate/boolean (lambda (x y) (and x y)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
|
||||
;;; ======================
|
||||
;;; Constructing functions
|
||||
;;; ======================
|
||||
|
||||
;;; Given a table like the one produced by the tabulate functions,
|
||||
;;; creates a function which has this behaviour.
|
||||
;;;
|
||||
;;; More exactly, the input is a list of lists of values. All but the
|
||||
;;; last elements of every list give the values of the parameters of
|
||||
;;; the function, while the the last element of every list gives the
|
||||
;;; value of the function. Thus, every list should have at least two
|
||||
;;; elements.
|
||||
;;;
|
||||
;;; The produced function is implemented via lookups in hash tables,
|
||||
;;; meaning that it may be sometimes more expensive to compute than by
|
||||
;;; using an direct symbolic implementation.
|
||||
(define (table->function table)
|
||||
(let ([func (table->function/list table)])
|
||||
(λ args (func args))))
|
||||
|
||||
(module+ test
|
||||
(test-case "table->function"
|
||||
(define negation (table->function '((#t #f) (#f #t))))
|
||||
(check-true (negation #f))
|
||||
(check-false (negation #t))))
|
||||
|
||||
;;; Like table->function, but the produced function accepts a single
|
||||
;;; list of arguments instead of individual arguments.
|
||||
(define (table->function/list table)
|
||||
((curry hash-ref)
|
||||
(for/hash ([line table])
|
||||
(let-values ([(x fx) (split-at-right line 1)])
|
||||
(values x (car fx))))))
|
||||
|
||||
(module+ test
|
||||
(test-case "table->function/list"
|
||||
(define negation/list (table->function/list '((#t #f) (#f #t))))
|
||||
(check-true (negation/list '(#f)))
|
||||
(check-false (negation/list '(#t)))))
|
||||
|
||||
;;; Returns the stream of the truth tables of all Boolean functions of
|
||||
;;; a given arity.
|
||||
;;;
|
||||
;;; There are 2^(2^n) Boolean functions of arity n.
|
||||
(define (enumerate-boolean-tables n)
|
||||
(let ([inputs (boolean-power/stream n)]
|
||||
[outputs (boolean-power/stream (expt 2 n))])
|
||||
(for/stream ([out (in-stream outputs)])
|
||||
(for/list ([in (in-stream inputs)] [o out])
|
||||
(append in (list o))))))
|
||||
|
||||
;;; Returns the stream of all Boolean functions of a given arity.
|
||||
;;;
|
||||
;;; There are 2^(2^n) Boolean functions of arity n.
|
||||
(define (enumerate-boolean-functions n)
|
||||
(stream-map table->function (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-tables"
|
||||
(define f1 (stream-first (enumerate-boolean-functions 1)))
|
||||
(check-false (f1 #f))
|
||||
(check-false (f1 #t))))
|
||||
|
||||
;;; Returns the stream of all Boolean functions of a given arity. As
|
||||
;;; different from the functions returned by
|
||||
;;; enumerate-boolean-functions, the functions take lists of arguments
|
||||
;;; instead of n arguments.
|
||||
;;;
|
||||
;;; There are 2^(2^n) Boolean functions of arity n.
|
||||
(define (enumerate-boolean-functions/list n)
|
||||
(stream-map table->function/list (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-functions/list"
|
||||
(define f1/list (stream-first (enumerate-boolean-functions/list 1)))
|
||||
(check-false (f1/list '(#f)))
|
||||
(check-false (f1/list '(#t)))))
|
||||
|
||||
|
||||
;;; ================
|
||||
;;; Random functions
|
||||
;;; ================
|
||||
|
||||
;;; Generates a random truth table for a Boolean function of arity n.
|
||||
(define (random-boolean-table n)
|
||||
(define/match (num->bool x) [(0) #f] [(1) #t])
|
||||
(define inputs (boolean-power n))
|
||||
(define outputs (stream-take (in-random 2) (expt 2 n)))
|
||||
(for/list ([i inputs] [o outputs])
|
||||
(append i (list (num->bool o)))))
|
||||
|
||||
(module+ test
|
||||
(test-case "random-boolean-table"
|
||||
(random-seed 0)
|
||||
(check-equal? (random-boolean-table 2) '((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f)))))
|
||||
|
||||
;;; Generates a random Boolean function of arity n.
|
||||
(define random-boolean-function (compose table->function random-boolean-table))
|
||||
|
||||
(module+ test
|
||||
(test-case "random-boolean-function"
|
||||
(define f (random-boolean-function 2))
|
||||
(check-true (f #f #f)) (check-false (f #f #t))
|
||||
(check-true (f #t #f)) (check-false (f #t #t))))
|
||||
|
||||
;;; Like random-boolean-function, but the constructed function takes a
|
||||
;;; list of arguments.
|
||||
(define random-boolean-function/list (compose table->function/list random-boolean-table))
|
||||
|
||||
(module+ test
|
||||
(test-case "random-boolean-function/list"
|
||||
(define f (random-boolean-function/list 2))
|
||||
(check-false (f '(#f #f))) (check-true (f '(#f #t)))
|
||||
(check-true (f '(#t #f))) (check-false (f '(#t #t)))))
|
||||
|
|
|
|||
149
networks.rkt
149
networks.rkt
|
|
@ -10,7 +10,7 @@
|
|||
;;; This model can generalise Boolean networks, TBANs, multivalued
|
||||
;;; networks, etc.
|
||||
|
||||
(require "utils.rkt" "generic.rkt" graph racket/random)
|
||||
(require "utils.rkt" "generic.rkt" "functions.rkt" graph racket/random)
|
||||
|
||||
(provide
|
||||
;; Structures
|
||||
|
|
@ -58,9 +58,6 @@
|
|||
[pretty-print-boolean-state-graph (-> graph? graph?)]
|
||||
[build-full-boolean-state-graph (-> dynamics? graph?)]
|
||||
[build-full-boolean-state-graph-annotated (-> dynamics? graph?)]
|
||||
[tabulate/domain-list (-> procedure? (listof generic-set?) (listof list?))]
|
||||
[tabulate (->* (procedure?) () #:rest (listof generic-set?) (listof list?))]
|
||||
[tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))]
|
||||
[tabulate-state (->* (procedure? domain-mapping/c) (#:headers boolean?)
|
||||
(listof (listof any/c)))]
|
||||
[tabulate-state/boolean (->* (procedure? (listof variable?)) (#:headers boolean?)
|
||||
|
|
@ -69,15 +66,7 @@
|
|||
(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?)]
|
||||
[table->network (->* ((listof (*list/c any/c any/c))) (#:headers boolean?) network?)]
|
||||
[enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
|
||||
[enumerate-boolean-functions (-> number? (stream/c procedure?))]
|
||||
[enumerate-boolean-functions/list (-> number? (stream/c procedure?))]
|
||||
[random-boolean-table (-> number? (listof (*list/c boolean? boolean?)))]
|
||||
[random-boolean-function (-> number? procedure?)]
|
||||
[random-boolean-function/list (-> number? procedure?)]
|
||||
[random-function/state (domain-mapping/c generic-set? . -> . procedure?)]
|
||||
[random-boolean-function/state ((listof variable?) . -> . procedure?)]
|
||||
[random-network (domain-mapping/c . -> . network?)]
|
||||
|
|
@ -716,36 +705,6 @@
|
|||
;;; Tabulating functions and networks
|
||||
;;; =================================
|
||||
|
||||
;;; Given a function and a list of domains for each of its arguments,
|
||||
;;; in order, produces a list of lists giving the values of arguments
|
||||
;;; and the value of the functions for these inputs.
|
||||
(define (tabulate/domain-list func doms)
|
||||
(for/list ([xs (apply cartesian-product doms)])
|
||||
(append xs (list (apply func xs)))))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate/domain-list"
|
||||
(check-equal? (tabulate/domain-list (λ (x y) (and x y)) '((#f #t) (#f #t)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
;;; Like tabulate, but the domains are given as a rest argument.
|
||||
(define (tabulate func . doms) (tabulate/domain-list func doms))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate"
|
||||
(check-equal? (tabulate (λ (x y) (and x y)) '(#f #t) '(#f #t))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
;;; Like tabulate, but assumes the domains of all variables of the
|
||||
;;; function are Boolean. func must have a fixed arity. It is an
|
||||
;;; error to supply a function of variable arity.
|
||||
(define (tabulate/boolean func)
|
||||
(tabulate/domain-list func (make-list (procedure-arity func) '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate/boolean"
|
||||
(check-equal? (tabulate/boolean (lambda (x y) (and x y)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
;;; Like tabulate, but supposes that the function works on states.
|
||||
;;;
|
||||
|
|
@ -813,42 +772,6 @@
|
|||
;;; Constructing functions and networks
|
||||
;;; ===================================
|
||||
|
||||
;;; Given a table like the one produced by the tabulate functions,
|
||||
;;; creates a function which has this behaviour.
|
||||
;;;
|
||||
;;; More exactly, the input is a list of lists of values. All but the
|
||||
;;; last elements of every list give the values of the parameters of
|
||||
;;; the function, while the the last element of every list gives the
|
||||
;;; value of the function. Thus, every list should have at least two
|
||||
;;; elements.
|
||||
;;;
|
||||
;;; The produced function is implemented via lookups in hash tables,
|
||||
;;; meaning that it may be sometimes more expensive to compute than by
|
||||
;;; using an direct symbolic implementation.
|
||||
(define (table->function table)
|
||||
(let ([func (table->function/list table)])
|
||||
(λ args (func args))))
|
||||
|
||||
(module+ test
|
||||
(test-case "table->function"
|
||||
(define negation (table->function '((#t #f) (#f #t))))
|
||||
(check-true (negation #f))
|
||||
(check-false (negation #t))))
|
||||
|
||||
;;; Like table->function, but the produced function accepts a single
|
||||
;;; list of arguments instead of individual arguments.
|
||||
(define (table->function/list table)
|
||||
((curry hash-ref)
|
||||
(for/hash ([line table])
|
||||
(let-values ([(x fx) (split-at-right line 1)])
|
||||
(values x (car fx))))))
|
||||
|
||||
(module+ test
|
||||
(test-case "table->function/list"
|
||||
(define negation/list (table->function/list '((#t #f) (#f #t))))
|
||||
(check-true (negation/list '(#f)))
|
||||
(check-false (negation/list '(#t)))))
|
||||
|
||||
;;; 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
|
||||
|
|
@ -906,81 +829,11 @@
|
|||
(check-false (f2 (make-state '((x1 . #t) (x2 . #f)))))
|
||||
(check-true (f2 (make-state '((x1 . #t) (x2 . #t)))))))
|
||||
|
||||
;;; Returns the stream of the truth tables of all Boolean functions of
|
||||
;;; a given arity.
|
||||
;;;
|
||||
;;; There are 2^(2^n) Boolean functions of arity n.
|
||||
(define (enumerate-boolean-tables n)
|
||||
(let ([inputs (boolean-power/stream n)]
|
||||
[outputs (boolean-power/stream (expt 2 n))])
|
||||
(for/stream ([out (in-stream outputs)])
|
||||
(for/list ([in (in-stream inputs)] [o out])
|
||||
(append in (list o))))))
|
||||
|
||||
;;; Returns the stream of all Boolean functions of a given arity.
|
||||
;;;
|
||||
;;; There are 2^(2^n) Boolean functions of arity n.
|
||||
(define (enumerate-boolean-functions n)
|
||||
(stream-map table->function (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-tables"
|
||||
(define f1 (stream-first (enumerate-boolean-functions 1)))
|
||||
(check-false (f1 #f))
|
||||
(check-false (f1 #t))))
|
||||
|
||||
;;; Returns the stream of all Boolean functions of a given arity. As
|
||||
;;; different from the functions returned by
|
||||
;;; enumerate-boolean-functions, the functions take lists of arguments
|
||||
;;; instead of n arguments.
|
||||
;;;
|
||||
;;; There are 2^(2^n) Boolean functions of arity n.
|
||||
(define (enumerate-boolean-functions/list n)
|
||||
(stream-map table->function/list (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-functions/list"
|
||||
(define f1/list (stream-first (enumerate-boolean-functions/list 1)))
|
||||
(check-false (f1/list '(#f)))
|
||||
(check-false (f1/list '(#t)))))
|
||||
|
||||
|
||||
;;; =============================
|
||||
;;; Random functions and networks
|
||||
;;; =============================
|
||||
|
||||
;;; Generates a random truth table for a Boolean function of arity n.
|
||||
(define (random-boolean-table n)
|
||||
(define/match (num->bool x) [(0) #f] [(1) #t])
|
||||
(define inputs (boolean-power n))
|
||||
(define outputs (stream-take (in-random 2) (expt 2 n)))
|
||||
(for/list ([i inputs] [o outputs])
|
||||
(append i (list (num->bool o)))))
|
||||
|
||||
(module+ test
|
||||
(test-case "random-boolean-table"
|
||||
(random-seed 0)
|
||||
(check-equal? (random-boolean-table 2) '((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f)))))
|
||||
|
||||
;;; Generates a random Boolean function of arity n.
|
||||
(define random-boolean-function (compose table->function random-boolean-table))
|
||||
|
||||
(module+ test
|
||||
(test-case "random-boolean-function"
|
||||
(define f (random-boolean-function 2))
|
||||
(check-true (f #f #f)) (check-false (f #f #t))
|
||||
(check-true (f #t #f)) (check-false (f #t #t))))
|
||||
|
||||
;;; Like random-boolean-function, but the constructed function takes a
|
||||
;;; list of arguments.
|
||||
(define random-boolean-function/list (compose table->function/list random-boolean-table))
|
||||
|
||||
(module+ test
|
||||
(test-case "random-boolean-function/list"
|
||||
(define f (random-boolean-function/list 2))
|
||||
(check-false (f '(#f #f))) (check-true (f '(#f #t)))
|
||||
(check-true (f '(#t #f))) (check-false (f '(#t #t)))))
|
||||
|
||||
;;; Generates a random function accepting a state over the domains
|
||||
;;; given by arg-domains and producing values in func-domain.
|
||||
(define (random-function/state arg-domains func-domain)
|
||||
|
|
|
|||
Loading…
Reference in a new issue