diff --git a/example/example.org b/example/example.org index 0130a9b..018d083 100644 --- a/example/example.org +++ b/example/example.org @@ -471,6 +471,44 @@ tab [[file:dots/examplehsuRqc.svg]] :END: +** Network functions + =dds/networks= provides some basic primitives for working with + individual functions which may appear in a network model. Clearly, + these primitives can be applied in contexts not necessarily + directly related to networks. + + Here's how you can tabulate a function. The domain of x is {1, 2}, + and the domain of y is {0, 2, 4}. The first column in the output + corresponds to x, the second to y, and the third corresponds to the + value of the function. + + #+BEGIN_SRC racket :results table drawer +(tabulate (λ (x y) (+ x y)) '(1 2) '(0 2 4)) + #+END_SRC + + #+RESULTS: + :RESULTS: + | 1 | 0 | 1 | + | 1 | 2 | 3 | + | 1 | 4 | 5 | + | 2 | 0 | 2 | + | 2 | 2 | 4 | + | 2 | 4 | 6 | + :END: + + Here's how you tabulate a Boolean function: + #+BEGIN_SRC racket :results table drawer +(tabulate/boolean (λ (x y) (and x y))) + #+END_SRC + + #+RESULTS: + :RESULTS: + | #f | #f | #f | + | #f | #t | #f | + | #t | #f | #f | + | #t | #t | #t | + :END: + * Reaction systems :PROPERTIES: :header-args:racket: :prologue "#lang racket\n(require graph (file \"~/Candies/prj/racket/dds/rs.rkt\") (file \"~/Candies/prj/racket/dds/utils.rkt\"))" diff --git a/networks-tests.rkt b/networks-tests.rkt index 89e9e7a..c8d827b 100644 --- a/networks-tests.rkt +++ b/networks-tests.rkt @@ -207,3 +207,11 @@ (check-equal? (edge-weight gr-complete-bool-ann #hash((a . #f) (b . #t)) #hash((a . #t) (b . #t))) (set (set 'a))))) + +(test-case "Functions" + (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))) + (check-equal? (tabulate (λ (x y) (and x y)) '(#f #t) '(#f #t)) + '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))) + (check-equal? (tabulate/boolean (lambda (x y) (and x y))) + '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))) diff --git a/networks.rkt b/networks.rkt index d6103b6..3551b91 100644 --- a/networks.rkt +++ b/networks.rkt @@ -55,7 +55,10 @@ [pretty-print-state-graph (-> graph? graph?)] [pretty-print-boolean-state-graph (-> graph? graph?)] [build-full-boolean-state-graph (-> dynamics? graph?)] - [build-full-boolean-state-graph-annotated (-> 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?)))]) ;; Predicates (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] @@ -385,3 +388,24 @@ (dds-build-state-graph-annotated dyn (list->set (build-all-boolean-states (hash-keys (dynamics-network dyn)))))) + + +;;; ========= +;;; Functions +;;; ========= + +;;; 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))))) + +;;; Like tabulate, but the domains are given as a rest argument. +(define (tabulate func . doms) (tabulate/domain-list func doms)) + +;;; 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))))