FIXME WIP: Continue converting to Typed Racket.

I exported everything to typed-compose now.

README.org

@@ -18,9 +18,7 @@ Currently, the toolkit includes the following files:
 
   - [[file:generic.rkt][generic.rkt]]: The generic interface for a discrete dynamical
     system, with functions for constructing state graphs.
-  - [[file:utils.rkt][utils.rkt]]: Misc utilities.
-  - [[file:functions.rkt][functions.rkt]]: Definitions for working with functions: tabulating,
-    constructing from tables, generating random functions, etc.
+  - [[file:utils.rkt][utils.rkt]]: Misc utility functions.
   - [[file:networks.rkt][networks.rkt]]: Implements network-based models, which generalise
     Boolean networks, threshold Boolean automata networks, multivalued
     networks, etc.
@@ -36,20 +34,43 @@ interaction with Org-mode.
    that I work on the subsequent items decreases with their position
    in the list.
 
-*** TODO Fix =ob-racket= to work with Typed Racket
-Currently, the =ob-racket= backend for running Racket code blocks in
-Org-mode assumes the code is written in =#lang racket=, which breaks
-the output for tables for example.  This makes the typed version of
-=dds= essentially useless with tables.
+*** TODO Convert =dds= to Typed Racket
+    Rewriting =dds= with Typed Racket will be a major refactoring,
+    consisting in the following 3 phases which will happen more or
+    less in parallel:
 
-*** TODO Fix [[file:example/example.org][example.org]]
-I changed quite a number of things while converting =dds= to Typed
-Racket, which should break a lot of things in [[file:example/example.org][example.org]].
+    - define types, add type signatures, add types for functions
+      I import from =graph=;
+    - transfer the comments from the source files to Scribble
+      documentation;
+    - redefine the generic interface for dynamics, which is currently
+      in =generics=.
+
+    I plan to implement the new dynamics interface as a classes, since
+    Typed Racket can now type classes.  I didn't really like generics:
+    they are quite cumbersome, and I think I can do more with classes.
+
+    People on Racket Users suggested using structures with fields
+    containing functions, but it does not seem to get me to my goal of
+    having type-level methods/functions.
+
+    The order in which I will convert the modules:
+
+    1. =utils=
+    2. =functions=
+    3. =dynamics= (currently =generics=)
+    4. =networks=
+    5. =rs=
+
+    This is how I will convert a module =A=:
+
+    1. Create a copy =A-untyped.rkt=.
+    2. Empty =A.rkt=.
+    3. Transfer the definitions from =A-untyped.rkt= to =A.rkt= one by
+       one, adding the necessary types, signatures, and typed imports
+       as I go.
+    4. When done, remove =A-untyped.rkt=.
 
-*** TODO Think about splitting the library into lib and doc
-*** TODO Implement string rewriting
-*** TODO Implement [[https://en.wikipedia.org/wiki/P_system][P systems]]
-*** TODO Consider splitting =dds/utils= into a separate package
 *** TODO Implement a shorter syntax for defining Boolean functions
     Right now, this is how one defines the Boolean function:
 
@@ -66,14 +87,14 @@ Racket, which should break a lot of things in [[file:example/example.org][exampl
 (define-pbf my-pbf (or (and (not :Go) :new-x) (and :Go :old-x)))
     #+END_SRC
 
-*** TODO Submit =update-graph= to =stchang=
 *** TODO Implement =monotone?=
  =monotone?= would verify whether a given Boolean function is
     monotone according to the definition in the book /Boolean
     Functions: Theory, Algorithms, and Applications/ by Crama
     and Hammer.
 
-*** TODO Consider optimizing the algorithms in =networks= and =dynamics=
+*** TODO Submit =update-graph= to =stchang=
+*** TODO Split =networks= into general networks and threshold Boolean networks
 *** TODO Implement the BN \to RS conversion
 *** TODO Implement the minimisation of TBF/SBF
 *** TODO Contribute to Racket

dds.org

@@ -17,14 +17,7 @@ raco pkg install
 raco setup -l dds
   #+END_SRC
 
-  The =dds= package must already be installed.
-
-  Execute the following code block to open the documentation in the
-  last visited browser window.
-
-  #+BEGIN_SRC elisp :results silent
-(shell-command "firefox doc/dds/index.html")
-  #+END_SRC
+  I think that the =dds= package must already be installed.
 
 * Racket Package catalog bug <2020-11-26 Thu>
  =raco pkg= had a bug which caused it to fail with the following

dynamics.rkt

@@ -1,68 +0,0 @@
-#lang typed/racket
-
-(require "utils.rkt" typed/graph)
-
-(provide dds%)
-
-(define dds%
-  (class object%
-    #:forall (State Modality)
-    (super-new)
-
-    (: step (-> State (Listof State)))
-    (define/public (step st)
-      (map (inst cdr Modality State) (step/annotated st)))
-
-    (: step/annotated (-> State (Listof (Pairof Modality State))))
-    (define/abstract/error (step/annotated st))
-
-    (: step* (-> (Listof State) (Listof State)))
-    (define/public (step* sts)
-      (remove-duplicates
-       (apply append
-              (for/list : (Listof (Listof State)) ([s sts])
-                (step s)))))
-
-    (: build-state-graph (-> (Listof State) Graph))
-    (define/public (build-state-graph sts)
-      (build-state-graph* sts 'full))
-
-    (: build-state-graph/annotated (-> (Listof State) Graph))
-    (define/public (build-state-graph/annotated sts)
-      (build-state-graph*/annotated sts 'full))
-
-    (: build-state-graph* (-> (Listof State) (U Positive-Integer 'full) Graph))
-    (define/public (build-state-graph* sts nsteps)
-      (unweighted-graph/directed
-       (assert-type (get-edges (build-state-graph*/annotated sts nsteps))
-                    (Listof (List Any Any)))))
-
-    (: build-state-graph*/annotated (-> (Listof State) (U Positive-Integer 'full) Graph))
-    (define/public (build-state-graph*/annotated sts nsteps)
-      (define (all-steps-done? k)
-        (if (equal? nsteps 'full)
-            #f ; keep going forever
-            (>= (assert-type k Integer) nsteps)))
-      (weighted-graph/directed
-       (let build-graph : (Listof (List Modality State State))
-            ([visited-states : (Setof State) (set)]
-             [states : (Setof State) (list->set sts)]
-             [edges : (Listof (List Modality State State)) '()]
-             [k 1])
-         (define new-edges
-           (for*/list : (Listof (List Modality State State))
-                      ([s (in-set states)] ; the state we are looking at
-                       [out (in-list (step/annotated s))]) ; the arrows going out of s
-             (list (car out) s (cdr out))))
-         (define edges/full (append edges new-edges))
-         (define new-states
-           (list->set (map (inst caddr Modality State State) new-edges)))
-         (define new-states-pruned
-           (set-subtract new-states visited-states))
-         (if (or (set-empty? new-states-pruned) (all-steps-done? k))
-             edges/full
-             (build-graph (set-union visited-states new-states-pruned)
-                          new-states-pruned
-                          edges/full
-                          (add1 k))))))
-    ))

functions.rkt

@@ -1,4 +1,4 @@
-#lang typed/racket
+#lang racket
 
 ;;; dds/functions
 
@@ -9,305 +9,140 @@
 
 (require "utils.rkt")
 
-(require "utils.rkt"
-         syntax/parse/define typed/racket/stream
-         (only-in typed/racket/unsafe unsafe-provide)
-         (for-syntax syntax/parse))
-
-(require/typed racket/stream
-  [stream-map (All (a b) (-> (-> a b) (Sequenceof a) (Sequenceof b)))])
-
 (provide
- pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
- tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv
- tabulate*/pv/boolean tabulate/pv/boolean tabulate*/pv/01 tabulate/pv/01
- tabulate*/list tabulate/list
- tabulate*/list/boolean tabulate/list/boolean tabulate*/list/01 tabulate/list/01
- table->function/list table->unary-function table->function table->function/pv
- enumerate-boolean-tables enumerate-boolean-functions
- enumerate-boolean-functions/pv enumerate-boolean-functions/list
- random-boolean-table random-boolean-function random-boolean-function/list
-
- (struct-out tbf) TBF tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean
- list->tbf lists->tbfs read-org-tbfs tbf-tabulate* tbf-tabulate
- tbf-tabulate*/boolean sbf? sbf list->sbf read-org-sbfs)
+ ;; Structures
+ (contract-out
+  [struct tbf ((weights (vectorof number?)) (threshold number?))])
+ ;; Functions
+ (contract-out
+  [tabulate (-> procedure? (listof generic-set?) (listof list?))]
+  [tabulate* (-> (listof procedure?) (listof generic-set?) (listof list?))]
+  [tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))]
+  [tabulate*/boolean (-> (non-empty-listof procedure-fixed-arity?) (listof (listof boolean?)))]
+  [tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
+  [tabulate*/01 (-> (non-empty-listof procedure?) (listof (listof (or/c 0 1))))]
+  [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?)]
+  [tbf-w (-> tbf? (vectorof number?))]
+  [tbf-θ (-> tbf? number?)]
+  [vector-boolean->01 (-> (vectorof boolean?) (vectorof (or/c 0 1)))]
+  [apply-tbf (-> tbf? (vectorof (or/c 0 1)) (or/c 0 1))]
+  [apply-tbf/boolean (-> tbf? (vectorof boolean?) boolean?)]
+  [list->tbf (-> (cons/c number? (cons/c number? (listof number?))) tbf?)]
+  [lists->tbfs (-> (listof (listof number?)) (listof tbf?))]
+  [read-org-tbfs (->* (string?) (#:headers boolean?) (listof tbf?))]
+  [tbf-tabulate* (-> (listof tbf?) (listof (listof (or/c 0 1))))]
+  [tbf-tabulate (-> tbf? (listof (listof (or/c 0 1))))]
+  [tbf-tabulate*/boolean (-> (listof tbf?) (listof (listof boolean?)))]
+  [sbf (-> (vectorof number?) tbf?)]
+  [list->sbf (-> (listof number?) sbf?)]
+  [read-org-sbfs (->* (string?) (#:headers boolean?) (listof sbf?))])
+ ;; Predicates
+ (contract-out
+  [sbf? (-> any/c boolean?)]))
 
 (module+ test
-  (require typed/rackunit))
-
-(begin-for-syntax
-  (require racket (for-syntax syntax/parse))
-
-  (define (make-pseudovariadic-core args bodies tag-stx)
-    (define nargs-stx (datum->syntax args (length (syntax->list args))))
-    #`(λ xs
-        (match xs
-          [(list #,@args) #,@bodies]
-          [_ (error #,tag-stx "invalid arity, expected ~a argument(s)" #,nargs-stx)])))
-
-  (define (make-pseudovariadic-lambda stx)
-    (syntax-parse stx
-      [(_ (args:id ...) bodies:expr ...)
-       (make-pseudovariadic-core #'(args ...)
-                                 #'(bodies ...)
-                                 (datum->syntax stx ''pseudovariadic-lambda))]))
-
-  (define (make-pseudovariadic-define stx)
-    (syntax-parse stx
-      [(_ (name:id args:id ...) bodies:expr ...)
-       #`(define name
-           #,(make-pseudovariadic-core
-              #'(args ...)
-              #'(bodies ...)
-              (datum->syntax #'name `(quote ,(syntax->datum #'name)))))])))
-
-(define-syntax (pseudovariadic-lambda stx) (make-pseudovariadic-lambda stx))
-(define-syntax (pvλ stx) (make-pseudovariadic-lambda stx))
-
-(module+ test
-  (test-case "pseudovariadic-lambda")
-  (check-false ((pseudovariadic-lambda (x y) (and x y)) #t #f))
-  (check-false ((pvλ (x y) (and x y)) #t #f))
-  (check-exn exn:fail? (λ () ((pseudovariadic-lambda (x y) (and x y)) #t #f #f)))
-  (check-exn exn:fail? (λ () ((pvλ (x y) (and x y)) #t #f #f))))
-
-(define-syntax (pseudovariadic-define stx) (make-pseudovariadic-define stx))
-(define-syntax (pvdefine stx) (make-pseudovariadic-define stx))
-
-(module+ test
-  (test-case "pseudovariadic-define")
-  (: f (-> Boolean * Boolean))
-  (pseudovariadic-define (f x y) (and x y))
-  (check-false (f #t #f))
-  (check-exn exn:fail? (λ () (f #t #f #f)))
-
-  (: g (-> Boolean * Boolean))
-  (pvdefine (g x y) (and x y))
-  (check-false (g #t #f))
-  (check-exn exn:fail? (λ () (g #t #f #f))))
-
-(define-syntax-parse-rule (make-tabulate* name:id row-op:id apply-op:id)
-  (define (name funcs doms)
-    (for/list ([xs (in-list (apply cartesian-product doms))])
-      (row-op xs (for/list ([f funcs]) : (Listof b)
-                           (apply-op f xs))))))
-
-(: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
-                                 (Listof (Listof (U Any b))))))
-(make-tabulate* tabulate* append apply)
-
-(module+ test
-  (test-case "tabulate*"
-    (check-equal? (tabulate*
-                   (list (λ (x y) (and x y))
-                         (λ (x y) (or x y)))
-                   '((#f #t) (#f #t)))
-                  '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))
-    (check-equal? (tabulate* empty '((#f #t) (#f #t)))
-                  '((#f #f) (#f #t) (#t #f) (#t #t)))))
-
-(: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
-                                       (Listof (List (List a ...) (Listof b))))))
-(make-tabulate* tabulate*/strict list apply)
-
-(module+ test
-  (test-case "tabulate*/strict"
-    (check-equal? (tabulate*/strict
-                   (list (λ (x y) (and x y))
-                         (λ (x y) (or x y)))
-                   '((#f #t) (#f #t)))
-                  '(((#f #f) (#f #f)) ((#f #t) (#f #t)) ((#t #f) (#f #t)) ((#t #t) (#t #t))))))
+  (require rackunit))
 
 
-(: tabulate*/pv (All (a b) (-> (Listof (-> a * b)) (Listof (Listof a))
-                               (Listof (Listof (U a b))))))
-(make-tabulate* tabulate*/pv append apply)
+;;; ==========
+;;; Tabulating
+;;; ==========
 
-(module+ test
-  (test-case "tabulate*/pv"
-    (check-equal? (tabulate*/pv (list (pvλ (x y) (and x y))
-                                      (pvλ (x y) (or x y)))
-                                '((#f #t) (#f #t)))
-                  '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
-
-(define-syntax-parse-rule (simple-apply func:expr arg:expr)
-  (func arg))
-
-(: tabulate*/list (All (a b) (-> (Listof (-> (Listof a) b)) (Listof (Listof a))
-                                 (Listof (Listof (U a b))))))
-(make-tabulate* tabulate*/list append simple-apply)
-
-(module+ test
-  (test-case "tabulate*/list"
-    (check-equal? (tabulate*/list (list (λ ([xs : (Listof Boolean)])
-                                          (and (car xs) (cadr xs)))
-                                        (λ ([xs : (Listof Boolean)])
-                                          (or (car xs) (cadr xs))))
-                                  '((#f #t) (#f #t)))
-                  '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
-
-(: tabulate (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
-                               (Listof (Listof (U Any b))))))
+;;; 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 func doms)
-  (tabulate* (list func) doms))
+  (tabulate* `(,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)))))
 
-(: tabulate/strict (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
-                                      (Listof (List (List a ...) (Listof b))))))
-(define (tabulate/strict func doms)
-  (tabulate*/strict (list func) doms))
+;;; Like tabulate, but takes a list of functions taking
+;;; the same arguments over the same domains.
+(define (tabulate* funcs doms)
+  (for/list ([xs (apply cartesian-product doms)])
+    (append xs (for/list ([f funcs]) (apply f xs)))))
 
 (module+ test
-  (test-case "tabulate/strict"
-    (check-equal? (tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t)))
-                  '(((#f #f) (#f)) ((#f #t) (#f)) ((#t #f) (#f)) ((#t #t) (#t))))))
+  (test-case "tabulate*"
+    (check-equal? (tabulate* (list (λ (x y) (and x y))
+                                   (λ (x y) (or x y)))
+                             '((#f #t) (#f #t)))
+                  '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))
+    (check-equal? (tabulate* empty '((#f #t) (#f #t)))
+                  '((#f #f) (#f #t) (#t #f) (#t #t)))))
 
-(: tabulate/pv (All (a b) (-> (-> a * b) (Listof (Listof a))
-                              (Listof (Listof (U a b))))))
-(define (tabulate/pv func doms)
-  (tabulate*/pv (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 func (make-list (procedure-arity func) '(#f #t))))
 
 (module+ test
-  (test-case "tabulate/pv"
-    (check-equal? (tabulate/pv (pvλ (x y) (and x y)) '((#f #t) (#f #t)))
+  (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)))))
 
-(: tabulate/list (All (a b) (-> (-> (Listof a) b) (Listof (Listof a))
-                                (Listof (Listof (U a b))))))
-(define (tabulate/list func doms)
-  (tabulate*/list (list func) doms))
+;;; Like tabulate/boolean, but takes a list of functions of the same
+;;; arity.
+(define (tabulate*/boolean funcs)
+  (define doms (make-list (procedure-arity (car funcs)) '(#f #t)))
+  (tabulate* funcs doms))
 
 (module+ test
-  (test-case "tabulate/list"
-    (check-equal? (tabulate/list (λ ([xs : (Listof Boolean)])
-                                   (and (car xs) (cadr xs)))
-                                 '((#f #t) (#f #t)))
-                  '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
-
-(: tabulate/pv/boolean (-> Positive-Integer (-> Boolean * Boolean) (Listof (Listof Boolean))))
-(define (tabulate/pv/boolean arity func)
-  (tabulate/pv func (make-list arity '(#f #t))))
-
-(module+ test
-  (test-case "tabulate/pv/boolean"
-    (check-equal? (tabulate/pv/boolean 2 (pvλ (x y) (and x y)))
-                  '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
-
-(: tabulate*/pv/boolean (-> Positive-Integer (Listof (-> Boolean * Boolean))
-                            (Listof (Listof Boolean))))
-(define (tabulate*/pv/boolean arity funcs)
-  (tabulate*/pv funcs (make-list arity '(#f #t))))
-
-(module+ test
-  (test-case "tabulate*/pv/boolean"
-    (check-equal? (tabulate*/pv/boolean 2 (list (pvλ (x y) (and x y))
-                                                (pvλ (x y) (or x y))))
+  (test-case "tabulate*/boolean"
+    (check-equal? (tabulate*/boolean `(,(λ (x y) (and x y))
+                                       ,(λ (x y) (or x y))))
                   '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
 
-(: tabulate/pv/01 (-> Positive-Integer (-> (U Zero One) * (U Zero One))
-                      (Listof (Listof (U Zero One)))))
-(define (tabulate/pv/01 arity func)
-  (tabulate/pv func (make-list arity '(0 1))))
+;;; Like tabulate, but assumes the domains of all variables of the
+;;; function are {0, 1}.  func must have a fixed arity.  It is an
+;;; error to supply a function of variable arity.
+(define (tabulate/01 func)
+  (tabulate func (make-list (procedure-arity func) '(0 1))))
 
 (module+ test
-  (test-case "tabulate/pv/01"
-    (check-equal? (tabulate/pv/01 2 (pvλ (x y)
-                                         (assert-type (modulo (+ x y) 2) (U Zero One))))
+  (test-case "tabulate/01"
+    (check-equal? (tabulate/01 (λ (x y) (modulo (+ x y) 2)))
                   '((0 0 0) (0 1 1) (1 0 1) (1 1 0)))))
 
-(: tabulate*/pv/01 (-> Positive-Integer (Listof (-> (U Zero One) * (U Zero One)))
-                       (Listof (Listof (U Zero One)))))
-(define (tabulate*/pv/01 arity funcs)
-  (tabulate*/pv funcs (make-list arity '(0 1))))
+;;; Like tabulate/01, but takes a list of functions of the same arity.
+(define (tabulate*/01 funcs)
+  (tabulate* funcs (make-list (procedure-arity (car funcs)) '(0 1))))
 
 (module+ test
-  (test-case "tabulate*/pv/01"
-    (check-equal? (tabulate*/pv/01 2 `(,(pvλ (x y) (assert-type (min x y) (U Zero One)))
-                                       ,(pvλ (x y) (assert-type (max x y) (U Zero One)))))
+  (test-case "tabulate*/01"
+    (check-equal? (tabulate*/01 `(,(λ (x y) (min x y)) ,(λ (x y) (max x y))))
                   '((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1)))))
 
-(: tabulate/list/boolean (-> Positive-Integer (-> (Listof Boolean) Boolean)
-                             (Listof (Listof Boolean))))
-(define (tabulate/list/boolean arity func)
-  (tabulate/list func (make-list arity '(#f #t))))
+;;; ======================
+;;; Constructing functions
+;;; ======================
 
-(module+ test
-  (test-case "tabulate/list/boolean"
-    (check-equal? (tabulate/list/boolean 2 (λ (xs) (and (car xs) (cadr xs))))
-                  '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
-
-(: tabulate*/list/boolean (-> Positive-Integer (Listof (-> (Listof Boolean) Boolean))
-                              (Listof (Listof Boolean))))
-(define (tabulate*/list/boolean arity funcs)
-  (tabulate*/list funcs (make-list arity '(#f #t))))
-
-(module+ test
-  (test-case "tabulate*/list/boolean"
-    (check-equal?
-     (tabulate*/list/boolean 2 (list (λ (xs) (and (car xs) (cadr xs)))
-                                     (λ (xs) (or (car xs) (cadr xs)))))
-     '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
-
-(: tabulate/list/01 (-> Positive-Integer (-> (Listof (U Zero One)) (U Zero One))
-                        (Listof (Listof (U Zero One)))))
-(define (tabulate/list/01 arity func)
-  (tabulate/list func (make-list arity '(0 1))))
-
-(module+ test
-  (test-case "tabulate/list/01"
-    (check-equal?
-     (tabulate/list/01 2 (λ (xs)
-                           (assert-type (modulo (+ (car xs) (cadr xs)) 2) (U Zero One))))
-     '((0 0 0) (0 1 1) (1 0 1) (1 1 0)))))
-
-(: tabulate*/list/01 (-> Positive-Integer (Listof (-> (Listof (U Zero One)) (U Zero One)))
-                         (Listof (Listof (U Zero One)))))
-(define (tabulate*/list/01 arity funcs)
-  (tabulate*/list funcs (make-list arity '(0 1))))
-
-(module+ test
-  (test-case "tabulate*/list/01"
-    (check-equal? (tabulate*/list/01
-                   2
-                   `(,(λ (xs) (assert-type (min (car xs) (cadr xs)) (U Zero One)))
-                     ,(λ (xs) (assert-type (max (car xs) (cadr xs)) (U Zero One)))))
-                  '((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1)))))
-
-(: table->function/list (All (a) (-> (Listof (Listof a))
-                                     (-> (Listof a) a))))
-(define (table->function/list table)
-  (table->unary-function
-   (for/list ([line (in-list table)]) : (Listof (List (Listof a) a))
-             (define-values (ins out) (split-at-right line 1))
-             (list ins (car out)))))
-
-(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)))))
-
-(: table->unary-function (All (a b) (-> (Listof (List a b)) (-> a b))))
-(define (table->unary-function table)
-  (define ht-tab
-    (for/hash ([line (in-list table)]) : (HashTable a b)
-      (values (car line) (cadr line))))
-  (λ (x) (hash-ref ht-tab x)))
-
-(module+ test
-  (test-case "table->unary-function"
-    (define unary-negation (table->unary-function '((#t #f) (#f #t))))
-    (check-false (unary-negation #t))
-    (check-true (unary-negation #f))))
-
-(: table->function (All (a) (-> (Listof (Listof a)) (-> a * a))))
+;;; 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)
-  (define func (table->function/list table))
-  (λ args (func args)))
+  (let ([func (table->function/list table)])
+    (λ args (func args))))
 
 (module+ test
   (test-case "table->function"
@@ -315,177 +150,150 @@
     (check-true (negation #f))
     (check-false (negation #t))))
 
-(: table->function/pv (All (a) (-> (Listof (Listof a)) (-> a * a))))
-(define (table->function/pv table)
-  (define func (table->function/list table))
-  (define arity (- (length (car table)) 1))
-  (λ xs
-    (if (= arity (length xs))
-        (func xs)
-        (error 'pseudovariadic-lambda
-               "invalid arity, expected ~a argument(s)"
-               arity))))
+;;; 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/pv"
-    (define negation (table->function/pv '((#t #f) (#f #t))))
-    (check-true (negation #f))
-    (check-false (negation #t))
-    (check-exn exn:fail? (λ () (negation #f #t)))))
+  (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)))))
 
-(: enumerate-boolean-tables (-> Positive-Integer (Sequenceof (Listof (Listof Boolean)))))
+;;; 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)
-  (define inputs (boolean-power n))
-  (define outputs (boolean-power/stream (assert-type (expt 2 n) Integer)))
+  (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))))))
 
-  (: append-outputs (-> (Listof (Listof Boolean)) (Listof Boolean)
-                        (Listof (Listof Boolean))))
-  (define (append-outputs ins outs)
-    (for/list ([row ins] [o outs]) (append row (list o))))
-
-  (: yield (-> (Sequenceof (Listof Boolean)) (Sequenceof (Listof (Listof Boolean)))))
-  (define (yield rest-outputs)
-    (if (stream-empty? rest-outputs)
-        (stream)
-        (stream-cons (append-outputs inputs (stream-first rest-outputs))
-                     (yield (stream-rest rest-outputs)))))
-
-  (yield outputs))
+;;; 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"
-    (check-equal? (stream->list (enumerate-boolean-tables 2))
-                  '(((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #f))
-                    ((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))
-                    ((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #f))
-                    ((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t))
-                    ((#f #f #f) (#f #t #t) (#t #f #f) (#t #t #f))
-                    ((#f #f #f) (#f #t #t) (#t #f #f) (#t #t #t))
-                    ((#f #f #f) (#f #t #t) (#t #f #t) (#t #t #f))
-                    ((#f #f #f) (#f #t #t) (#t #f #t) (#t #t #t))
-                    ((#f #f #t) (#f #t #f) (#t #f #f) (#t #t #f))
-                    ((#f #f #t) (#f #t #f) (#t #f #f) (#t #t #t))
-                    ((#f #f #t) (#f #t #f) (#t #f #t) (#t #t #f))
-                    ((#f #f #t) (#f #t #f) (#t #f #t) (#t #t #t))
-                    ((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f))
-                    ((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #t))
-                    ((#f #f #t) (#f #t #t) (#t #f #t) (#t #t #f))
-                    ((#f #f #t) (#f #t #t) (#t #f #t) (#t #t #t))))))
+    (define f1 (stream-first (enumerate-boolean-functions 1)))
+    (check-false (f1 #f))
+    (check-false (f1 #t))))
 
-(: enumerate-boolean-functions (-> Positive-Integer (Sequenceof (-> Boolean * Boolean))))
-(define (enumerate-boolean-functions n)
-  (stream-map (inst table->function Boolean) (enumerate-boolean-tables n)))
-
-(module+ test
-  (test-case "enumerate-boolean-functions"
-    (define bool-f1 (stream-first (enumerate-boolean-functions 1)))
-    (check-false (bool-f1 #f))
-    (check-false (bool-f1 #t))))
-
-(: enumerate-boolean-functions/pv (-> Positive-Integer (Sequenceof (-> Boolean * Boolean))))
-(define (enumerate-boolean-functions/pv n)
-  (stream-map (inst table->function/pv Boolean) (enumerate-boolean-tables n)))
-
-(module+ test
-  (test-case "enumerate-boolean-functions/pv"
-    (define bool-f1/pv (stream-first (enumerate-boolean-functions/pv 1)))
-    (check-false (bool-f1/pv #f))
-    (check-false (bool-f1/pv #t))
-    (check-exn exn:fail? (λ () (bool-f1/pv #f #f)))))
-
-(: enumerate-boolean-functions/list
-   (-> Positive-Integer (Sequenceof (-> (Listof Boolean) Boolean))))
+;;; 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 (inst table->function/list Boolean) (enumerate-boolean-tables n)))
+  (stream-map table->function/list (enumerate-boolean-tables n)))
 
 (module+ test
   (test-case "enumerate-boolean-functions/list"
-    (define bool-f1/list (stream-first (enumerate-boolean-functions/list 1)))
-    (check-false (bool-f1/list '(#f)))
-    (check-false (bool-f1/list '(#t)))))
+    (define f1/list (stream-first (enumerate-boolean-functions/list 1)))
+    (check-false (f1/list '(#f)))
+    (check-false (f1/list '(#t)))))
 
-(: random-boolean-table (-> Positive-Integer (Listof (Listof Boolean))))
+
+;;; ================
+;;; Random functions
+;;; ================
+
+;;; Generates a random truth table for a Boolean function of arity n.
 (define (random-boolean-table n)
-  (define ins (boolean-power n))
-  (define outs (stream-take (in-random 2) (assert-type (expt 2 n) Nonnegative-Integer)))
-  (for/list ([i ins] [o outs])
-    (append i (list (if (= o 1) #t #f)))))
+  (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 1)
-    (check-equal? (random-boolean-table 2)
-                  '((#f #f #t)
-                    (#f #t #t)
-                    (#t #f #f)
-                    (#t #t #t)))))
+    (random-seed 0)
+    (check-equal? (random-boolean-table 2) '((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f)))))
 
-(: random-boolean-function (-> Positive-Integer (-> Boolean * Boolean)))
-(define (random-boolean-function n)
-  (table->function (random-boolean-table n)))
+;;; 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"
-    (random-seed 1)
-    (define random-bool-f (random-boolean-function 2))
-    (check-true (random-bool-f #f #f))
-    (check-true (random-bool-f #f #t))
-    (check-false (random-bool-f #t #f))
-    (check-true (random-bool-f #t #t))))
+    (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))))
 
-(: random-boolean-function/list (-> Positive-Integer (-> (Listof Boolean) Boolean)))
-(define (random-boolean-function/list n)
-  (table->function/list (random-boolean-table n)))
+;;; 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"
-    (random-seed 1)
-    (define random-bool-f/list (random-boolean-function/list 2))
-    (check-true (random-bool-f/list '(#f #f)))
-    (check-true (random-bool-f/list '(#f #t)))
-    (check-false (random-bool-f/list '(#t #f)))
-    (check-true (random-bool-f/list '(#t #t)))))
+    (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)))))
 
-(struct tbf ([weights : (Vectorof Real)] [threshold : Real])
-  #:transparent #:type-name TBF)
+
+;;; ===========================
+;;; Threshold Boolean functions
+;;; ===========================
+
+;;; A threshold Boolean function (TBF) is a pair (w, θ), where w is a
+;;; vector of weights and θ is the threshold.
+(struct tbf (weights threshold) #:transparent)
+
+;;; Unicode shortcuts for accessing the elements of a TBF.
 (define tbf-w tbf-weights)
 (define tbf-θ tbf-threshold)
 
-(: boolean->01/vector (-> (Vectorof Boolean) (Vectorof (U Zero One))))
-(define (boolean->01/vector bool-v)
-  (vector-map (λ (x) (any->01 x)) bool-v))
+;;; Converts a Boolean vector to a 0-1 vector.
+(define (vector-boolean->01 bool-v)
+  (vector-map any->01 bool-v))
 
 (module+ test
-  (test-case "boolean->01/vector"
-    (check-equal? (boolean->01/vector #(#t #f #f)) #(1 0 0))))
+  (test-case "boolean->0-1"
+    (check-equal? (vector-boolean->01 #(#t #f #f)) #(1 0 0))))
 
-(: apply-tbf (-> TBF (Vectorof (U Zero One)) (U Zero One)))
+;;; Applies the TBF to its inputs.
+;;;
+;;; Applying a TBF consists in multiplying the weights by the
+;;; corresponding inputs and comparing the sum of the products to the
+;;; threshold.
 (define (apply-tbf tbf inputs)
   (any->01
    (>
-    ;; The scalar product between the inputs and the weights.
+    ;; The scalar product between the inputs and the weights
     (for/sum ([x (in-vector inputs)]
-              [w (in-vector (tbf-w tbf))]) : Real
-             (* x w))
+              [w (in-vector (tbf-w tbf))])
+      (* x w))
     (tbf-θ tbf))))
 
 (module+ test
   (test-case "apply-tbf"
     (define f1 (tbf #(2 -2) 1))
-    (check-equal? (tabulate/pv/01 2 (pvλ (x y) (apply-tbf f1 (vector x y))))
+    (check-equal? (tabulate/01 (λ (x y) (apply-tbf f1 (vector x y))))
                   '((0 0 0) (0 1 0) (1 0 1) (1 1 0)))))
 
-(: apply-tbf/boolean (-> TBF (Vectorof Boolean) Boolean))
+;;; Like apply-tbf, but takes Boolean values as inputs and outputs a
+;;; boolean value.
 (define (apply-tbf/boolean tbf inputs)
-  (01->boolean (apply-tbf tbf (boolean->01/vector inputs))))
+  (01->boolean (apply-tbf tbf (vector-map any->01 inputs))))
 
 (module+ test
   (test-case "apply-tbf/boolean"
     (define f1 (tbf #(2 -2) 1))
-    (check-equal? (tabulate/pv/boolean 2 (pvλ (x y) (apply-tbf/boolean f1 (vector x y))))
+    (check-equal? (tabulate/boolean (λ (x y) (apply-tbf/boolean f1 (vector x y))))
                   '((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #f)))))
 
-(: list->tbf (-> (Listof Real) TBF))
+;;; Converts a list of numbers to a TBF.  The last element of the list
+;;; is taken to be the threshold, while the other elements are taken
+;;; to be the weights.
 (define (list->tbf lst)
   (define-values (w θ) (split-at-right lst 1))
   (tbf (list->vector w) (car θ)))
@@ -494,167 +302,112 @@
   (test-case "list->tbf"
     (check-equal? (list->tbf '(1 2 3)) (tbf #(1 2) 3))))
 
-(: lists->tbfs (-> (Listof (Listof Real)) (Listof TBF)))
-(define (lists->tbfs lsts)
-  (map list->tbf lsts))
+;;; Reads a list of TBF from an Org-mode table read by
+;;; read-org-sexp.
+(define lists->tbfs ((curry map) list->tbf))
 
 (module+ test
   (test-case "read-tbfs"
     (check-equal? (lists->tbfs '((1 2 3) (2 3 4)))
                   (list (tbf '#(1 2) 3) (tbf '#(2 3) 4)))))
 
-(: read-org-tbfs (->* (String) (#:headers Boolean) (Listof TBF)))
+;;; Reads a list of TBF from an Org-mode string containing a sexp,
+;;; containing a list of lists of numbers.  If headers is #t, drops
+;;; the first list, supposing that it contains the headers of the
+;;; table.
+;;;
+;;; The input is typically what read-org-sexp reads.
 (define (read-org-tbfs str #:headers [headers #f])
-  (define sexp (assert-type (read-org-sexp str) (Listof Any)))
+  (define sexp (read-org-sexp str))
   (define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
-  (lists->tbfs (assert-type sexp-clean (Listof (Listof Real)))))
+  (lists->tbfs sexp-clean))
 
 (module+ test
   (test-case "read-org-tbfs"
     (check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
                   (list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
 
-(: tbf-tabulate* (-> (Listof TBF) (Listof (Listof (U Zero One)))))
+;;; Tabulates a list of TBFs.
+;;;
+;;; The result is a list of lists describing the truth table of the
+;;; given TBFs.  The first elements of each line give the values of
+;;; the inputs, while the last elements give the values of each the
+;;; functions corresponding to the input.
+;;;
+;;; All the TBFs in tbfs must have the same number of inputs as the
+;;; first TBF in the list.  This function does not check this
+;;; condition.
 (define (tbf-tabulate* tbfs)
   (define funcs (for/list ([tbf tbfs])
-                  : (Listof (-> (Listof (U Zero One)) (U Zero One)))
-                  (λ ([in : (Listof (U Zero One))])
-                    (apply-tbf tbf (list->vector in)))))
+                  (λ in (apply-tbf tbf (list->vector in)))))
   (define nvars (vector-length (tbf-w (car tbfs))))
-  (tabulate*/list funcs (make-list nvars '(0 1))))
+  (tabulate* funcs (make-list nvars '(0 1))))
 
 (module+ test
   (test-case "tbf-tabulate*"
     (check-equal? (tbf-tabulate* (list (tbf #(2 2) 1) (tbf #(1 1) 1)))
                   '((0 0 0 0) (0 1 1 0) (1 0 1 0) (1 1 1 1)))))
 
-(: tbf-tabulate (-> TBF (Listof (Listof (U Zero One)))))
-(define (tbf-tabulate t)
-  (tbf-tabulate* (list t)))
+;;; Tabulates a TBF.
+(define tbf-tabulate (compose tbf-tabulate* list))
 
 (module+ test
   (test-case "tbf-tabulate"
     (check-equal? (tbf-tabulate (tbf #(1 2) 1))
                   '((0 0 0) (0 1 1) (1 0 0) (1 1 1)))))
 
-(: tbf-tabulate*/boolean (-> (Listof TBF) (Listof (Listof Boolean))))
+;;; Tabulates a list of TBFs like tbf-boolean*, but uses Boolean
+;;; values #f and #t instead of 0 and 1.
+;;;
+;;; All the TBFs in tbfs must have the same number of inputs as the
+;;; first TBF in the list.  This function does not check this
+;;; condition.
 (define (tbf-tabulate*/boolean tbfs)
   (define funcs (for/list ([tbf tbfs])
-                  : (Listof (-> (Listof Boolean) Boolean))
-                  (λ ([in : (Listof Boolean)])
-                    (apply-tbf/boolean tbf (list->vector in)))))
+                  (λ in (apply-tbf/boolean tbf (list->vector in)))))
   (define nvars (vector-length (tbf-w (car tbfs))))
-  (tabulate*/list funcs (make-list nvars '(#f #t))))
+  (tabulate* funcs (make-list nvars '(#f #t))))
 
 (module+ test
   (test-case "tbf-tabulate*/boolean"
-    (check-equal? (tbf-tabulate*/boolean (list (tbf #(1 2) 1)))
+    (check-equal? (tbf-tabulate*/boolean `(,(tbf #(1 2) 1)))
                   '((#f #f #f) (#f #t #t) (#t #f #f) (#t #t #t)))))
 
-(: sbf? (-> TBF Boolean))
-(define (sbf? t)
-  (= 0 (tbf-θ t)))
+;;; A sign Boolean function (SBF) is a TBF whose threshold is 0.
+(define sbf? (and/c tbf? (λ (x) (= 0 (tbf-θ x)))))
 
 (module+ test
   (test-case "sbf?"
     (check-false (sbf? (tbf #(1 2) 3)))
     (check-true (sbf? (tbf #(1 2) 0)))))
 
-(: sbf (-> (Vectorof Real) TBF))
-(define (sbf w)
-  (tbf w 0))
+;;; Creates a TBF which is an SBF from a vector of weights.
+(define (sbf w) (tbf w 0))
 
 (module+ test
   (test-case "sbf"
     (check-equal? (sbf #(1 -1)) (tbf '#(1 -1) 0))))
 
-(: list->sbf (-> (Listof Real) TBF))
-(define (list->sbf lst) (sbf (list->vector lst)))
+;;; Converts a list of numbers to an SBF.  The elements of the list
+;;; are taken to be the weights of the SBF.
+(define list->sbf (compose sbf list->vector))
 
 (module+ test
   (test-case "list->sbf"
     (check-equal? (list->sbf '(1 -1)) (tbf '#(1 -1) 0))))
 
-(: read-org-sbfs (->* (String) (#:headers Boolean) (Listof TBF)))
+;;; Reads a list of SBF from an Org-mode string containing a sexp,
+;;; containing a list of lists of numbers.  If headers is #t, drops
+;;; the first list, supposing that it contains the headers of the
+;;; table.
+;;;
+;;; The input is typically what read-org-sexp reads.
 (define (read-org-sbfs str #:headers [headers #f])
-  (define sexp (assert-type (read-org-sexp str) (Listof Any)))
+  (define sexp (read-org-sexp str))
   (define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
-  (map list->sbf (assert-type sexp-clean (Listof (Listof Real)))))
+  (map list->sbf sexp-clean))
 
 (module+ test
   (test-case "read-org-sbfs"
     (check-equal? (read-org-sbfs "((1 1) (1 -1))")
                   (list (tbf '#(1 1) 0) (tbf '#(1 -1) 0)))))
-
-(module untyped racket
-  (module+ test
-    (require rackunit))
-
-  (provide
-   (contract-out [tabulate* (-> (listof procedure?) (listof (listof any/c))
-                                (listof (listof any/c)))]
-                 [tabulate (-> procedure? (listof (listof any/c))
-                               (listof (listof any/c)))]
-                 [tabulate/boolean (-> procedure? (listof (listof boolean?)))]
-                 [tabulate*/boolean (-> (non-empty-listof procedure?)
-                                        (listof (listof boolean?)))]
-                 [tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
-                 [tabulate*/01 (-> (non-empty-listof procedure?) (listof (listof (or/c 0 1))))]))
-
-  (define (tabulate* funcs doms)
-    (for/list ([xs (in-list (apply cartesian-product doms))])
-      (append xs (for/list ([f funcs])
-                   (apply f xs)))))
-
-  (module+ test
-    (test-case "tabulate*"
-      (check-equal? (tabulate*
-                     (list (λ (x y) (and x y))
-                           (λ (x y) (or x y)))
-                     '((#f #t) (#f #t)))
-                    '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))
-      (check-equal? (tabulate* empty '((#f #t) (#f #t)))
-                    '((#f #f) (#f #t) (#t #f) (#t #t)))))
-
-  (define (tabulate func doms)
-    (tabulate* (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)))))
-
-  (define (tabulate/boolean func)
-    (tabulate 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)))))
-
-  (define (tabulate*/boolean funcs)
-    (define doms (make-list (procedure-arity (car funcs)) '(#f #t)))
-    (tabulate* funcs doms))
-
-  (module+ test
-    (test-case "tabulate*/boolean"
-      (check-equal? (tabulate*/boolean `(,(λ (x y) (and x y))
-                                         ,(λ (x y) (or x y))))
-                    '((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
-
-  (define (tabulate/01 func)
-    (tabulate func (make-list (procedure-arity func) '(0 1))))
-
-  (module+ test
-    (test-case "tabulate/01"
-      (check-equal? (tabulate/01 (λ (x y) (modulo (+ x y) 2)))
-                    '((0 0 0) (0 1 1) (1 0 1) (1 1 0)))))
-
-  (define (tabulate*/01 funcs)
-    (tabulate* funcs (make-list (procedure-arity (car funcs)) '(0 1))))
-
-  (module+ test
-    (test-case "tabulate*/01"
-      (check-equal? (tabulate*/01 `(,(λ (x y) (min x y)) ,(λ (x y) (max x y))))
-                    '((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1)))))
-  )

graph-typed.rkt

@@ -0,0 +1,16 @@
+#lang typed/racket
+
+;;; Slap types on some graph functions.
+
+(require/typed/provide graph
+  [#:opaque Graph graph?]
+  [graphviz (-> Graph
+                [#:output Output-Port]
+                [#:colors (HashTable Any Natural)]
+                String)]
+  [unweighted-graph/directed (-> (Listof (List Any Any)) Graph)]
+  [in-edges (-> Graph (Sequenceof Any))]
+  [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
+  [undirected-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
+  [has-vertex? (-> Graph Any Boolean)]
+  [has-edge? (-> Graph Any Any Boolean)])

info.rkt

@@ -2,18 +2,5 @@
 (define collection "dds")
 (define deps '("base"
                "graph-lib"
-               "rackunit-lib"
-               "rackunit-typed"
-               "typed-graph"
-               "typed-racket-lib"
-               "typed-compose"
-               "typed-racket-stream"
-               "typed-racket-more"))
-(define build-deps '("racket-doc"
-                     "typed-racket-doc"
-                     "sandbox-lib"
-                     "scribble-lib"
-                     "typed-graph"
-                     "graph-doc"
-                     ))
+               "rackunit-lib"))
 (define scribblings '(("scribblings/dds.scrbl" (multi-page))))

rs.rkt

@@ -1,355 +1,336 @@
-#lang typed/racket
+#lang racket
 
-(require typed/graph "utils.rkt" "dynamics.rkt")
+;;; dds/rs
+
+;;; Definitions for working with reaction systems.
+
+(require graph "utils.rkt" "generic.rkt")
 
 (provide
- Species (struct-out reaction) Reaction ReactionName ReactionSystem
- make-reaction enabled? list-enabled union-products apply-rs
-
- str-triple->reaction ht-str-triples->rs read-org-rs read-context-sequence
- reaction->str-triple rs->ht-str-triples
-
- (struct-out state) State dynamics% Dynamics% build-interactive-process-graph
- build-interactive-process-graph/simple-states
- pretty-print-state-graph/simple-states build-interactive-process
- build-interactive-process/org pretty-print-state pretty-print-state-graph
- )
+ ;; Structures
+ (struct-out reaction)
+ (struct-out state)
+ (struct-out dynamics)
+ ;; Functions
+ (contract-out [enabled? (-> reaction? (set/c symbol?) boolean?)]
+               [list-enabled (-> reaction-system/c (set/c species?) (listof symbol?))]
+               [union-products (-> reaction-system/c (listof symbol?) (set/c species?))]
+               [apply-rs (-> reaction-system/c (set/c species?) (set/c species?))]
+               [ht-str-triples->rs (-> (hash/c symbol? (list/c string? string? string?)) reaction-system/c)]
+               [read-org-rs (-> string? reaction-system/c)]
+               [read-context-sequence (-> string? (listof (set/c species?)))]
+               [rs->ht-str-triples (-> reaction-system/c (hash/c symbol? (list/c string? string? string?)))]
+               [dds-step-one (-> dynamics? state? (set/c state?))]
+               [dds-step-one-annotated (-> dynamics? state? (set/c (cons/c (set/c symbol?) state?)))]
+               [dds-step (-> dynamics? (set/c state? #:kind 'dont-care) (set/c state?))]
+               [dds-build-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) graph?)]
+               [dds-build-n-step-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) number? graph?)]
+               [dds-build-state-graph-annotated (-> dynamics? (set/c state? #:kind 'dont-care) graph?)]
+               [dds-build-n-step-state-graph-annotated (-> dynamics? (set/c state? #:kind 'dont-care) number? graph?)]
+               [build-interactive-process-graph (-> reaction-system/c (listof (set/c species?)) graph?)]
+               [build-reduced-state-graph (-> reaction-system/c (listof (set/c species?)) graph?)]
+               [pretty-print-reduced-state-graph (-> graph? graph?)]
+               [build-interactive-process (-> reaction-system/c (listof (set/c species?)) (listof (list/c (set/c species?) (set/c species?))))]
+               [pretty-print-state-graph (-> graph? graph?)])
+ ;; Predicates
+ (contract-out [species? (-> any/c boolean?)])
+ ;; Contracts
+ (contract-out [reaction-system/c contract?]))
 
 (module+ test
-  (require typed/rackunit))
+  (require rackunit))
 
-(define-type Species Symbol)
 
-(struct reaction ([reactants : (Setof Species)]
-                  [inhibitors : (Setof Species)]
-                  [products : (Setof Species)])
-  #:transparent
-  #:type-name Reaction)
+;;; =================
+;;; Basic definitions
+;;; =================
 
-(define-type ReactionName Symbol)
+;;; A species is a symbol.
+(define species? symbol?)
 
-(: make-reaction (-> (Listof Species) (Listof Species) (Listof Species) Reaction))
-(define (make-reaction r i p) (reaction (list->set r)
-                                        (list->set i)
-                                        (list->set p)))
-(module+ test
-  (test-case "make-reaction"
-    (check-equal? (make-reaction '(a b) '(c d) '(e f))
-                  (reaction (set 'b 'a) (set 'c 'd) (set 'f 'e)))))
+;;; A reaction is a triple of sets, giving the reactants, the
+;;; inhibitors, and the products, respectively.
+(struct reaction (reactants inhibitors products) #:transparent)
 
-(: enabled? (-> Reaction (Setof Species) Boolean))
+;;; A reaction is enabled on a set if all of its reactants are in the
+;;; set and none of its inhibitors are.
 (define/match (enabled? r s)
-  [((reaction r i _) s)
+  [((reaction r i p) s)
    (and (subset? r s) (set-empty? (set-intersect i s)))])
 
-(module+ test
-  (test-case "enabled?"
-    (check-true (enabled? (make-reaction '(a b) '(c d) '())
-                          (set 'a 'b 'e)))
-    (check-false (enabled? (make-reaction '(a b) '(c d) '())
-                           (set 'a 'b 'c)))
-    (check-false (enabled? (make-reaction '(a b) '(c d) '())
-                           (set 'b 'e)))))
+;;; A reaction system is a dictionary mapping reaction names to
+;;; reactions.
+(define reaction-system/c (hash/c symbol? reaction?))
 
-(define-type ReactionSystem (HashTable ReactionName Reaction))
-
-(: list-enabled (-> ReactionSystem (Setof Species) (Listof ReactionName)))
+;;; Returns the list of reaction names enabled on a given set.
 (define (list-enabled rs s)
   (for/list ([(name reaction) (in-hash rs)]
              #:when (enabled? reaction s))
     name))
 
-(module+ test
-  (test-case "list-enabled"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(z))))
-    (check-equal? (list-enabled rs (set 'x 'y)) '(b))
-    (check-equal? (list-enabled rs (set 'x)) '(a))))
-
-(: union-products (-> ReactionSystem (Listof ReactionName) (Setof Species)))
+;;; Returns the union of the product sets of the given reactions in a
+;;; reaction system.  If no reactions are supplied, returns the empty
+;;; set.
+;;;
+;;; This function can be seen as producing the result of the
+;;; application of the given reactions to a set.  Clearly, it does not
+;;; check whether the reactions are actually enabled.
 (define (union-products rs as)
-  (cond
-    [(empty? as) (set)]
-    [else (define products (for/list : (Listof (Setof Species))
-                                     ([a as])
-                             (reaction-products (hash-ref rs a))))
-          (apply set-union (assert-type products (NonemptyListof (Setof Species))))]))
+  (if (empty? as)
+      (set)
+      (apply set-union
+             (for/list ([a as])
+               (reaction-products (hash-ref rs a))))))
 
-(module+ test
-  (test-case "union-products"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(t))))
-    (check-equal? (union-products rs '(a b))
-                  (set 't 'z))
-    (check-equal? (union-products rs '(a))
-                  (set 'z))
-    (check-equal? (union-products rs '())
-                  (set))))
-
-(: apply-rs (-> ReactionSystem (Setof Species) (Setof Species)))
+;;; Applies a reaction system to a set.
 (define (apply-rs rs s)
   (let ([as (list-enabled rs s)])
     (union-products rs as)))
 
 (module+ test
-  (test-case "apply-rs"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(t))))
-    (check-equal? (apply-rs rs (set 'x 'y))
-                  (set 't))
-    (check-equal? (apply-rs rs (set 'x))
-                  (set 'z))))
+  (test-case "Basic definitions"
+    (define r1 (reaction (set 'x) (set 'y) (set 'z)))
+    (define r2 (reaction (set 'x) (set) (set 'y)))
+    (define rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2))))
+    (define s1 (set 'x 'z))
+    (define s2 (set 'x 'y))
+    (check-true (enabled? r1 s1))
+    (check-false (enabled? r1 s2))
+    (check-equal? (list-enabled rs s1) '(a b))
+    (check-equal? (list-enabled rs s2) '(b))
+    (check-equal? (union-products rs '(a b)) (set 'y 'z))
+    (check-equal? (apply-rs rs s1) (set 'y 'z))
+    (check-equal? (apply-rs rs s2) (set 'y))))
 
-(: str-triple->reaction (-> (List String String String) Reaction))
+
+;;; ====================
+;;; Org-mode interaction
+;;; ====================
+
+;;; This section contains some useful primitives for Org-mode
+;;; interoperability.
+
+;;; Converts a triple of strings to a reaction.
 (define/match (str-triple->reaction lst)
   [((list str-reactants str-inhibitors str-products))
    (reaction (list->set (read-symbol-list str-reactants))
              (list->set (read-symbol-list str-inhibitors))
              (list->set (read-symbol-list str-products)))])
 
-(module+ test
-  (test-case "str-triple->reaction"
-    (check-equal? (str-triple->reaction '("a b" "c d" "e f"))
-                  (reaction (set 'b 'a) (set 'c 'd) (set 'f 'e)))))
-
-(: ht-str-triples->rs (-> (HashTable ReactionName (List String String String))
-                          ReactionSystem))
+;;; Converts a hash table mapping reaction names to triples of strings
+;;; to a reaction system.
 (define (ht-str-triples->rs ht)
-  (for/hash : (HashTable ReactionName Reaction)
-            ([(a triple) (in-hash ht)])
+  (for/hash ([(a triple) (in-hash ht)])
     (values a (str-triple->reaction triple))))
 
 (module+ test
   (test-case "ht-str-triples->rs"
-    (check-equal? (ht-str-triples->rs (hash 'a (list "x y" "" "k i")
-                                            'b (list "" "x y" "t j")))
-                  (hash 'a (reaction (set 'y 'x) (set) (set 'k 'i))
-                        'b (reaction (set) (set 'y 'x) (set 't 'j))))))
+    (check-equal?
+     (ht-str-triples->rs #hash((a . ("x t" "y" "z"))))
+     (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))))
 
-(: read-org-rs (-> String ReactionSystem))
-(define (read-org-rs str)
-  (ht-str-triples->rs
-   (assert-type (read-org-variable-mapping str)
-                (Immutable-HashTable ReactionName (List String String String)))))
+;;; Reads a reaction system from an Org-mode style string.
+(define read-org-rs (compose ht-str-triples->rs read-org-variable-mapping))
 
 (module+ test
   (test-case "read-org-rs"
-    (check-equal?
-     (read-org-rs "((\"a\" \"x t\" \"y\" \"z\") (\"b\" \"x\" \"q\" \"z\"))")
-     (hash 'a (reaction (set 't 'x) (set 'y) (set 'z))
-           'b (reaction (set 'x) (set 'q) (set 'z))))))
+    (check-equal? (read-org-rs "((\"a\" \"x t\" \"y\" \"z\") (\"b\" \"x\" \"q\" \"z\"))")
+                  (hash
+                   'a
+                   (reaction (set 'x 't) (set 'y) (set 'z))
+                   'b
+                   (reaction (set 'x) (set 'q) (set 'z))))))
 
-(: read-context-sequence (-> String (Listof (Setof Species))))
+;;; Reads a context sequence from an Org sexp corresponding to a list.
 (define (read-context-sequence str)
-  (for/list ([sexp (in-list (flatten (string->any str)))])
-    (list->set (read-symbol-list (assert-type sexp String)))))
+  (map (compose list->set read-symbol-list) (flatten (string->any str))))
 
 (module+ test
   (test-case "read-context-sequence"
     (check-equal? (read-context-sequence "((\"x y\") (\"z\") (\"\") (\"t\"))")
                   (list (set 'x 'y) (set 'z) (set) (set 't)))))
 
-(: reaction->str-triple (-> Reaction (Listof String)))
+;;; Converts a reaction to a triple of strings.
 (define/match (reaction->str-triple r)
   [((reaction r i p))
-   (for/list ([c (in-list (list r i p))])
-     (drop-first-last (any->string (set->list c))))])
+   (map (compose drop-first-last any->string set->list)
+        (list r i p))])
 
-(module+ test
-  (test-case "reaction->str-triple"
-    (check-equal? (reaction->str-triple (make-reaction '(x y) '(z t) '(k i)))
-                  '("x y" "z t" "i k"))))
-
-(: rs->ht-str-triples (-> ReactionSystem (HashTable ReactionName (Listof String))))
+;;; Converts a reaction system to a hash table mapping reaction names
+;;; to triples of strings.
 (define (rs->ht-str-triples rs)
-  (for/hash : (HashTable ReactionName (Listof String))
-            ([(a r) (in-hash rs)])
+  (for/hash ([(a r) (in-hash rs)])
     (values a (reaction->str-triple r))))
 
 (module+ test
   (test-case "rs->ht-str-triples"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(t))))
-    (check-equal? (rs->ht-str-triples rs)
-                  (hash 'a (list "x" "y" "z")
-                        'b (list "x y" "" "t")))))
+    (check-equal?
+     (rs->ht-str-triples (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))
+     #hash((a . ("t x" "y" "z"))))))
 
-(struct state ([result : (Setof Species)]
-               [rest-contexts : (Listof (Setof Species))])
-  #:transparent
-  #:type-name State)
 
-(define dynamics%
-  (class (inst dds% State (Listof ReactionName))
-    (super-new)
-    (init-field [rs : ReactionSystem])
-    (: step/annotated (-> State (Listof (Pairof (Listof ReactionName) State))))
-    (define/override (step/annotated s)
-      (match s
-        [(state res (cons ctx rest-ctx))
-         (define full-s (set-union ctx res))
-         (define en (list-enabled rs full-s))
-         (list (cons en (state (union-products rs en) rest-ctx)))]
-        [(state _'()) '()]))))
+;;; ============================
+;;; Dynamics of reaction systems
+;;; ============================
 
-(define-type Dynamics%
-  (Instance (Class
-             (init (rs ReactionSystem))
-             (field (rs ReactionSystem))
-             (build-state-graph (-> (Listof State) Graph))
-             (build-state-graph*
-              (-> (Listof State) (U 'full Exact-Positive-Integer) Graph))
-             (build-state-graph*/annotated
-              (-> (Listof State) (U 'full Exact-Positive-Integer) Graph))
-             (build-state-graph/annotated (-> (Listof State) Graph))
-             (step (-> State (Listof State)))
-             (step* (-> (Listof State) (Listof State)))
-             (step/annotated (-> State (Listof (Pairof (Listof Variable) State)))))))
+;;; An interactive process of a reaction system is a sequence of
+;;; states driven by a sequence of contexts in the following way.
+;;; The reaction system starts with the initial context.  Then, at
+;;; every step, the result of applying the reaction system is merged
+;;; with the next element of the context sequence, and the reaction
+;;; system is then applied to the result of the union.  If the
+;;; sequence of contexts is empty, the reaction system cannot evolve.
 
-(module+ test
-  (test-case "dynamics%:step/annotated"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define dyn (new dynamics% [rs rs]))
-    (define s0 (state (set 'x 'y)
-                      (list (set) (set) (set 'x))))
-    (define-values (_ 3-steps)
-      (for/fold ([last-s : State s0]
-                 [trace : (Listof (Pairof (Listof ReactionName) State)) '()])
-                ([_ (in-range 1 4)])
-        (define trans (send dyn step/annotated last-s))
-        (values (cdar trans) (append trace trans))))
-    (check-equal? 3-steps
-                  (list
-                   (cons '(b) (state (set 'x) (list (set) (set 'x))))
-                   (cons '(a) (state (set 'z) (list (set 'x))))
-                   (cons '(a) (state (set 'z) '()))))))
+;;; A state of a reaction system is a set of species representing the
+;;; result of the application of the reactions from the previous
+;;; steps, plus the rest of the context sequence.  When the context
+;;; sequence is empty, nothing is added to the current state.
+(struct state (result rest-contexts) #:transparent)
 
-(: build-interactive-process-graph (-> ReactionSystem (Listof (Setof Species)) Graph))
+;;; The dynamics of the reaction system only stores the reaction
+;;; system itself.
+(struct dynamics (rs) #:transparent
+  #:methods gen:dds
+  [;; Since reaction systems are deterministic, a singleton set is
+   ;; produced, unless the context sequence is empty, in which case an
+   ;; empty set of states is generated.  This transition is annotated
+   ;; by the list of rules which were enabled in the current step.
+   (define (dds-step-one-annotated dyn st)
+     (define rs (dynamics-rs dyn))
+     (define (apply-rs-annotate s rest-ctx)
+       (define en (list-enabled rs s))
+       (set (cons (list->set en)
+                  (state (union-products rs en) rest-ctx))))
+     (match st
+       [(state res (cons ctx rest-ctx))
+        (apply-rs-annotate (set-union res ctx) rest-ctx)]
+       [(state res '()) (set)]))])
+
+;;; Builds the state graph of a reaction system driven by a given
+;;; context sequence.
 (define (build-interactive-process-graph rs contexts)
-  (send (new dynamics% [rs rs])
-        build-state-graph/annotated
-        (list (state (set) contexts))))
+  (dds-build-state-graph-annotated (dynamics rs)
+                                   (set (state (set) contexts))))
 
-(module+ test
-  (test-case "build-interactive-process-graph"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define ctx : (Listof (Setof Species)) (list (set) (set) (set 'x)))
-    (check-equal? (graphviz (build-interactive-process-graph rs ctx))
-                  "digraph G {\n\tnode0 [label=\"(state (set) '(#<set: x>))\"];\n\tnode1 [label=\"(state (set 'z) '())\"];\n\tnode2 [label=\"(state (set) '(#<set:> #<set: x>))\"];\n\tnode3 [label=\"(state (set) '(#<set:> #<set:> #<set: x>))\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"'(a)\"];\n\t\tnode2 -> node0 [label=\"'()\"];\n\t\tnode3 -> node2 [label=\"'()\"];\n\t}\n}\n")))
-
-(: build-interactive-process-graph/simple-states (-> ReactionSystem (Listof (Setof Species)) Graph))
-(define (build-interactive-process-graph/simple-states rs contexts)
+;;; Builds the reduced state graph of a reaction system driven by
+;;; a given context sequence.  Unlike build-interactive-process-graph,
+;;; the nodes of this state graph do not contain the context sequence.
+(define (build-reduced-state-graph rs contexts)
   (define sgr (build-interactive-process-graph rs contexts))
   (weighted-graph/directed
    (for/list ([e (in-edges sgr)])
-     (define u (assert-type (car e) State))
-     (define v (assert-type (cadr e) State))
+     (define u (car e)) (define v (cadr e))
      (list (edge-weight sgr u v) (state-result u) (state-result v)))))
 
 (module+ test
-  (test-case "build-interactive-process-graph/simple-states"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define ctx : (Listof (Setof Species)) (list (set) (set) (set 'x)))
-    (check-equal? (graphviz (build-interactive-process-graph/simple-states rs ctx))
-                  "digraph G {\n\tnode0 [label=\"(set)\"];\n\tnode1 [label=\"(set 'z)\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"'()\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"'(a)\"];\n\t}\n}\n")))
+  (test-case "build-reduced-state-graph"
+    (define rs (hash 'a (reaction (set 'x) (set 'y) (set 'z))
+                     'b (reaction (set 'x) (set) (set 'y))))
+    (define ctx (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
+    (check-equal? (graphviz (build-reduced-state-graph rs ctx))
+                  "digraph G {\n\tnode0 [label=\"(set)\\n\"];\n\tnode1 [label=\"(set 'y 'z)\\n\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"#<set: #<set:>>\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"#<set: #<set: a b>>\"];\n\t\tnode1 -> node0 [label=\"#<set: #<set:>>\"];\n\t}\n}\n")))
 
-(: pretty-print-state-graph/simple-states (-> Graph Graph))
-(define (pretty-print-state-graph/simple-states sgr)
-  (update-graph
-   sgr
-   #:v-func
-   (λ (st) (~a "{" (pretty-print-set (assert-type st (Setof Species))) "}"))
-   #:e-func
-   (λ (e) (pretty-print-set (assert-type e (Listof ReactionName))))))
+(define (pretty-print-reduced-state-graph sgr)
+  (update-graph sgr
+                #:v-func (λ (st) (~a "{" (pretty-print-set st) "}"))
+                #:e-func pretty-print-set-sets))
 
 (module+ test
-  (test-case "pretty-print-state-graph/simple-states"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define ctx : (Listof (Setof Species)) (list (set) (set) (set 'x)))
-    (check-equal?
-     (graphviz (pretty-print-state-graph/simple-states
-                (build-interactive-process-graph/simple-states rs ctx)))
-     "digraph G {\n\tnode0 [label=\"{}\"];\n\tnode1 [label=\"{z}\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"a\"];\n\t}\n}\n")
-    ))
+  (test-case "pretty-print-reduced-graph"
+    (define rs (hash 'a (reaction (set 'x) (set 'y) (set 'z))
+                     'b (reaction (set 'x) (set) (set 'y))))
+    (define ctx (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
+    (define sgr (build-reduced-state-graph rs ctx))
+    (graphviz (pretty-print-reduced-state-graph sgr))))
 
-(: build-interactive-process (-> ReactionSystem (Listof (Setof Species))
-                                 (Listof (Pairof (Setof Species) (Setof Species)))))
+
+;;; Builds the interactive process driven by the given context
+;;; sequence.  The output is a list of pairs of lists in which the
+;;; first element is the current context and the second element is the
+;;; result of the application of reactions to the previous state.  The
+;;; interactive process stops one step after the end of the context
+;;; sequence, to show the effect of the last context.
 (define (build-interactive-process rs contexts)
-  (define dyn (new dynamics% [rs rs]))
-  (define padded-contexts
-    (append contexts (list (assert-type (set) (Setof Species)))))
-  (for/fold ([proc : (Listof (Pairof (Setof Species) (Setof Species))) '()]
-             [st : State (state (set) padded-contexts)]
-             #:result (reverse proc))
-            ([c padded-contexts])
-    (define res (state-result st))
-    (define ctx (state-rest-contexts st))
-    (values
-     ((inst cons (Pairof (Setof Species) (Setof Species)))
-      (cons (if (empty? ctx) (assert-type (set) (Setof Species)) (car ctx)) res)
-      proc)
-     (set-first (send dyn step st)))))
+  (let ([dyn (dynamics rs)]
+        [padded-contexts (append contexts (list (set)))])
+    (for/fold ([proc '()]
+               [st (state (set) padded-contexts)]
+               #:result (reverse proc))
+              ([c padded-contexts])
+      (values
+       (cons (match st
+               [(state res ctx)
+                (list (if (empty? ctx) (set) (car ctx)) res)])
+             proc)
+       (set-first (dds-step-one dyn st))))))
 
-(module+ test
-  (test-case "build-interactive-process"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define ctx : (Listof (Setof Species)) (list (set 'x 'y) (set) (set 'x) (set)))
-    (check-equal? (build-interactive-process rs ctx)
-                  (list
-                   (cons (set 'y 'x) (set))
-                   (cons (set) (set 'x))
-                   (cons (set 'x) (set 'z))
-                   (cons (set) (set 'z))
-                   (cons (set) (set))))))
-
-(: build-interactive-process/org (-> ReactionSystem (Listof (Setof Species))
-                                     (Listof (Listof (Setof Species)))))
-(define (build-interactive-process/org rs context)
-  (for/list : (Listof (Listof (Setof Species)))
-            ([p (build-interactive-process rs context)])
-    (list (car p) (cdr p))))
-
-(module+ test
-  (test-case "build-interactive-process/org"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define ctx : (Listof (Setof Species)) (list (set 'x 'y) (set) (set 'x) (set)))
-    (check-equal? (build-interactive-process/org rs ctx)
-                  (list
-                   (list (set 'y 'x) (set))
-                   (list (set) (set 'x))
-                   (list (set 'x) (set 'z))
-                   (list (set) (set 'z))
-                   (list (set) (set))))))
-
-(: pretty-print-state (-> State String))
+;;; Pretty-prints the context sequence and the current result of a
+;;; state of the reaction system.  Note that we need to keep the full
+;;; context sequence in the name of each state to avoid confusion
+;;; between the states at different steps of the evolution.
 (define/match (pretty-print-state st)
   [((state res ctx))
    (format "C:~a\nD:{~a}" (pretty-print-set-sets ctx) (pretty-print-set res))])
 
-(module+ test
-  (test-case "pretty-print-state"
-    (check-equal? (pretty-print-state
-                   (state (set 'x 'y) (list (set 'z) (set) (set 'x))))
-                  "C:{z}{}{x}\nD:{x y}")))
-
-(: pretty-print-state-graph (-> Graph Graph))
+;;; Pretty prints the state graph of a reaction system.
 (define (pretty-print-state-graph sgr)
-  (update-graph
-   sgr
-   #:v-func (λ (st) (pretty-print-state (assert-type st State)))
-   #:e-func (λ (e) (pretty-print-set (assert-type e (Listof ReactionName))))))
+  (update-graph sgr #:v-func pretty-print-state #:e-func pretty-print-set-sets))
 
 (module+ test
-  (test-case "pretty-print-state-graph"
-    (define rs (hash 'a (make-reaction '(x) '(y) '(z))
-                     'b (make-reaction '(x y) '() '(x))))
-    (define ctx : (Listof (Setof Species)) (list (set) (set) (set 'x)))
-    (check-equal? (graphviz (build-interactive-process-graph rs ctx))
-                  "digraph G {\n\tnode0 [label=\"(state (set) '(#<set: x>))\"];\n\tnode1 [label=\"(state (set 'z) '())\"];\n\tnode2 [label=\"(state (set) '(#<set:> #<set: x>))\"];\n\tnode3 [label=\"(state (set) '(#<set:> #<set:> #<set: x>))\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"'(a)\"];\n\t\tnode2 -> node0 [label=\"'()\"];\n\t\tnode3 -> node2 [label=\"'()\"];\n\t}\n}\n")
-    ))
+  (test-case "Dynamics of reaction systems"
+    (define r1 (reaction (set 'x) (set 'y) (set 'z)))
+    (define r2 (reaction (set 'x) (set) (set 'y)))
+    (define rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2))))
+    (define dyn (dynamics rs))
+    (define state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))))
+    (define sgr (dds-build-state-graph-annotated dyn (set state1)))
+    (define ip (build-interactive-process-graph rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z))))
+
+    (check-equal? (dds-step-one-annotated dyn state1)
+                  (set (cons
+                        (set 'a 'b)
+                        (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))))
+    (check-equal? (dds-step-one dyn state1)
+                  (set (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))))
+
+    (check-true (has-vertex? sgr (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))))
+    (check-true (has-vertex? sgr (state (set) (list (set 'z) (set) (set 'z)))))
+    (check-true (has-vertex? sgr (state (set) (list (set) (set 'z)))))
+    (check-true (has-vertex? sgr (state (set) (list (set 'z)))))
+    (check-true (has-vertex? sgr (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))))
+    (check-true (has-vertex? sgr (state (set) '())))
+
+    (check-false (has-edge? sgr
+                            (state (set) '())
+                            (state (set) '())))
+    (check-equal? (edge-weight sgr
+                               (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))
+                               (state (set) (list (set 'z) (set) (set 'z))))
+                  (set (set)))
+    (check-equal? (edge-weight sgr
+                               (state (set) (list (set 'z) (set) (set 'z)))
+                               (state (set) (list (set) (set 'z))))
+                  (set (set)))
+    (check-equal? (edge-weight sgr
+                               (state (set) (list (set) (set 'z)))
+                               (state (set) (list (set 'z))))
+                  (set (set)))
+    (check-equal? (edge-weight sgr
+                               (state (set) (list (set 'z)))
+                               (state (set) '()))
+                  (set (set)))
+    (check-equal? (edge-weight sgr
+                               (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
+                               (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))
+                  (set (set 'a 'b)))
+
+    (check-equal? sgr ip)
+
+    (check-equal? (build-interactive-process rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
+                  (list
+                   (list (set 'x) (set))
+                   (list (set 'y) (set 'y 'z))
+                   (list (set 'z) (set))
+                   (list (set) (set))
+                   (list (set 'z) (set))
+                   (list (set) (set))))))

scribblings/dds.scrbl

@@ -25,8 +25,4 @@ dds currently includes the following modules:
 @table-of-contents[]
 
 @include-section["utils.scrbl"]
-@include-section["functions.scrbl"]
-@include-section["dynamics.scrbl"]
-@include-section["networks.scrbl"]
-@include-section["tbn.scrbl"]
-@include-section["rs.scrbl"]
+@include-section["graph-typed.scrbl"]

scribblings/dynamics.scrbl

@@ -1,117 +0,0 @@
-#lang scribble/manual
-
-@(require scribble/example racket/sandbox
-	  (for-label "../dynamics.rkt" typed/racket/base
-	  	     (only-in racket/class object%)))
-
-@(define-syntax-rule (deftypeform . args)
-  (defform #:kind "type" . args))
-
-@(define-syntax-rule (deftype . args)
-  (defidform #:kind "polymorphic type" . args))
-
-@title[#:tag "dynamics"]{dds/dynamics: Dynamics of DDS}
-
-@defmodule[dds/dynamics]
-
-This module provides a number of general definitions for building and analyzing
-the dynamics of discrete dynamical systems.
-
-@defclass[dds% object% ()]{
-
-The abstract base class for discrete dynamical systems.
-
-This class has two type parameters:
-
-@itemize[
-
-@item{@racket[State] --- a state of the discrete dynamical system,}
-
-@item{@racket[Modality] --- a description of the way in which the discrete
-dynamical system transitions from a given state @italic{s} to another state
-@italic{s}.  For systems whose states are described by a set of variables,
-a @racket[Modality] is typically a list of variables updated during the
-state transition.}
-
-]
-
-@defmethod[(step [st State]) (Listof State)]{
-
-Given a state @racket[st], produces the next states of the state.
-
-This method falls back to calling @method[dds% step/annotated], and then
-discarding the annotations.
-
-}
-
-@defmethod[(step/annotated [st State]) (Listof (Pairof Modality State))]{
-
-Given a state, produces the next states paired with the corresponding
-modalities. Typical usage would include giving the information about the
-update mode.
-
-This method has no fallback and must be overridden.
-
-}
-
-@defmethod[(step* [sts (Listof State)]) (Listof State)]{
-
-Given a set of starting states, produce the set of states reachable in
-one step.
-
-This method falls back to running @method[dds% step] for all states.
-
-Note that @method[dds% step*] has no direct @tt{/annotated} counterpart.
-This is because producing a list of @racket[(Pairof Modality State)] would not
-give enough information to identify to which particular transition the modality
-corresponds to.
-
-}
-
-@defmethod[(build-state-graph [sts (Listof State)]) Graph]{
-
-Given a set of starting states, produces the state graph reachable from the
-starting states.
-
-This method falls back to exploring the state graph with @method[dds% step].
-
-}
-
-@defmethod[(build-state-graph/annotated [sts (Listof State)]) Graph]{
-
-Given a set of starting states, produces the labelled state graph reachable
-from the starting states.
-
-This method falls back to exploring the state graph with @method[dds%
-step/annotated].
-
-}
-
-@defmethod[(build-state-graph* [sts (Listof State)]
-			       [nsteps (U Positive-Integer 'full)])
-			       Graph]{
-
-Given a set of starting states and a number @racket[nsteps] of steps to run,
-produces the state graph reachable from the starting states @racket[nsteps]
-steps.  If @racket[nsteps] is @racket['full], constructs the full state
-graph instead.
-
-This method falls back to exploring the state graph with @method[dds% step].
-
-}
-
-@defmethod[(build-state-graph*/annotated [sts (Listof State)]
-					 [nsteps (U Positive-Integer 'full)])
-					 Graph]{
-
-Given a set of starting states and a number @racket[nsteps] of steps to run,
-produces the labelled state graph reachable from the starting states
-@racket[nsteps] steps.  If @racket[nsteps] is @racket['full], constructs the
-full state graph instead.
-
-This method falls back to exploring the state graph with @method[dds%
-step/annotated].
-
-}
-
-}

scribblings/functions.scrbl

@@ -1,20 +1,5 @@
 #lang scribble/manual
-@(require scribble/example racket/sandbox
-	  (for-label typed/racket/base "../functions.rkt" dds/utils
-	  	     typed/racket/unsafe
-		     (only-in racket stream->list stream-first)))
-
-@(define functions-evaluator
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 500])
-   (make-evaluator 'typed/racket #:requires '("functions.rkt"))))
-
-@(define-syntax-rule (ex . args)
-  (examples #:eval functions-evaluator . args))
-
-@(define-syntax-rule (deftype . args)
-  (defidform #:kind "type" . args))
+@(require (for-label racket "../functions.rkt" "../utils.rkt"))
 
 @title[#:tag "functions"]{dds/functions: Formal Functions}
 
@@ -25,707 +10,10 @@ This modules provides some definitions for working with functions: tabulating,
 Some definitions of particular kinds of functions are also provided (threshold
 Boolean functions, etc.).
 
-@section[#:tag "pseudovariadic"]{Pseudovariadic functions}
-
-Functions for @seclink["tabulating"]{tabulating functions} take as an argument
-a function to tabulate or a list of functions to tabulate.  Writing the type of
-such functions in Typed Racket and generalizing on the number of the arguments
-is hard, and using functions with such types seems even harder.
-The @seclink["tabulating"]{following section} contains some examples,
-illustrating among other things the difficulties of typing
-tabulating functions.
-
-The type of @racket[apply] does not help in this situation, because Typed
-Racket treats @racket[apply] in
-@hyperlink["https://racket.discourse.group/t/replicating-the-type-of-apply/770/3"]{a
-special way}.  This means that a user-defined function with the same type as
-@racket[apply] and directly calling it will not work in the same way.
-
-@ex[
-apply
-(define myapply apply)
-myapply
-(apply (λ (x y) (and x y)) '(#t #f))
-(eval:error (myapply (λ (x y) (and x y)) '(#t #f)))
-]
-
-One way to work around this issue is to write functions which disguise as
-variadic functions of type @racket[(-> a * b)], but which throw an exception
-when they receive a number of arguments different from a given constant value.
-Such functions are called @italic{pseudovariadic functions} in
-this documentation.
-
-@deftogether[(@defform[(pseudovariadic-lambda (id ...+) body ...+)]
-              @defform[(pvλ (id ...+) body ...+)])]{
-
-Define a pseudovariadic anonymous function.
-
-@ex[
-(: f (-> Boolean * Boolean))
-(define f (pseudovariadic-lambda (x y) (and x y)))
-(f #t #f)
-(eval:error (f #t #f #t))
-]}
-
-@deftogether[(@defform[(pseudovariadic-define (name id ...+) body ...+)]
-              @defform[(pvdefine (id ...+) body ...+)])]{
-
-Define a pseudovariadic function called @racket[name].
-
-@ex[
-(: g (-> Boolean * Boolean))
-(pseudovariadic-define (g x y) (and x y))
-(g #t #f)
-(eval:error (g #t #f #t))
-]}
-@section[#:tag "tabulating"]{Tabulating functions}
-
-@defproc[(tabulate [func (-> a ... b)]
-		   [doms (List (Listof a) ... a)])
-		   (Listof (Listof (U Any b)))]{
-
-Given a function @racket[func] and a list of domains @racket[doms] 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.
-
-@ex[
-(tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate/strict [func (-> a ... b)]
-		   	  [doms (List (Listof a) ... a)])
-		   	  (Listof (List (List a ...) (Listof b)))]{
-
-Like @racket[tabulate], but the types of the arguments of @racket[func]
-explicitly appear in the return type.
-
-As of 2022-03-06, I am not able to write the type of a list first containing
-elements of types @racket[a ...], followed by an element of type @racket[b].
-This is why this function returns a list of lists, each containing first a list
-of inputs, and then the output of @racket[func].
-
-@ex[
-(tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate/pv [func (-> a * b)]
-		      [doms (Listof (Listof a))])
-		      (Listof (Listof (U a b)))]{
-
-Like @racket[tabulate], but @racket[func]
-@seclink["pseudovariadic"]{pseudovariadic}.
-
-@ex[
-(tabulate/pv (pvλ (x y) (and x y)) '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate/list [func (-> (Listof a) b)]
-			[doms (Listof (Listof a))])
-			(Listof (Listof (U a b)))]{
-
-Like @racket[tabulate/list], but @racket[func] takes its arguments as a list.
-
-@ex[
-(tabulate/list (λ ([xs : (Listof Boolean)])
-                 (and (car xs) (car xs)))
-               '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate* [funcs (Listof (-> a ... b))]
-		    [doms (List (Listof a) ... a)])
-		    (Listof (Listof (U Any b)))]{
-
-Like @racket[tabulate], but @racket[funcs] is a list of functions taking the
-same arguments over the same domains.
-
-@ex[
-(tabulate* (list (λ (x y) (and x y))
-                 (λ (x y) (or x y)))
-           '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate*/strict [funcs (Listof (-> a ... b))]
-			   [doms (List (Listof a) ... a)])
-			   (Listof (List (List a ...) (Listof b)))]{
-
-Like @racket[tabulate*], but the types of the arguments of the functions
-explicitly appear in the return type.
-
-As of 2022-03-06, I am not able to write the type of a list first containing
-elements of types @racket[a ...], followed by a list of elements of type
-@racket[b].  This is why this function returns a list of lists, each containing
-first a list of inputs, and then the list of outputs of @racket[funcs].
-
-@ex[
-(tabulate*/strict (list (λ (x y) (and x y))
-                  	(λ (x y) (or x y)))
-           	   '((#f #t) (#f #t)))
-]
-
-The result of @racket[tabulate*] can be obtained by applying
-@racket[append-lists]:
-
-@ex[
-(require (only-in "utils.rkt" append-lists))
-(append-lists (tabulate*/strict (list (λ (x y) (and x y))
-                                      (λ (x y) (or x y)))
-                                '((#f #t) (#f #t))))
-]}
-
-@defproc[(tabulate*/pv [funcs (Listof (-> a * b))]
-		       [doms (Listof (Listof a))])
-		       (Listof (Listof (U a b)))]{
-
-Like @racket[tabulate*], but the functions in @racket[funcs]
-are @seclink["pseudovariadic"]{pseudovariadic}.
-
-@ex[
-(tabulate*/pv (list (pvλ (x y) (and x y))
-                    (pvλ (x y) (or x y)))
-              '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate*/list [funcs (Listof (-> (Listof a) b))]
-			 [doms (Listof (Listof a))])
-			 (Listof (Listof (U a b)))]{
-
-Like @racket[tabulate*], but the functions in @racket[funcs] take their
-arguments as a list.
-
-@ex[
-(tabulate*/list (list (λ ([xs : (Listof Boolean)])
-                        (and (car xs) (cadr xs)))
-                      (λ ([xs : (Listof Boolean)])
-                        (or (car xs) (cadr xs))))
-                '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate/pv/boolean [arity Positive-Integer] [func (-> Boolean * Boolean)])
-			      (Listof (Listof Boolean))]{
-
-Like @racket[tabulate/pv], but assumes the domains of all variables of the
-function are Boolean.  The arity of @racket[func] must be explicitly supplied.
-
-@ex[
-(tabulate/pv/boolean 2 (pvλ (x y) (and x y)))
-]
-
-Explicitly supplying the arity is necessary because the actual arity of
-a pseudovariadic function cannot be determined programmatically.  Note that
-@racket[tabulate] can be applied directly to a function, but the type of
-@racket[tabulate] requires a cast is required the domains argument
-@racket[doms].
-
-@ex[
-(tabulate (λ (x y) (and x y))
-          (cast (make-list 2 '(#f #t))
-                (List (Listof Boolean) (Listof Boolean))))
-]
-
-This cast is what makes it necessary to resort to pseudovariadic functions and
-explicit @racket[arity] to be able to write a type for
-@racket[tabulate/pv/boolean].
-
-See also @secref{fuctions/untyped} for simpler, but untyped version of
-this function.
-
-}
-
-@defproc[(tabulate*/pv/boolean [arity Positive-Integer]
-			       [func (Listof (-> Boolean * Boolean))])
-			       (Listof (Listof Boolean))]{
-
-Like @racket[tabulate/pv/boolean], but takes a list of functions of the
-same arity.
-
-@ex[
-(tabulate*/pv/boolean 2 (list (pvλ (x y) (and x y))
-                              (pvλ (x y) (or x y))))
-]}
-
-@defproc[(tabulate/pv/01 [arity Positive-Integer] [func (-> (U Zero One) * (U Zero One))])
-			 (Listof (Listof (U Zero One)))]{
-
-Like @racket[tabulate/pv], but assumes the domains of all variables of the
-function are @tt{{0,1}}.  The arity of @racket[func] must be
-explicitly supplied.
-
-@ex[
-(tabulate/pv/01 2 (pvλ (x y)
-                       (cast (modulo (+ x y) 2)
-                             (U Zero One))))
-]
-
-See @racket[tabulate/pv/boolean] for an explanation of the explicit
-@racket[arity] argument.
-
-}
-
-@defproc[(tabulate*/pv/01 [arity Positive-Integer]
-			  [func (Listof (-> (U Zero One) * (U Zero One)))])
-			  (Listof (Listof (U Zero One)))]{
-
-Like @racket[tabulate/pv/01], but takes a list of functions of the same arity.
-
-@ex[
-(tabulate*/pv/01 2 `(,(pvλ (x y) (cast (min x y) (U Zero One)))
-                     ,(pvλ (x y) (cast (max x y) (U Zero One)))))
-]}
-
-@defproc[(tabulate/list/boolean [arity Positive-Integer]
-				[func (-> (Listof Boolean) Boolean)])
-				(Listof (Listof Boolean))]{
-
-Like @racket[tabulate/list], but assumes the domains of all variables of the
-function are Boolean.
-
-@ex[
-(tabulate/list/boolean 2 (λ (xs) (and (car xs) (cadr xs))))
-]}
-
-@defproc[(tabulate*/list/boolean [arity Positive-Integer]
-				 [funcs (Listof (-> (Listof Boolean) Boolean))])
-				 (Listof (Listof Boolean))]{
-
-Like @racket[tabulate*/list], but assumes the domains of all variables of the
-function are Boolean.
-
-@ex[
-(tabulate*/list/boolean 2 (list (λ (xs) (and (car xs) (cadr xs)))
-                                (λ (xs) (or (car xs) (cadr xs)))))
-]}
-
-@defproc[(tabulate/list/01 [arity Positive-Integer]
-			   [func (-> (Listof (U Zero One)) (U Zero One))])
-			   (Listof (Listof (U Zero One)))]{
-
-Like @racket[tabulate/list], but assumes the domains of all variables of the
-function are @tt{{0,1}}.
-
-@ex[
-(tabulate/list/01 2 (λ (xs)
-                      (cast (modulo (+ (car xs) (cadr xs)) 2) (U Zero One))))
-]}
-
-@defproc[(tabulate*/list/01 [arity Positive-Integer]
-			    [funcs (Listof (-> (Listof (U Zero One)) (U Zero One)))])
-			    (Listof (Listof (U Zero One)))]{
-
-Like @racket[tabulate*/list], but assumes the domains of all variables of the
-function are @tt{{0,1}}.
-
-@ex[
-(tabulate*/list/01
- 2
- `(,(λ (xs) (cast (min (car xs) (cadr xs)) (U Zero One)))
-   ,(λ (xs) (cast (max (car xs) (cadr xs)) (U Zero One)))))
-]}
+@section{Tabulating functions}
 
 @section{Constructing functions}
 
-@defproc[(table->function/list [table (Listof (Listof a))])
-			       (-> (Listof a) a)]{
-
-Given a table like the one produced by the functions of the @racket[tabulate]
-family, creates a function which has this behaviour.
-
-More precisely, given a line of @racket[table] without its last element, the
-function returned by @racket[table->function/list] produces the corresponding
-last element.
-
-@ex[
-(define tab : (Listof (Listof Boolean))
-  '((#f #f #f)
-    (#f #t #f)
-    (#t #f #f)
-    (#t #t #t)))
-(define and/list (table->function/list tab))
-(and/list '(#f #t))
-(and/list '(#t #t))
-]}
-
-@defproc[(table->unary-function [table (Listof (List a b))])
-				(-> a b)]{
-
-Like @racket[table->function/list], but the @racket[table] contains
-exactly 2 columns: one column for the inputs and one column for the
-outputs, and the result is a unary function.
-
-@ex[
-(let ([unary-negation (table->unary-function '((#t #f) (#f #t)))])
-  (unary-negation #t))
-]}
-
-@defproc[(table->function [table (Listof (Listof a))])
-			  (-> a * a)]{
-
-Like @racket[table->function/list], but the resulting function takes a variable
-number of arguments rather than a list of values.
-
-@ex[
-(define my-and (table->function tab))
-(my-and #f #t)
-(my-and #t #t)
-]}
-
-@defproc[(table->function/pv [table (Listof (Listof a))])
-			     (-> a * a)]{
-
-Like @racket[table->function], but the resulting function raises an explicit
-error about invalid arity, instead of the @racket[hash-ref]-related error
-raised by the function returned by @racket[table->function].  In other words,
-the returned by @racket[table->function/pv] is
-@seclink["pseudovariadic"]{pseudovariadic}.
-
-@ex[
-(define my-and/pv (table->function/pv tab))
-(my-and/pv #f #t)
-(eval:error (my-and/pv #f))
-(eval:error (my-and #f))
-]}
-
-@defproc[(enumerate-boolean-tables [n Positive-Integer])
-				    (Sequenceof (Listof (Listof Boolean)))]{
-
-Returns the stream of the truth tables of all Boolean functions of
-arity @racket[n].
-
-There are @tt{2^(2^n)} Boolean functions of arity @racket[n].
-
-@ex[
-(require typed/racket/stream)
-(stream->list (enumerate-boolean-tables 1))
-]}
-
-@defproc[(enumerate-boolean-functions [n Positive-Integer])
-				      (Sequenceof (-> Boolean * Boolean))]{
-
-Returns the stream of all Boolean functions of a given arity @racket[n].
-
-There are @tt{2^(2^n)} Boolean functions of arity @racket[n].
-
-@ex[
-(length (stream->list (enumerate-boolean-functions 2)))
-]}
-
-@defproc[(enumerate-boolean-functions/pv [n Positive-Integer])
-					 (Sequenceof (-> Boolean * Boolean))]{
-
-Like @racket[enumerate-boolean-functions], but the returned functions are
-@seclink["pseudovariadic"]{pseudovariadic}.
-
-@ex[
-(define bool-f1/pv (stream-first (enumerate-boolean-functions/pv 2)))
-(bool-f1/pv #f #f)
-(eval:error (bool-f1/pv #f))
-]}
-
-@defproc[(enumerate-boolean-functions/list
-	  [n Positive-Integer])
-	  (Sequenceof (-> (Listof Boolean) Boolean))]{
-
-Like @racket[enumerate-boolean-functions], but the returned functions take
-their arguments as a single list.
-
-@ex[
-(define bool-f1/list (stream-first (enumerate-boolean-functions/list 2)))
-(bool-f1/list '(#f #f))
-]}
-
 @section{Random functions}
 
-@defproc[(random-boolean-table [n Positive-Integer]) (Listof (Listof Boolean))]{
-
-Generates a random truth table for a Boolean function of arity @racket[n].
-
-@ex[
-(random-boolean-table 2)
-]}
-
-@defproc[(random-boolean-function [n Positive-Integer]) (-> Boolean * Boolean)]{
-
-Generates a random Boolean function of arity @racket[n].
-
-@ex[
-(define random-bool-f (random-boolean-function 2))
-(random-bool-f #t #f)
-]}
-
-@defproc[(random-boolean-function/list [n Positive-Integer]) (-> (Listof Boolean) Boolean)]{
-
-Like @racket[random-boolean-function], but the constructed function takes
-a list of arguments.
-
-@ex[
-(define random-bool-f/list (random-boolean-function/list 2))
-(random-bool-f/list '(#t #f))
-]}
-
-@section[#:tag "tbf"]{Threshold Boolean functions}
-
-@defstruct*[tbf ([weights (Vectorof Real)] [threshold Real])]{
-
-A threshold Boolean function (TBF) is a pair @tt{(w, θ)}, where @tt{w} is
-a vector of weights and @tt{θ} is the threshold.
-
-Instances of @racket[tbf] have the type @racket[TBF].
-
-}
-
-@deftype[TBF]{
-
-The type of the instances of @racket[tbf]:
-
-@ex[
-(tbf #(1 2) 3)
-]}
-
-@deftogether[(@defproc[(tbf-w [t TBF]) (Vectorof Real)]
-              @defproc[(tbf-θ [t TBF]) Real])]{
-
-Shortcuts for @racket[tbf-weights] and @racket[tbf-threshold].
-
-}
-
-@defproc[(boolean->01/vector [bool-v (Vectorof Boolean)])
-			     (Vectorof (U Zero One))]{
-
-Converts a Boolean vector to a vector of zeros and ones.
-
-@ex[
-(boolean->01/vector #(#t #f #f))
-]}
-
-@defproc[(apply-tbf [t TBF] [inputs (Vectorof (U Zero One))]) (U Zero One)]{
-
-Applies the TBF to its inputs.
-
-Applying a TBF consists in multiplying the weights by the corresponding inputs
-and comparing the sum of the products to the threshold.  If the product is
-above the threshold, the function is 1, otherwise it is 0.
-
-@ex[
-(define simple-tbf (tbf #(2 -2) 1))
-(tabulate/pv/01 2 (pvλ (x y) (apply-tbf simple-tbf (vector x y))))
-]}
-
-@defproc[(apply-tbf/boolean [t TBF] [inputs (Vectorof Boolean)]) Boolean]{
-
-Like @racket[apply-tbf], but takes Boolean values as inputs and outputs
-a Boolean value.
-
-@ex[
-(define simple-tbf (tbf #(2 -2) 1))
-(tabulate/pv/boolean 2 (pvλ (x y) (apply-tbf/boolean simple-tbf (vector x y))))
-]}
-
-@defproc[(list->tbf [lst (Listof Real)]) TBF]{
-
-Converts a list of numbers to a TBF.  The last element of the list is taken to
-be the threshold, while the other elements are taken to be the weights.
-
-@ex[
-(list->tbf '(1 2 3))
-]}
-
-@defproc[(lists->tbfs [lsts (Listof (Listof Real))]) (Listof TBF)]{
-
-Converts multiple lists of numbers to a list of TBFs.
-
-The main use is for reading TBFs from Org-mode tables read by
-@racket[read-org-sexp].
-
-@ex[
-(lists->tbfs '((1 2 3) (2 3 4)))
-]}
-
-@defproc[(read-org-tbfs [str String] [#:headers headers Boolean #f])
-			(Listof TBF)]{
-
-Reads a list of TBF from an Org-mode string containing a sexp, containing
-a list of lists of numbers.  If headers is @racket[#t], drops the first list,
-supposing that it contains the headers of the table.
-
-The input is typically what @racket[read-org-sexp] reads.
-
-@ex[
-(read-org-tbfs "((1 2 1) (1 0 1))")
-(read-org-tbfs "((x y f) (1 2 1) (1 0 1))" #:headers #t)
-]}
-
-@defproc[(tbf-tabulate* [tbfs (Listof TBF)])
-			(Listof (Listof (U Zero One)))]{
-
-Tabulates a list of TBFs.
-
-The result is a list of lists describing the truth table of the given TBFs.
-The first elements of each line give the values of the inputs, while the last
-elements give the values of each the functions corresponding to the input.
-
-All the TBFs in @racket[tbfs] must have the same number of inputs as the first
-TBF in the list.
-
-@ex[
-(tbf-tabulate* (list (tbf #(2 2) 1) (tbf #(1 1) 1)))
-]}
-
-@defproc[(tbf-tabulate [t TBF])
-		       (Listof (Listof (U Zero One)))]{
-
-Tabulates a single TBF.
-
-@ex[
-(tbf-tabulate (tbf #(1 2) 1))
-]}
-
-@defproc[(tbf-tabulate*/boolean [tbfs (Listof TBF)])
-				(Listof (Listof Boolean))]{
-
-Tabulates a list of TBFs like @racket[tbf-tabulate*], but uses Boolean values
-@racket[#f] and @racket[#t] instead of 0 and 1.
-
-All the TBFs in @racket[tbfs] must have the same number of inputs as the first
-TBF in the list.
-
-@ex[
-(tbf-tabulate*/boolean (list (tbf #(1 2) 1)))
-]}
-
-@defproc[(sbf? [t TBF]) Boolean]{
-
-A sign Boolean function (SBF) is a TBF whose threshold is 0.
-
-@ex[
-(sbf? (tbf #(1 2) 3))
-(sbf? (tbf #(1 2) 0))
-]}
-
-@defproc[(sbf [w (Vectorof Real)]) TBF]{
-
-Creates a TBF which is an SBF from a vector of weights.
-
-@ex[
-(sbf #(1 -1))
-]}
-
-@defproc[(list->sbf [lst (Listof Real)])
-		    TBF]{
-
-Converts a list of numbers to an SBF.  The elements of the list are taken to be
-the weights of the SBF.
-
-@ex[
-(list->sbf '(1 -1))
-]}
-
-@defproc[(read-org-sbfs [str String] [#:headers headers Boolean #f])
-			(Listof TBF)]{
-
-Reads a list of SBF from an Org-mode string containing a sexp, containing
-a list of lists of numbers.  If headers is @racket[#t], drops the first list,
-supposing that it contains the headers of the table.
-
-The input is typically what @racket[read-org-sexp] reads.
-
-@ex[
-(read-org-sbfs "((1 1) (1 -1))")
-]
-
-See also @racket[read-org-tbfs].
-}
-@section[#:tag "fuctions/untyped"]{Untyped definitions}
-
-@defmodule[(submod dds/functions untyped)]
-
-@(require (for-label (only-in racket/contract/base listof any/c)
-	  (for-label (only-in (submod "../functions.rkt" untyped)
-	                      tabulate/boolean tabulate*/boolean
-			      tabulate/01 tabulate*/01))))
-
-This submodule contains some functions which cannot be typed or some functions
-for which Typed Racket cannot produce contracts, i.e. polymorphic functions of
-variable arity.  The definitions in this submodule specifically target untyped
-user code.
-
-Since the names of some of the definitions in this submodule are the same in
-the main module, and since they are imported in the same namespace for
-rendering this document, some references to untyped definitions may wrongfully
-point to typed definitions.  As a tentative fix, all such references are
-accompanied by the explicit mention "untyped".
-
-@(define functions-evaluator/untyped
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 50])
-   (make-evaluator 'racket #:requires '((submod "functions.rkt" untyped)))))
-
-@(define-syntax-rule (ex/untyped . args)
-  (examples #:eval functions-evaluator/untyped . args))
-
-@defproc[(tabulate [funcs procedure?]
-		   [doms (listof list?)])
-		   (listof list?)]{
-
-Given a function @racket[func] and a list of domains @racket[doms] 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.
-
-@ex/untyped[
-(tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate* [funcs (listof procedure?)]
-		    [doms (listof list?)])
-		    (listof list?)]{
-
-Like @racket[tabulate] (untyped), but @racket[funcs] is a list of functions
-taking the same arguments over the same domains.
-
-@ex/untyped[
-(tabulate* (list (λ (x y) (and x y))
-                 (λ (x y) (or x y)))
-           '((#f #t) (#f #t)))
-]}
-
-@defproc[(tabulate/boolean [func procedure?]) (listof (listof boolean?))]{
-
-Like @racket[tabulate] (untyped), but assumes the domains of all variables of
-the function are Boolean.  @racket[func] must have a fixed arity.  It is an
-error to supply a function of variable arity.
-
-@ex/untyped[
-(tabulate/boolean (lambda (x y) (and x y)))
-]}
-
-@defproc[(tabulate*/boolean [funcs (non-empty-listof procedure?)])
-			    (listof (listof boolean?))]{
-
-Like @racket[tabulate/boolean], but takes a list of functions of the
-same arity.
-
-@ex/untyped[
-(tabulate*/boolean `(,(λ (x y) (and x y))
-                     ,(λ (x y) (or x y))))
-]}
-
-@defproc[(tabulate/01 [func procedure?]) (listof (listof (or/c 0 1)))]{
-
-Like @racket[tabulate] (untyped), but assumes the domains of all variables of
-the function are @tt{{0,1}}.  @racket[func] must have a fixed arity.  It is an
-error to supply a function of variable arity.
-
-@ex/untyped[
-(tabulate/01 (λ (x y) (modulo (+ x y) 2)))
-]
-
-The same remarks apply as for @racket[tabulate/boolean] (untyped).
-
-}
-
-@defproc[(tabulate*/01 [funcs (listof procedure?)]) (listof (listof (or/c 0 1)))]{
-
-Like @racket[tabulate/01], but takes a list of functions of the same arity.
-
-@ex/untyped[
-(tabulate*/01 `(,(λ (x y) (min x y)) ,(λ (x y) (max x y))))
-]}
+@section{Threshold Boolean functions}

scribblings/graph-typed.scrbl

@@ -0,0 +1,19 @@
+#lang scribble/manual
+
+@title[#:tag "graph-typed"]{dds/graph-typed: Incomplete Typed Interface to graph}
+
+@defmodule[dds/graph-typed]
+
+@bold{DISCLAIMER:} This is @bold{not} a complete typed interface to Stephen
+Chang's @hyperlink["https://docs.racket-lang.org/graph/index.html"]{graph
+library}.  Read on for more details.
+
+Stephen Chang's
+@hyperlink["https://docs.racket-lang.org/graph/index.html"]{graph library} is
+used in dds to represent different kinds of graphs (state graphs, interaction
+graphs, graphs of interaction processes, etc.).  This module adds types to the
+functions which are used in dds.  These types do not necessarily capture the
+signatures of the functions entirely, and are mainly meant for internal use.
+I may eventually consider contributing something similar to Stephen Chang's
+library, but it would have to be a more polished product than this module is at
+the moment.

scribblings/networks.scrbl

@@ -1,28 +1,5 @@
 #lang scribble/manual
-@(require scribble/example racket/sandbox
-	  (for-label typed/racket/base
-	  	     graph
-		     (only-in typed/graph Graph)
-		     (only-in racket/class send)
-		     "../networks.rkt"
-		     "../utils.rkt"
-		     "../functions.rkt"
-		     "../dynamics.rkt"))
-
-@(define networks-evaluator
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 500])
-   (make-evaluator 'typed/racket #:requires '("networks.rkt"))))
-
-@(define-syntax-rule (ex . args)
-  (examples #:eval networks-evaluator . args))
-
-@(define-syntax-rule (deftypeform . args)
-  (defform #:kind "type" . args))
-
-@(define-syntax-rule (deftype . args)
-  (defidform #:kind "type" . args))
+@(require (for-label racket graph "../networks.rkt" "../utils.rkt" "../functions.rkt" racket/random racket/hash))
 
 @title[#:tag "networks"]{dds/networks: Formal Dynamical Networks}
 
@@ -33,914 +10,37 @@ is a set of variables which are updated according to their corresponding update
 functions.  The variables to be updated at each step are given by the mode.
 This model can generalise Boolean networks, TBANs, multivalued networks, etc.
 
-@section[#:tag "networks-basics"]{Basic types}
-
-@deftypeform[(State a)]{
-
-An immutable mapping (a hash table) assigning elements of type @racket[a] to
-the variables.  A synonym of @racket[VariableMapping].
-
-}
-
-@deftypeform[(UpdateFunction a)]{
-
-An update function is a function computing a value from the given
-state.  This is a synonym of the type @racket[(-> (State a) a)].
-
-}
-
-@deftypeform[(Domain a)]{
-
-A domain which is a subset of the type @racket[a].
-
-@racket[(Domain a)] is a synonym of @racket[(Listof a)].
-
-}
-
-@deftypeform[(DomainMapping a)]{
-
-A domain mapping is a hash table mapping variables to the lists of values in
-their domains.
-
-}
-
-@section{Common examples}
-
-The examples in this document often use the same definitions, which are
-therefore grouped here to avoid duplicating them.
-
-These are two functions calculating an @italic{AND} and an @italic{OR} between
-the variables @racket[a] and @racket[b]:
-
-@ex[
-(: or-func (UpdateFunction Boolean))
-(define (or-func s)
-  (or (hash-ref s 'a) (hash-ref s 'b)))
-
-(: and-func (UpdateFunction Boolean))
-(define (and-func s)
-  (and (hash-ref s 'a) (hash-ref s 'b)))
-]
-
-These are two functions calculating an @italic{AND} and an @italic{OR} between
-two variables @racket[a] and @racket[b] whose values are in @tt{{0,1}}:
-
-@ex[
-(require (only-in "utils.rkt" assert-type))
-
-(: or-func/01 (UpdateFunction (U Zero One)))
-(define (or-func/01 s)
-  (assert-type (max (hash-ref s 'a) (hash-ref s 'b))
-               (U Zero One)))
-
-(: and-func/01 (UpdateFunction (U Zero One)))
-(define (and-func/01 s)
-  (assert-type (min (hash-ref s 'a) (hash-ref s 'b))
-               (U Zero One)))
-]
-
-@section{Utilities}
-
-@defproc[(01->boolean/state [s (State (U Zero One))]) (State Boolean)]{
-
-Converts the values 0 and 1 in a state to @racket[#f] and
-@racket[#t] respectively.
-
-@ex[
-(01->boolean/state (hash 'a 0 'b 1))
-]}
-
-@defproc[(make-same-domains [vars (Listof Variable)]
-			    [domain (Domain a)])
-			    (DomainMapping a)]{
-
-Makes a hash set mapping all variables to a single domain.
-
-@ex[
-(make-same-domains '(a b) '(1 2))
-]}
-
-@defproc[(make-boolean-domains [vars (Listof Variable)])
-			       (DomainMapping Boolean)]{
-
-Makes a hash set mapping all variables to the Boolean domain.
-
-@ex[
-(make-boolean-domains '(a b))
-]}
-
-@defproc[(make-01-domains [vars (Listof Variable)])
-			  (DomainMapping (U Zero One))]{
-
-Makes a hash set mapping all variables to the Boolean domain, expressed as
-@tt{{0,1}}.
-
-@ex[
-(make-01-domains '(a b))
-]}
-
-@section{Networks}
-
-@defstruct*[network ([functions (VariableMapping (UpdateFunction a))]
-		     [domains (DomainMapping a)])]{
-
-A network consists of a mapping from its variables to its update variables, as
-a well as of a mapping from its variables to their domains.
-
-Instances of @racket[network] have the type @racket[Network].
-
-}
-
-@deftypeform[(Network a)]{
-
-The type of the instances of @racket[network].
-
-@ex[
-(network (hash 'a or-func
-               'b and-func)
-         (hash 'a '(#f #t)
-               'b '(#f #t)))
-]}
-
-@defproc[(make-boolean-network [funcs (VariableMapping (UpdateFunction Boolean))])
- 			       (Network Boolean)]{
-
-Builds a Boolean network from a given hash table assigning functions to
-variables by attributing Boolean domains to every variable.
-
-@ex[
-(make-boolean-network (hash 'a or-func 'b and-func))
-]}
-
-@defproc[(make-01-network [funcs (VariableMapping (UpdateFunction (U Zero One)))])
-			  (Network (U Zero One))]{
-
-Build a network from a given hash table assigning functions to variables by
-attributing the domain @tt{{0,1}} to every variable.
-
-@ex[
-(make-01-network (hash 'a or-func/01 'b and-func/01))
-]}
-
-@defproc[(update [network (Network a)] [s (State a)] [xs (Listof Variable)])
-		 (State a)]{
-
-Given a state @racket[s] updates all the variables of @racket[network] from
-@racket[xs].
-
-@ex[
-(update (make-boolean-network (hash 'a or-func 'b and-func))
-        (hash 'a #f 'b #t)
-	'(a))
-]}
+@section[#:tag "networks-basics"]{Basic definitions}
 
 @section{Syntactic description of networks}
 
-@deftype[UpdateFunctionForm]{
-
-An update function form is any form which can appear as a body of a function
-and which can be evaluated with @racket[eval].
-
-@ex[
-(ann '(and x y (not z)) UpdateFunctionForm)
-(ann '(+ 1 a (- b 10)) UpdateFunctionForm)
-]
-
-@racket[UpdateFunctionForm] is a synonym of @racket[Any].
-
-}
-
-@defstruct*[network-form ([functions (VariableMapping NetworkForm)]
-			  [domains (DomainMapping a)])]{
-
-A network form consists of a mapping from variables to the forms of their
-update functions, together with a mapping from its variables to its
-update functions.
-
-The domain mapping does not have to assign domains to all variables (e.g., it
-may be empty), but in this case the functions which need to know the domains
-will not work.
-
-Instances of @racket[network-form] have the type @racket[NetworkForm].
-
-}
-
-@deftypeform[(NetworkForm a)]{
-
-The type of instances of @racket[network-form].
-
-@ex[
-(network-form (hash 'a '(and a b) 'b '(or a b))
-              (hash 'a '(#f #t) 'b '(#f #t)))
-]}
-
-@defproc[(update-function-form->update-function/any [func UpdateFunctionForm])
-						    (UpdateFunction Any)]{
-
-Builds an update function from an update function form.
-
-@ex[
-(define and-from-form (update-function-form->update-function/any '(and x y)))
-(and-from-form (hash 'x #f 'y #f))
-(and-from-form (hash 'x #f 'y #t))
-(and-from-form (hash 'x #t 'y #f))
-(and-from-form (hash 'x #t 'y #t))
-]}
-
-@defproc[(update-function-form->update-function/boolean [func UpdateFunctionForm])
-						    	(UpdateFunction Boolean)]{
-
-Like @racket[update-function-form->update-function/any], but the resulting
-function operates on Boolean states.
-
-@ex[
-(define and-from-form/boolean (update-function-form->update-function/boolean '(and x y)))
-(and-from-form/boolean (hash 'x #f 'y #f))
-(and-from-form/boolean (hash 'x #f 'y #t))
-(and-from-form/boolean (hash 'x #t 'y #f))
-(and-from-form/boolean (hash 'x #t 'y #t))
-]}
-
-@defproc[(update-function-form->update-function/01 [func UpdateFunctionForm])
-						   (UpdateFunction (U Zero One))]{
-
-Like @racket[update-function-form->update-function/01], but the resulting
-function operates on Boolean states, with the domain @tt{{0,1}}.
-
-@ex[
-(define and-from-form/01 (update-function-form->update-function/01 '(min x y)))
-(and-from-form/01 (hash 'x 0 'y 0))
-(and-from-form/01 (hash 'x 0 'y 1))
-(and-from-form/01 (hash 'x 1 'y 0))
-(and-from-form/01 (hash 'x 1 'y 1))
-]}
-
-@defproc[(network-form->network/any [nf (NetworkForm Any)]) (Network Any)]{
-
-Builds a network from a network form.
-
-@ex[
-(network-form->network/any
- (network-form (hash 'a '(and a b)
-                     'b '(not b))
-               (hash 'a '(#f #t)
-                     'b '(#f #t))))
-]}
-
-@defproc[(network-form->network/boolean [nf (NetworkForm Boolean)]) (Network Boolean)]{
-
-Like @racket[network-form->network/any], but builds a Boolean network.
-
-@ex[
-(network-form->network/boolean
- (network-form (hash 'a '(and a b)
-                     'b '(not b))
-               (hash 'a '(#f #t)
-                     'b '(#f #t))))
-]}
-
-@defproc[(network-form->network/01 [nf (NetworkForm (U Zero One))]) (Network (U Zero One))]{
-
-Like @racket[network-form->network/any], but builds a Boolean network, whose
-domains are expressed as @tt{{0,1}}.
-
-@ex[
-(network-form->network/01
- (network-form (hash 'a '(min a b)
-                     'b '(- 1 b))
-               (hash 'a '(0 1)
-                     'b '(0 1))))
-]}
-
-@defproc[(make-boolean-network-form [forms (VariableMapping UpdateFunctionForm)])
-				    (NetworkForm Boolean)]{
-
-Build a Boolean network form from a given mapping assigning forms to variables.
-
-@ex[
-(make-boolean-network-form (hash 'a '(and a b)
-                                 'b '(not b)))
-]}
-
-@defproc[(forms->boolean-network [forms (VariableMapping UpdateFunctionForm)])
-				 (Network Boolean)]{
-
-Build a Boolean network from a given mapping assigning forms to variables.
-
-@ex[
-(forms->boolean-network (hash 'a '(and a b)
-                              'b '(not b)))
-]}
-
-@section{Dynamics of networks}
-
-This section contains definitions for building and analysing the dynamics
-of networks.
-
-@defproc[(build-all-states [vars-domains (DomainMapping a)])
-			   (Listof (State a))]{
-
-Given a @racket[DomainMapping], constructs the list of all possible states.
-
-@ex[
-(build-all-states (make-boolean-domains '(a b)))
-]}
-
-@defproc[(build-all-boolean-states [vars (Listof Variable)])
-				   (Listof (State Boolean))]{
-
-Builds all Boolean states over a given list of variables.
-
-@ex[
-(build-all-boolean-states '(a b))
-]}
-
-@defproc[(build-all-01-states [vars (Listof Variable)])
-			      (Listof (State Boolean))]{
-
-Builds all Boolean states over a given set of variables, but with the Boolean
-values represented as 0 and 1.
-
-@ex[
-(build-all-01-states '(a b))
-]}
-
-@deftype[Modality]{
-
-A modality is a list of variables.  This is a synonym of @racket[(Listof
-Variable)].
-
-}
-
-@deftype[Mode]{
-
-A mode is a list of modalities.  This is a synonym of @racket[(Listof Modality)].
-
-}
-
-@defclass[dynamics% dds% ()]{
-
-A model of dynamics of a network is a @racket[Network] with a @racket[Mode].
-
-@defconstructor[([network (Network a)] [mode Mode])]{
-
-Creates a new instance of @racket[dynamics%] from a @racket[network] and
-a @racket[mode].  Both are available as public fields of the class.
-
-}
-
-@defmethod[(step/annotated [st (State a)]) (Listof (Pairof Modality (State a)))]{
-
-Apply the network stored in this class to the state @racket[st] with all
-modalities of the mode stored in this class.
-
-This is the only method of @racket[dds%] overridden in this class.
-
-@ex[
-(let* ([n (forms->boolean-network (hash 'a '(and a b)
-                                        'b '(not b)))]
-       [syn '((a) (b))]
-       [syn-dynamics (new (inst dynamics% Boolean) [network n] [mode syn])]
-       [st (hash 'a #f 'b #f)])
-  (send syn-dynamics step/annotated st))
-]}}
-
-@deftypeform[(Dynamics% a)]{
-
-The type of an instance of @racket[dynamics%] with values of type @racket[a].
-
-@ex[
-(let* ([n (forms->boolean-network (hash 'a '(and a b)
-                                        'b '(not b)))]
-       [syn '((a) (b))]
-       [syn-dynamics (new (inst dynamics% Boolean) [network n] [mode syn])])
-  (ann syn-dynamics (Dynamics% Boolean)))
-]
-
-Note that, as of 2022-09-15, Typed Racket does not seem to allow to pass type
-parameters from a child class to a parent class.  Therefore, @racket[dynamics%]
-inherits in fact from a @racket[dds%] with its first type parameter set to
-@racket[(State Any)].  This can be seen by examining the type of
-@racket[dynamics%].
-
-@ex[dynamics%]
-
-The type constructor @racket[Dynamics%] takes this limitation into account.
-
-}
-
-@defproc[(make-asyn [vars (Listof Variable)]) Mode]{
-
-Given a list of variables, builds the asynchronous mode, i.e. a set of
-singleton sets of variables.
-
-@ex[(make-asyn '(x y z))]
-
-}
-
-@defproc[(make-syn [vars (Listof Variable)]) Mode]{
-
-Given a list of variables, builds the synchronous mode, i.e. a singleton set
-containing the set of all variables.
-
-@ex[(make-syn '(x y z))]
-
-}
-
-@defproc[(make-asyn-dynamics [network (Network a)]) (Dynamics% a)]{
-
-Creates the asynchronous dynamics for a given network: an instance of
-@racket[dynamics%] with @tt{network} as the network and the asynchronous
-mode as @tt{mode}.
-
-See @racket[build-full-state-graph/annotated] for an example.
-
-}
-
-@defproc[(make-syn-dynamics [network (Network a)]) (Dynamics% a)]{
-
-Creates the synchronous dynamics for a given network: an instance of
-@racket[dynamics%] with @tt{network} as the network and the synchronous mode as
-@tt{mode}.
-
-See @racket[build-full-state-graph] for an example.
-
-}
-
-@defproc[(build-full-state-graph [dyn (Dynamics% a)]) Graph]{
-
-Builds the full state graph of the given dynamics.
-
-@ex[
-(require (only-in "utils.rkt" dotit))
-
-(let* ([n (forms->boolean-network (hash 'a '(and a b)
-                                        'b '(not b)))]
-       [syn-dynamics (make-syn-dynamics n)])
-  (dotit ((inst build-full-state-graph Boolean) syn-dynamics)))
-]
-
-}
-
-@defproc[(build-full-state-graph/annotated [dyn (Dynamics% a)]) Graph]{
-
-Builds the full annotated state graph of the given dynamics.
-
-@ex[
-(require (only-in "utils.rkt" dotit))
-
-(let* ([n (forms->boolean-network (hash 'a '(and a b)
-                                        'b '(not b)))]
-       [asyn-dynamics (make-asyn-dynamics n)])
-  (dotit ((inst build-full-state-graph/annotated Boolean) asyn-dynamics)))
-]
-
-}
-
-@section[#:tag "networks_Pretty_printing"]{Pretty printing}
-
-This section defines various functions for nicely formatting node and edge
-labels in state graphs of networks.
-
-@defproc[(pretty-print-state [s (State a)]) String]{
-
-Pretty-prints a state of a network.
-
-@ex[(pretty-print-state (hash 'a #f 'b 3 'c 4))]
-
-}
-
-@defproc[(pretty-print-state/01 [s (State a)]) String]{
-
-Pretty-prints a state of a network, replacing all @racket[#f] values with 0 and
-all other values with 1.
-
-@ex[(pretty-print-state/01 (hash 'a #f 'b 3 'c '() 'd #t))]
-
-}
-
-@defproc[(pretty-print-state-graph-with [gr Graph] [pprinter (-> Any Any)]) Graph]{
-
-Given a state graph @racket[gr] and the pretty-printer for states
-@racket[pprinter], build a new state graph in which the nodes are
-pretty-printed with @racket[pprinter] and the edges with
-@racket[pretty-print-set-sets].
-
-}
-
-@defproc[(pretty-print-state-graph [gr Graph]) Graph]{
-
-Calls @racket[pretty-print-state-graph-with] with @racket[pretty-print-state].
-
-@ex[
-(let* ([n (forms->boolean-network (hash 'a '(and a b)
-                                        'b '(not b)))]
-       [syn-dynamics (make-syn-dynamics n)])
-  (dotit (pretty-print-state-graph
-          ((inst build-full-state-graph Boolean) syn-dynamics))))
-]
-
-}
-
-@defproc[(ppsg [gr Graph]) Graph]{
-
-A shortcut for @racket[pretty-print-state-graph].
-
-}
-
-@defproc[(pretty-print-state-graph/01 [gr Graph]) Graph]{
-
-Calls @racket[pretty-print-state-graph-with] with @racket[pretty-print-state/01].
-
-@ex[
-(let* ([n (forms->boolean-network (hash 'a '(and a b)
-                                        'b '(not b)))]
-       [syn-dynamics (make-syn-dynamics n)])
-  (dotit (pretty-print-state-graph/01
-          ((inst build-full-state-graph Boolean) syn-dynamics))))
-]
-
-}
-
-@defproc[(ppsg01 [gr Graph]) Graph]{
-
-A shortcut for @racket[pretty-print-state-graph/01].
-
-}
-
-
 @section{Inferring interaction graphs}
 
 This section provides inference of both unsigned and signed interaction graphs.
 Since the inference of signed interaction graphs is based on analysing the
 dynamics of the networks, it may be quite resource-consuming, especially since
-any syntactic forms are allowed in the definitions of the functions.
+I allow any syntactic forms in the definitions of the functions.
 
-We use the term @emph{syntactic interaction graph} to refer to the graph in
-which the presence of an arc from @tt{x} to @tt{y} is based on whether @tt{x}
-appears in the form of @tt{y}.  This is quite different from the canonical
-definition of the @emph{interaction graph}, in which the arc from @tt{x} to
-@tt{y} represents the fact that a change in the value of @tt{x} may lead to
-a change in the value of @tt{y}.  Thus the syntactic interaction graph may have
-extra arcs if @tt{x} appears in the form of @tt{y}, but has no actual influence
-on @tt{y}.
+Note the fine difference between @emph{syntactic} interaction graphs and
+interaction graphs generated from the dynamics of the network.
+Syntactic interaction graphs are based on the whether a variable appears or not
+in the form of the function for another variable.  On the other hand, the
+normal, conventional interaction graph records the fact that one variable has
+an impact on the dynamics of the other variable.  Depending on the model, these
+may or may not be the same.
 
-@defproc[(list-syntactic-interactions [nf (NetworkForm a)]
-				      [x Variable])
-				      (Listof Variable)]{
+@section{Dynamics of networks}
 
-Lists the variables of the network form appearing in the update function form
-for @racket[x].
-
-The variables which are not part of the network are excluded from the listing.
-
-@ex[
-(list-syntactic-interactions
- (make-boolean-network-form #hash((a . (+ a b))
-                                  (b . (- b))))
- 'a)
-(list-syntactic-interactions
- (make-boolean-network-form #hash((a . (+ a b c))
-                                  (b . (- b c))))
- 'a)
-]}
-
-@defproc[(build-syntactic-interaction-graph [n (NetworkForm a)])
-					    Graph]{
-
-Builds the graph in which the vertices are the variables of a given network,
-and which contains an arrow from @racket[x] to @racket[y] whenever @racket[x]
-appears in @racket[(list-interactions y)].
-
-@ex[
-(require (only-in "utils.rkt" dotit))
-(dotit (build-syntactic-interaction-graph
-        (make-boolean-network-form #hash((a . (+ a b))
-                                         (b . (- b))))))
-]}
-
-@defproc[(interaction? [network (Network a)]
-		       [x Variable]
-		       [y Variable])
-		       Boolean]{
-
-Given two variables @racket[x] and @racket[y] of a @racket[network], verifies
-if they interact, i.e. that there exists a pair of states @italic{s} and
-@italic{s'} with the following properties:
-
-@itemlist[
-@item{@italic{s} and @italic{s'} only differ in the value of @racket[x];}
-@item{running the network from @italic{s} and @italic{s'} yields different
-values for @racket[y].}
-]
-
-@ex[
-(let ([bn (forms->boolean-network #hash((a . (and a b))
-                                        (b . (not b))))])
-  (values (interaction? bn 'a 'b)
-          (interaction? bn 'b 'a)))
-]}
-
-@defproc[(get-interaction-sign [network (Network a)]
-			       [x Variable]
-			       [y Variable])
-			       (Option Integer)]{
-
-Given two variables @racket[x] and @racket[y] of @racket[network], checks
-whether they interact, and if they interact, returns 1 if increasing @racket[x]
-leads to an increase in @racket[y], -1 if it leads to a decrease in @racket[y],
-and 0 if it can lead to both.  If @racket[x] has no impact on @racket[y], returns @racket[#f].
-
-The values in the domains are ordered according to the order in which they are
-listed in @racket[network].
-
-Since @racket[get-interaction-sign] needs to check all possible interactions
-between @racket[x] and @racket[y], it is more costly than calling
-@racket[interaction?].
-
-@ex[
-(let ([bn (forms->boolean-network #hash((a . (and a b))
-                                        (b . (not b))))])
-  (values (get-interaction-sign bn 'a 'b)
-          (get-interaction-sign bn 'b 'a)
-          (get-interaction-sign bn 'b 'b)))
-]}
-
-@defproc[(build-interaction-graph [network (Network a)]) Graph]{
-
-Given a network, builds its interaction graph.  The graph has variables as
-nodes and has a directed edge from @italic{x} to @italic{y} if
-@racket[interaction?] returns @racket[#t] for these variables, in this order.
-
-@ex[
-(dotit (build-interaction-graph
-        (forms->boolean-network #hash((a . (and a b))
-                                      (b . (not b))))))
-]}
-
-@defproc[(build-interaction-graph/form [nf (NetworkForm a)]) Graph]{
-
-Like @racket[build-interaction-graph], but accepts a network form and
-converts it a to @racket[(Network a)] first.
-
-@ex[
-(dotit (build-interaction-graph/form
-        (make-boolean-network-form #hash((a . (and a b))
-                                         (b . (not b))))))
-]}
-
-@defproc[(build-signed-interaction-graph [network (Network a)]) Graph]{
-
-Given a network, builds its signed interaction graph.  The graph has variables
-as nodes and has a directed edge from @italic{x} to @racket{y} labelled by the
-value @racket[get-interaction-sign] produces for these variables, in that
-order, unless this value is @racket[#f].
-
-@ex[
-(dotit (build-signed-interaction-graph
-        (forms->boolean-network #hash((a . (and a b))
-                                      (b . (not b))))))
-]}
-
-@defproc[(build-signed-interaction-graph/form [nf (NetworkForm a)]) Graph]{
-
-Like @racket[build-signed-interaction-graph], but takes a network form and
-converts it to a network.
-
-@ex[
-(dotit (build-signed-interaction-graph/form
-        (make-boolean-network-form #hash((a . (and a b))
-                                         (b . (not b))))))
-]}
+This section contains definitions for building and analysing the dynamics
+of networks.
 
 @section{Tabulating functions and networks}
-@defproc[(tabulate-state* [funcs (Listof (-> (State a) a))]
-			  [domains (DomainMapping a)])
-			  (Listof (Listof a))]{
-
-Like @racket[tabulate*], but the functions operate on states.
-
-This function will produce a joint truth table of the given functions—a list of
-lists, in which the first columns list all possible combinations of the values
-of the input values, and the last columns give the corresponding values of the
-functions.  @racket[domains] defines the domains of each of the component of
-the states.
-
-@ex[
-(require (only-in "utils.rkt" λ/:))
-(tabulate-state* (list (λ/: (State Integer) (+ :a :b))
-                       (λ/: (State Integer) (- :a :b)))
-                 (hash 'a '(1 2) 'b '(2 3)))
-]}
-
-@defproc[(tabulate-state*+headers [funcs (Listof (-> (State a) a))]
-				  [domains (DomainMapping a)])
-				  (Pairof (Listof Symbol) (Listof (Listof a)))]{
-
-Like @racket[tabulate-state*], but the first line of the result lists the names
-of the variables and the functions.
-
-@ex[
-(tabulate-state*+headers (list (λ/: (State Integer) (+ :a :b))
-                               (λ/: (State Integer) (- :a :b)))
-                         (hash 'a '(1 2) 'b '(2 3)))
-]}
-
-@defproc[(tabulate-state*/boolean [funcs (Listof (-> State Boolean) Boolean)]
-				  [args (Listof Variable)])
-				  (Listof (Listof Boolean))]{
-
-Like @racket[tabulate-state*], but the functions operate on Boolean states.
-The list @racket[args] is used to generate all possible Boolean states
-containing the variables appearing on this list.
-
-@ex[
-(tabulate-state*/boolean (list (λ/: (State Boolean) (and :a :b))
-                               (λ/: (State Boolean) (or :a :b)))
-                         '(a b))
-]}
-
-@defproc[(tabulate-state*+headers/boolean
-		[funcs (Listof (-> State Boolean) Boolean)]
-		[args (Listof Variable)])
-		(Pairof (Listof Symbol) (Listof (Listof Boolean)))]{
-
-Like @racket[tabulate-state*+headers], but the functions operate on Boolean
-states, like @racket[tabulate-state*].
-
-@ex[
-(tabulate-state*+headers/boolean
- (list (λ/: (State Boolean) (and :a :b))
-       (λ/: (State Boolean) (or :a :b)))
- '(a b))
-]}
-
-@deftogether[(@defproc[(tabulate-state [func (-> (State a) a)]
-				       [domains (DomainMapping a)])
-			  	       (Listof (Listof a))]
-	      @defproc[(tabulate-state+headers
-			[func (-> (State a) a)]
-			[domains (DomainMapping a)])
-			(Pairof (Listof Symbol) (Listof (Listof a)))]
-              @defproc[(tabulate-state/boolean [func (-> (State Boolean) Boolean)]
-				  	       [args (Listof Variable)])
-				  	       (Listof (Listof Boolean))]
-              @defproc[(tabulate-state+headers/boolean
-			[func (-> (State Boolean) Boolean)]
-	   		[args (Listof Variable)])
-	  		(Pairof (Listof Symbol) (Listof (Listof Boolean)))])]{
-
-Like the starred versions @racket[tabulate-state*],
-@racket[tabulate-state*+headers], @racket[tabulate-state/boolean], and
-@racket[tabulate-state+headers/boolean], but only tabulate one
-function instead of a list.
-
-@ex[
-(tabulate-state
- (λ/: (State Boolean) (and :a :b))
- (hash 'a '(#f #t) 'b '(#f #t)))
-(tabulate-state+headers
- (λ/: (State Boolean) (and :a :b))
- (hash 'a '(#f #t) 'b '(#f #t)))
-(tabulate-state/boolean
- (λ/: (State Boolean) (and :a :b))
- '(a b))
-(tabulate-state+headers/boolean
- (λ/: (State Boolean) (and :a :b))
- '(a b))
-]}
-
-@defproc[(tabulate-network [network (Network a)]) (Listof (Listof a))]{
-
-Tabulates all the functions of @racket[network], producing an output
-similar to that of @racket[tabulate-state*].
-
-@ex[
-(tabulate-network (forms->boolean-network (hash 'a '(not a) 'b 'b)))
-]}
-
-@defproc[(tabulate-network+headers [network (Network a)]) (Listof (Listof a))]{
-
-Tabulates all the functions of @racket[network], producing an output
-similar to that of @racket[tabulate-state*+headers] , except that the
-function names in the corresponding column headers are of the form
-@tt{f-x}, where @tt{x} is the name of the corresponding variable.
-
-@ex[
-(tabulate-network+headers (forms->boolean-network (hash 'a '(not a) 'b 'b)))
-]}
 
 @section{Constructing functions and networks}
 
-@defproc[(table+vars->network [var-names (Listof Variable)]
-		              [table (Listof (Listof a))])
-			      (Network a)]{
-
-Given a @racket[table] like the one produced by
-@racket[tabulate-network] and the list of variable names
-@racket[var-names], constructs a network having this behaviour.
-
-The columns defining the functions are taken to be in the same order
-as the columns defining the variables.  The domains of the network are
-a mapping assigning to each variable the set of values which can
-appear in the corresponding column in the table.
-
-This function relies on @racket[table->unary-function], so the same
-performance caveats apply.
-
-This function does not check whether the table is complete.
-
-@ex[
-(let ([n (table+vars->network '(a b)
-                              '((#f #f #f #f)
-                                (#f #t #f #t)
-                                (#t #f #t #f)
-                                (#t #t #t #t)))])
-  (tabulate-network n))
-]}
-
-@defproc[(table->network [table (Listof (Listof a))]) (Network a)]{
-
-Like @racket[table+vars->network], but generates variable names as
-@tt{xi}, where 1 ≤ @tt{i} ≤ number of variables.
-
-@ex[
-(let ([n (table->network '((#f #f #f #f)
-                           (#f #t #f #t)
-                           (#t #f #t #f)
-                           (#t #t #t #t)))])
-  (network-domains n))
-]}
-
-@defproc[(table+headers->network [table (Pairof (Listof Symbol) (Listof (Listof a)))])
-				 (Network a)]{
-
-Like @racket[table+vars->network], but the variable names are taken
-from the first line of @racket[table].
-
-The lines of @racket[table] are taken to be of the same length, so it
-is assumed that half of the first line contain variable names, and the
-other half function names.  Function names are discarded.
-
-@ex[
-(let ([n (table+headers->network '((a b fa fb)
-                                   (#f #f #f #f)
-                                   (#f #t #f #t)
-                                   (#t #f #t #f)
-                                   (#t #t #t #t)))])
-  (network-domains n))
-]}
-
 @section{Random functions and networks}
 
-@defproc[(random-function/state [arg-domains (DomainMapping a)]
-				[func-doman (Domain a)])
-				(-> (State a) a)]{
+@section{TBF/TBN and SBF/SBN}
 
-Generates a random function accepting a state over the domains given
-by @racket[arg-domains] and producing values in @racket[func-domain].
-
-@ex[
-(let* ([doms (hash 'a '(1 2) 'b '(3 4))]
-       [f (random-function/state doms '(e f))])
-  (tabulate-state+headers f doms))
-]}
-
-@defproc[(random-boolean-function/state [args (Listof Variable)])
-					(-> (State a) a)]{
-
-Generates a random Boolean function accepting states over the
-variables in @racket[args].
-
-@ex[
-(tabulate-state+headers/boolean (random-boolean-function/state '(a b)) '(a b))
-]}
-
-@defproc[(random-network [domains (DomainMapping a)])
-			 (Network a)]{
-
-Generates a random network from the given domain mapping.
-
-@ex[
-(tabulate-network+headers (random-network (hash 'a '(1 2) 'b '(#f #t))))
-]}
-
-@defproc[(random-boolean-network [vars (Listof Variable)])
-				 (Network Boolean)]{
-
-Generates a random Boolean network with the given variables.
-
-@ex[
-(tabulate-network+headers (random-boolean-network '(x y z)))
-]}
-
-@defproc[(random-boolean-network/n [n Positive-Integer])
-				   (Network Boolean)]{
-
-Like @racket[random-boolean-network], but also generates the names of
-the variables for the network.  The variables have the names @tt{x0}
-to @tt{xk}, where @italic{k = n - 1}.
-
-@ex[
-(tabulate-network+headers (random-boolean-network/n 3))
-]}
+This section defines threshold Boolean functions (TBF) and networks (TBN), as
+well as sign Boolean functions (SBF) and networks (SBN).

scribblings/rs.scrbl

@@ -1,25 +1,5 @@
 #lang scribble/manual
-@(require scribble/example racket/sandbox
-	  (for-label typed/racket/base
-	  	     "../rs.rkt"
-		     "../utils.rkt"
-		     "../dynamics.rkt"))
-
-@(define rs-evaluator
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 500])
-   (make-evaluator 'typed/racket
-   		   #:requires '("rs.rkt" "utils.rkt"))))
-
-@(define-syntax-rule (ex . args)
-  (examples #:eval rs-evaluator . args))
-
-@(define-syntax-rule (deftypeform . args)
-  (defform #:kind "type" . args))
-
-@(define-syntax-rule (deftype . args)
-  (defidform #:kind "type" . args))
+@(require (for-label racket graph "../rs.rkt"))
 
 @title[#:tag "rs"]{dds/rs: Reaction Systems}
 
@@ -29,165 +9,11 @@ This module defines reaction systems and various tools for working with them.
 
 @section[#:tag "rs-basics"]{Basic definitions}
 
-@deftype[Species]{
-
-A synonym of @racket[Symbol].
-
-}
-
-@defstruct*[reaction ([reactants (Setof Species)]
-		      [inhibitors (Setof Species)]
-		      [products (Setof Species)])]{
-
-A reaction is a triple of sets, giving the reactants, the inhibitors,
-and the products, respectively.
-
-}
-
-@deftype[Reaction]{
-
-The type of the instances of @racket[reaction].
-
-}
-
-@deftype[ReactionName]{
-
-A reaction name is any @racket[Symbol].
-
-}
-
-@defproc[(make-reaction [r (Listof Reaction)]
-			[i (Listof Reaction)]
-			[p (Listof Reaction)])
-			Reaction]{
-
-A shortcut for constructing @racket[Reaction]s using list syntax
-instead of set syntax.
-
-@ex[
-(make-reaction '(a b) '(c d) '(e f))
-]}
-
-@defproc[(enabled? [r Reaction] [s (Setof Species)]) Boolean]{
-
-A @racket[Reaction] is enabled on a set of species if all of its
-reactants are in the set and none of its inhibitors are.
-
-@ex[
-(enabled? (make-reaction '(a b) '(c d) '())
-          (set 'a 'b 'e))
-(enabled? (make-reaction '(a b) '(c d) '())
-          (set 'a 'b 'c))
-(enabled? (make-reaction '(a b) '(c d) '())
-          (set 'b 'e))
-]}
-
-@deftype[ReactionSystem]{
-
-A reaction system is a dictionary mapping @racket[ReactionName]s to
-@racket[Reaction]s.
-
-}
-
-@defproc[(list-enabled [rs ReactionSystem] [s (Setof Species)])
-		       (Listof ReactionName)]{
-
-Returns the list of the names of reactions of @racket[rs] enabled on
-@racket[s].
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(z)))])
-  (values (list-enabled rs (set 'x 'y))
-          (list-enabled rs (set 'x))))
-]}
-
-@defproc[(union-products [rs ReactionSystem] [as (Listof ReactionName)])
-			 (Setof Species)]{
-
-Returns the union of the product sets of the given reactions listed in
-@racket[as] in @racket[rs].  If no reactions are supplied, returns the
-empty set.
-
-@ex[
-(union-products (hash 'a (make-reaction '(x) '(y) '(z))
-                      'b (make-reaction '(x y) '() '(z)))
-                '(a b))
-]}
-
-@defproc[(apply-rs [rs ReactionSystem] [s (Setof Species)])
-		   (Setof Species)]{
-
-Applies the reaction system @racket[rs] to @racket[s].
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(z)))])
-  (apply-rs rs (set 'x)))
-]}
-
-
 @section{Org-mode interaction}
 
 This section contains some useful primitives for
 @hyperlink["https://orgmode.org/"]{Org-mode} interoperability.
 
-@defproc[(str-triple->reaction [lst (List String String String)]) Reaction]{
-
-Converts a triple of strings to a reaction.
-
-@ex[
-(str-triple->reaction '("a b" "c d" "e f"))
-]}
-
-@defproc[(ht-str-triples->rs [ht (HashTable ReactionName (List String String String))])
-			     ReactionSystem]{
-
-Converts a hash table mapping reaction names to triples of strings to
-a reaction system.
-
-@ex[
-(ht-str-triples->rs (hash 'a (list "x y" "" "k i")
-                          'b (list "" "x y" "t j")))
-]}
-
-@defproc[(read-org-rs [str String]) ReactionSystem]{
-
-Reads a reaction system from an Org-mode style string.
-
-@ex[
-(read-org-rs "((\"a\" \"x t\" \"y\" \"z\") (\"b\" \"x\" \"q\" \"z\"))")
-]}
-
-@defproc[(read-context-sequence [str String]) (Listof (Setof Species))]{
-
-Reads a context sequence (a list of sets of species) from a string
-containing a list, which may be produced by Org-mode.
-
-@ex[
-(read-context-sequence "((\"x y\") (\"z\") (\"\") (\"t\"))")
-]}
-
-@defproc[(reaction->str-triple [r Reaction]) (Listof String)]{
-
-Converts a reaction to a triple of strings.
-
-@ex[
-(reaction->str-triple (make-reaction '(x y) '(z t) '(k i)))
-]}
-
-@defproc[(rs->ht-str-triples [rs ReactionSystem])
-			     (HashTable ReactionName (Listof String))]{
-
-Converts a reaction system to a hash table mapping
-@racket[ReactionNames]s to triples of strings.
-
-@ex[
-(rs->ht-str-triples (hash 'a (make-reaction '(x) '(y) '(z))
-                          'b (make-reaction '(x y) '() '(z))))
-]}
-
-
 @section{Dynamics of reaction systems}
 
 The dynamics of reaction systems is typically defined as @emph{interaction
@@ -197,177 +23,3 @@ system starts with the initial context.  Then, at every step, the result of
 applying the reaction system is merged with the next element of the context
 sequence, and the reaction system is then applied to the result of the union.
 If the sequence of contexts is empty, the reaction system cannot evolve.
-
-@defstruct*[state ([result (Setof Species)]
-		   [rest-contexts (Listof (Setof Species))])]{
-
-A state of a reaction system is a set of species representing the
-result of the application of the reactions from the previous steps
-(the field @racket[result]), plus the rest of the context sequence
-(the field @racket[rest-contexts]).
-
-The length of @racket[rest-contexts] dictates for how many steps the
-reaction system will be run.  If it is empty, no more reactions will
-be applied.
-
-}
-
-@deftype[State]{
-
-The type of the instances of @racket[state].
-
-}
-
-@defclass[dynamics% dds% ()]{
-
-A model of dynamics of a @racket[ReactionSystem].
-
-@defconstructor[([rs ReactionSystem])]{
-
-Constructs a model of dynamics for @racket[rs].
-
-}
-
-@defmethod[(step/annotated [s State]) (Listof (Pairof (Listof ReactionName) State))]{
-
-Runs the @racket[ReactionSystem] stored in this class on the given
-state and produces a list containing one pair, indicated the reactions
-enabled on @racket[s] and the @racket[State] resulting after applying
-these reactions.
-
-@ex[
-(let* ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                 'b (make-reaction '(x y) '() '(x)))]
-       [dyn (new dynamics% [rs rs])]
-       [s0 (state (set 'x 'y)
-                  (list (set) (set) (set 'x)))])
-  (send dyn step/annotated s0))
-]}
-
-}
-
-@deftype[Dynamics%]{
-
-The type of an instance of @racket[dynamics%].
-
-}
-
-@defproc[(build-interactive-process-graph [rs ReactionSystem]
-					  [contexts (Listof (Setof Species))])
-					  Graph]{
-
-Builds the state graph of the reaction system @racket[rs] driven by
-the context sequence @racket[contexts].
-
-This function directly calls @method[dds% build-state-graph/annotated]
-under the hood, and is actually a light interface on top of
-that function.
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(x)))]
-      [ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
-  (dotit (build-interactive-process-graph rs ctx)))
-]}
-
-@defproc[(build-interactive-process-graph/simple-states
-         [rs ReactionSystem]
-	 [contexts (Listof (Setof Species))])
-	 Graph]{
-
-Builds the state graph of the reaction system @racket[rs] driven by
-the context sequence @racket[contexts], like
-@racket[build-interactive-process-graph], but omits the context
-sequences from the states.
-
-@bold{Note:} If the reaction system visits the same set of species
-multiple times, all these visits will be conflated into a single node
-in the resulting graph.  The number or the order of visits will not be
-reflected in any way.
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(x)))]
-      [ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
-  (dotit (build-interactive-process-graph/simple-states rs ctx)))
-]}
-
-@defproc[(pretty-print-state-graph/simple-states [sgr Graph]) Graph]{
-
-Pretty prints the node and edge labels in a reaction system
-state graph with simple states.
-
-Simple states, as opposed to @racket[State], do not include the
-remaining context sequence.
-See @racket[build-interactive-process-graph/simple-states] for further
-explanations and examples.
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(x)))]
-      [ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
-  (dotit (pretty-print-state-graph/simple-states
-          (build-interactive-process-graph/simple-states rs ctx))))
-]}
-
-@defproc[(build-interactive-process [rs ReactionSystem]
-				    [ctx (Listof (Setof Species))])
-				    (Listof (Pairof (Setof Species) (Setof Species)))]{
-
-Builds the interactive process driven by the given context sequence.
-
-The output is a list of pairs of lists in which the first element is
-the current context and the second element is the result of the
-application of reactions to the previous state.  The interactive
-process stops one step after the end of the context sequence, to show
-the effect of the last context.
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(x)))]
-      [ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
-  (build-interactive-process rs ctx))
-]}
-
-@defproc[(build-interactive-process/org
-	  [rs ReactionSystem]
-	  [ctx (Listof (Setof Species))])
-	  (Listof (Listof (Setof Species)))]{
-
-Like @racket[build-interactive-process], but the type of a line of the
-output is @racket[(Listof (Setof Species))] instead of @racket[(Pairof
-(Setof Species) (Setof Species))].
-
-This function may be more practical for outputting directly to an
-Org-mode table.
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(x)))]
-      [ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
-  (build-interactive-process/org rs ctx))
-]}
-
-@defproc[(pretty-print-state [st State]) String]{
-
-Pretty prints the context sequence and the current result of
-@racket[st].
-
-@ex[
-(pretty-print-state (state (set 'x 'y) (list (set 'z) (set) (set 'x))))
-]}
-
-@defproc[(pretty-print-state-graph [sgr Graph]) Graph]{
-
-Pretty prints the state graph of a reaction system.
-
-Note that we need to keep the full context sequence in the name of
-each state to avoid confusion between the states at different steps of
-the evolution.
-
-@ex[
-(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
-                'b (make-reaction '(x y) '() '(x)))]
-      [ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
-  (dotit (pretty-print-state-graph (build-interactive-process-graph rs ctx))))
-]}

scribblings/tbn.scrbl

@@ -1,602 +0,0 @@
-#lang scribble/manual
-@(require scribble/example racket/sandbox
-	  (for-label typed/racket/base
-	  	     "../tbn.rkt"
-		     "../networks.rkt"
-		     "../utils.rkt"
-		     "../functions.rkt"
-		     "../dynamics.rkt"))
-
-@(define tbn-evaluator
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 500])
-   (make-evaluator 'typed/racket #:requires '("tbn.rkt"))))
-
-@(define-syntax-rule (ex . args)
-  (examples #:eval tbn-evaluator . args))
-
-@(define-syntax-rule (deftypeform . args)
-  (defform #:kind "type" . args))
-
-@(define-syntax-rule (deftype . args)
-  (defidform #:kind "type" . args))
-
-@title[#:tag "tbn"]{dds/tbn: Threshold and Sign Boolean Networks (TBN and SBN)}
-
-@defmodule[dds/tbn]
-
-@section{TBFs and states}
-
-This module defines threshold Boolean networks (TBN), as well as sign
-Boolean networks (SBN).  The update functions in such networks are
-respectively @seclink["tbf" #:doc '(lib
-"dds/scribblings/dds.scrbl")]{threshold Boolean functions} and sign
-Boolean functions.
-
-@defproc[(apply-tbf-to-state [a-tbf TBF] [st (State (U Zero One))])
-			     (U Zero One)]{
-
-Applies a TBF to a state.
-
-The values of the variables of the state are ordered by
-@racket[hash-map] and fed to the TBF in order.  The number of the
-inputs of the TBF must match the number of variables in the state.
-
-@ex[
-(require "functions.rkt")
-(apply-tbf-to-state (tbf #(1 1) 1) (hash 'x1 0 'x2 1))
-]}
-
-@defstruct*[tbf/state ([weights (VariableMapping Real)]
-		       [threshold Real])]{
-
-A state TBF is a @racket[TBF] with named inputs.  A state TBF can be
-applied to states in an unambiguous ways.
-
-}
-
-@deftype[TBF/State]{
-
-The type of the instances of @racket[tbf/state].
-
-}
-
-@deftogether[(@defproc[(tbf/state-w [tbfs TBF/State]) (VariableMapping Real)]
-	      @defproc[(tbf/state-θ [tbfs TBF/State]) Real])]{
-
-Shorter synonyms for field accessors of @racket[tbf/state].
-
-@ex[
-(let ([tbfs (tbf/state (hash 'a 1 'b 1) 1)])
-  (values (tbf/state-w tbfs)
-          (tbf/state-θ tbfs)))
-]}
-
-@defproc[(make-tbf/state [pairs (Listof (Pairof Variable Real))]
-			 [threshold Real])
-			 TBF/State]{
-
-Makes a @racket[TBF/State] from a list of pairs of names of variables
-and weights, as well as a threshold.
-
-@ex[
-(make-tbf/state '((x1 . 1) (x2 . 1)) 1)
-]}
-
-@defproc[(sbf/state? [tbfs TBF/State]) Boolean]{
-
-A state sign Boolean function (SBF) is a @racket[TBF/State] whose
-threshold is 0.
-
-@ex[
-(sbf/state? (tbf/state (hash 'a -1 'b 1) 0))
-(sbf/state? (tbf/state (hash 'a -1 'b 1) 1))
-]}
-
-@defproc[(apply-tbf/state [tbfs TBF/State]
-			  [st (State (U Zero One))])
-			  (U Zero One)]{
-
-Applies a @racket[TBF/State] to its inputs given by the state
-@racket[st].
-
-Applying a TBF consists in multiplying the weights by the
-corresponding inputs and comparing the sum of the products to
-the threshold.
-
-This function is similar to @racket[apply-tbf], but because it applies
-a @racket[TBF/State] to a @racket[(State (U Zero One))], it avoids
-potential mismatches between weights and the corresponding
-input values.
-
-@ex[
-(apply-tbf/state (tbf/state (hash 'a 2 'b -2) 1)
-                 (hash 'a 1 'b 0 'c 1))
-]}
-
-@defproc[(compact-tbf [tbf TBF/State]) TBF/State]{
-
-Compacts (and denormalizes) a TBF by removing all inputs which are 0.
-
-@ex[
-(compact-tbf (tbf/state (hash 'a 0 'b 1 'c 2 'd 0) 2))
-]}
-
-@section{Reading and printing TBFs and SBFs}
-
-@defproc[(lists+vars->tbfs/state [vars (Listof Variable)]
-				 [lsts (Listof (Listof Real))])
-				 (Listof TBF/State)]{
-
-Reads a list of @racket[TBF/State] from a list of list of
-@racket[Real]s.
-
-The last element of each list is taken to be the threshold of the
-TBFs, and the rest of the elements are taken to be the weights.
-
-@ex[
-(lists+vars->tbfs/state '(x y) '((1 2 3) (1 1 2)))
-]}
-
-@defproc[(lists+headers->tbfs/state [lsts+headers (Pairof (Listof Variable) (Listof (Listof Real)))])
-				    (Listof TBF/State)]{
-
-Like @racket[lists+vars->tbfs/state], but the names of the variables
-are taken from the first line of @racket[lsts+headers].
-
-All the lines in @racket[lsts+headers] are assumed to be of the same
-lenght, which means in particular that the last element of the first
-line (the threshold column) is discarded.
-
-@ex[
-(lists+headers->tbfs/state '((x y f) (1 2 3) (1 1 2)))
-]}
-
-@defproc[(lists->tbfs/state [lsts (Listof (Liostf Real))])
-			    (Listof TBF/State)]{
-
-Like @racket[lists+vars->tbfs/state], but the names of the variables
-are generated as @tt{xi}, where @italic{i} is the index of the
-variable, starting from 0.
-
-@ex[
-(lists->tbfs/state '((1 2 3) (1 1 2)))
-]}
-
-@defproc[(lists->tbfs/state/opt-headers
-	  [lsts (Listof (Listof (U Variable Real)))]
-	  [#:headers hdr Boolean])
-	  (Listof TBF/State)]{
-
-This function allows selecting between @racket[lists->tbfs/state] and
-@racket[lists+headers->tbfs/state] based on the value of @racket[hdr].
-If @racket[hdr] is @racket[#f], then @racket[lists->tbfs/state] is
-applied to @racket[lsts], otherwise @racket[lists+headers->tbfs/state]
-is applied.
-
-@ex[
-(lists->tbfs/state/opt-headers '((1 2 3) (1 1 2)) #:headers #f)
-(lists->tbfs/state/opt-headers '((x y f) (1 2 3) (1 1 2)) #:headers #t)
-]}
-
-@deftogether[(@defproc[(lists+vars->sbfs/state [vars (Listof Variable)]
-					       [lsts (Listof (Listof Real))])
-					       (Listof TBF/State)]
-	      @defproc[(lists+headers->sbfs/state
-			[lsts (Pairof (Listof Variable) (Listof (Listof Real)))])
-			(Listof TBF/State)]
-	      @defproc[(lists->sbfs/state [lsts (Listof (Listof Real))])
-	      				 (Listof TBF/State)])]{
-
-Like the corresponding TBF-related functions, but which create SBFs.
-In other words, the input lists are treated as lists of weights, and
-the thresholds are set to 0.
-
-@ex[
-(lists+vars->sbfs/state '(x y) '((1 2) (1 1)))
-(lists+headers->sbfs/state '((x y) (1 2) (1 1)))
-(lists->sbfs/state '((1 2) (1 1)))
-]}
-
-@defproc[(read-org-tbfs/state [str String]) (Listof TBF/State)]{
-
-Reads a list of @racket[TBF/State] from an Org-mode string containing
-a sexp, containing a list of lists of numbers.  As in
-@racket[lists->tbfs/state], the last element of each list is taken to
-be the threshold of the TBF, and the rest of the elements are taken to
-be the weights.
-
-Similarly to @racket[lists->tbfs/state], the names of the variables
-are generated as @tt{xi}, where @italic{i} is the index of the
-variable, starting from 0.
-
-@ex[
-(read-org-tbfs/state "((1 2 3) (1 1 2))")
-]}
-
-@defproc[(read-org-tbfs/state+headers [str String]) (Listof TBF/State)]{
-
-Like @racket[read-org-tbfs/state], but the first list in @racket[str]
-is taken to contain the names of the variables, similarly to
-@racket[lists+headers->tbfs/state].
-
-@ex[
-(read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))")
-]}
-
-@defproc[(tbfs/state->lists [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
-
-Given a list of @racket[TBF/State], produces a sexp that Org-mode can
-interpret as a table.
-
-All @racket[TBF/State] in the list must have the same inputs.
-The function does not check this property.
-
-@ex[
-(tbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 3)
-                         (tbf/state (hash 'a -2 'b 1) 1)))
-]}
-
-@defproc[(tbfs/state->lists+headers [tbfs (Listof TBF/State)])
-			       	    (Pairof (Listof Variable) (Listof (Listof Real)))]{
-
-Like @racket[tbfs/state->lists+headers], but the first list of the
-result is the list of input names of the first @racket[TBF/State] in
-@racket[tbfs].  The last element of this first list is @racket['θ] and
-corresponds to the column giving the thresholds of the TBFs.
-
-@ex[
-(tbfs/state->lists+headers
- (list (tbf/state (hash 'a 1 'b 2) 3)
-       (tbf/state (hash 'a -2 'b 1) 1)))
-]}
-
-@defproc[(sbfs/state->lists [sbfs (Listof TBF/State)])
-			    (Listof (Listof Real))]{
-
-Like @racket[tbfs/state->lists], but the thresholds are omitted.
-
-@ex[
-(sbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 0)
-                         (tbf/state (hash 'a -2 'b 1) 0)))
-]
-
-Note that this function just drops the threshold, without checking
-whether it is actually 0:
-
-@ex[
-(sbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 3)))
-]}
-
-@defproc[(sbfs/state->lists+headers [sbfs (Listof TBF/State)])
-				    (Pairof (Listof Variable) (Listof (Listof Real)))]{
-
-Like @racket[sbfs/state->lists], but also shows the names of the
-variables as column headers.
-
-@ex[
-(sbfs/state->lists+headers (list (tbf/state (hash 'a 1 'b 2) 0)
-                      	   	 (tbf/state (hash 'a -2 'b 1) 0)))
-]}
-
-@section{Tabulating TBFs and SBFs}
-
-@defproc[(tabulate-tbfs/state [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
-
-Tabulates a list of @racket[TBF/State].
-
-As in the case of @racket[tbf-tabulate*], the result is a list of
-lists giving the truth tables of the given TBFs.  The first elements
-of each row give the values of the inputs, while the last elements
-give the values of each function corresponding to the input.
-
-All the TBFs must have exactly the same inputs.  This function does
-not check this property.
-
-@ex[
-(tabulate-tbfs/state
- (list (tbf/state (hash 'a 1 'b 2) 2)
-       (tbf/state (hash 'a -2 'b 2) 1)))
-]}
-
-@defproc[(tabulate-tbfs/state+headers [tbfs (Listof TBF/State)])
-				      (Pairof (Listof Variable)
-				      	      (Listof (Listof Real)))]{
-
-Like @racket[tabulate-tbfs/state], but the first list of the result is
-a gives the names of the variables appearing in the inputs of
-@racket[(car tbfs)], followed by function names.  The function names
-are generated as @tt{fi}, where @tt{i} is the number of the TBF in
-the list.
-
-@ex[
-(tabulate-tbfs/state+headers
- (list (tbf/state (hash 'a 1 'b 2) 2)
-       (tbf/state (hash 'a -2 'b 2) 1)))
-]}
-
-@deftogether[(@defproc[(tabulate-tbf/state [tbf TBF/State])
-		       (Listof (Listof Real))]
-	      @defproc[(tabulate-tbf/state+headers [tbf TBF/State])
-	               (Pairof (Listof Variable) (Listof (Listof Real)))])]{
-
-Like @racket[tabulate-tbfs/state] and
-@racket[tabulate-tbfs/state+headers], but only tabulate single TBFs.
-
-@ex[
-(tabulate-tbf/state (tbf/state (hash 'a 1 'b 2) 2))
-(tabulate-tbf/state+headers (tbf/state (hash 'a 1 'b 2) 2))
-]}
-
-@section{TBNs and SBNs}
-
-@deftype[TBN]{
-
-The type of a TBN, i.e. a mapping assigning to each variable
-a @racket[TBF/State].
-
-}
-
-@defproc[(sbn? [tbn TBN]) Boolean]{
-
-A SBN is a @racket[TBN] in which all @racket[TBF/State]s satisfy
-@racket[sbf/state?].
-
-All functions in @racket[tbn] must only reference variables appearing
-in the network.  This function does not check this condition.
-
-@ex[
-(let ([f1 (tbf/state (hash 'a -1 'b 1) 0)]
-      [f2 (tbf/state (hash 'a -1 'b 1) 1)])
-  (values (sbn? (hash 'a f1 'b f1))
-          (sbn? (hash 'a f1 'b f2))))
-]}
-
-@defproc[(tbn->network [tbn TBN]) (Network (U Zero One))]{
-
-Constructs a @racket[Network] out of the given @racket[tbn].
-
-@ex[
-(require (only-in "networks.rkt" update))
-(let* ([tbn-form (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
-                       'b (tbf/state (hash 'a -1 'b 1) 1))]
-       [tbn (tbn->network tbn-form)]
-       [s (hash 'a 0 'b 1)])
-  (update tbn s '(a b)))
-]}
-
-@defproc[(build-tbn-state-graph [tbn TBN]) Graph]{
-
-Builds the state graph of a @racket[TBN].
-
-This function constructs a @racket[(Network (U Zero One))] from
-@racket[tbn], then builds the state graph of its synchronous dynamics,
-and pretty-prints the node labels.
-
-@ex[
-(require (only-in "utils.rkt" dotit))
-(dotit (build-tbn-state-graph
-        (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
-              'b (tbf/state (hash 'a -1 'b 1) 1))))
-]}
-
-@defproc[(normalized-tbn? [tbn TBN]) Boolean]{
-
-Checks whether @racket[tbn] is normalized: whether all of the
-functions have the same inputs, and whether these inputs are exactly
-the variables of @racket[tbn].
-
-@ex[
-(normalized-tbn?
- (hash 'x (tbf/state (hash 'x 0 'y -1) -1)
-       'y (tbf/state (hash 'x -1 'y 0) -1)))
-(normalized-tbn?
- (hash 'x (tbf/state (hash 'x 0 ) -1)
-       'y (tbf/state (hash 'y 0) -1)))
-]}
-
-@defproc[(normalize-tbn (tbn TBF)) TBN]{
-
-Normalizes @racket[tbn]: for every @racket[TBF/State], removes the
-inputs that are not in the variables of @racket[tbn], and adds missing
-inputs with 0 weight.
-
-@ex[
-(normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
-                     'y (tbf/state (hash 'y 3) 1)))
-]}
-
-@defproc[(compact-tbn [tbn TBN]) TBN]{
-
-Compacts the @racket[tbn] by removing all inputs which are 0 or which
-are not variables of the network.
-
-@ex[
-(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
-                   'b (tbf/state (hash 'a -1 'b 1) -1)))
-]}
-
-@defproc[(tbn-interaction-graph [tbn TBN]
-				[#:zero-edges zero-edges Boolean #t])
-				Graph]{
-
-Constructs the interaction graph of @racket[tbn].  The nodes of this
-graph are labeled with pairs (variable name, threshold), while the
-edges are labeled with the weights.
-
-If @racket[#:zero-edges] is @racket[#t], the edges with zero weights
-will also appear in the interaction graph.
-
-@ex[
-(dotit (tbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
-                                    'b (tbf/state (hash 'a -1) -1))))
-(dotit (tbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
-                                    'b (tbf/state (hash 'a -1) -1))
-                              #:zero-edges #f))
-]}
-
-@defproc[(pretty-print-tbn-interaction-graph [ig Graph]) Graph]{
-
-Pretty prints the node labels of the interaction graph of a TBN.
-
-@ex[
-(dotit (pretty-print-tbn-interaction-graph
-        (tbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
-                                     'b (tbf/state (hash 'a -1) -1)))))
-]}
-
-@defproc[(sbn-interaction-graph [sbn TBN]) Graph]{
-
-Constructs the interaction graph of @racket[sbn], like
-@racket[tbn-interaction-graph], but the nodes of the graph are labeled
-with variable names only.  This is an adaptation to SBNs, in which all
-weights are 0.  The function does not check whether @racket[sbn] is
-indeed an SBN.
-
-@ex[
-(dotit (sbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
-                                    'b (tbf/state (hash 'a -1) -1))))
-]}
-
-@section{Reading and printing TBNs and SBNs}
-
-@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
-			[#:headers headers Boolean #t]
-			[#:func-names func-names Boolean #t])
-			TBN]{
-
-Reads a TBN from a list of lists of numbers or symbols, which may
-represent an Org-mode table.  As in @racket[lists->tbfs/state], the
-last element of each list is taken to be the threshold of the TBF, and
-the rest of the elements are taken to be the weights.
-
-If @racket[headers] is @racket[#t], the names of the variables to
-appear as the inputs of the TBF are taken from the first list.
-The last element of this list (corresponding to the column giving the
-threshold) is discarded.  If @racket[headers] is @racket[#f], the
-names of the variables are generated as @tt{xi}, where @tt{i} is
-the index of the variable.
-
-If @racket[func-names] is @racket[#t], the first element in every row
-except the first one are taken to be the name of the variable to which
-the TBF should be associated.  If @racket[func-names] is @racket[#f],
-the functions are assigned to variables in lexicographic order.
-
-@racket[func-names] cannot be @racket[#t] if @racket[headers] is
-@racket[#f].  The function does not check this condition.
-
-This is a helper function for @racket[read-org-tbn] and
-@racket[read-org-sbn].
-
-@ex[
-(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
-(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
-(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t)
-]}
-
-@defproc[(read-org-tbn [str String]
-		       [#:headers headers Boolean #t]
-		       [#:func-names func-names Boolean #t])
-		       TBN]{
-
-Reads a TBN from an string containing a sexp, containing a list of
-lists of numbers and possibly symbols.  This string may be produced by
-Org-mode.
-
-As in @racket[lists->tbfs/state], the last element of each list is
-taken to be the threshold of the TBFs, and the rest of the elements
-are taken to be the weights.
-
-As in @racket[parse-org-tbn], if @racket[headers] is @racket[#t], the
-names of the variables to appear as the inputs of the TBF are taken
-from the first list.  The last element of this list is discarded.
-If @racket[headers] is @racket[#f], the names of the variables are
-generated as @tt{xi}, where @tt{i} is the index of the variable.
-
-If @racket[func-names] is @racket[#t], the first element in every row
-except the first one, are taken to be the name of the variable to
-which the TBF should be associated.  If @racket[func-names] is
-@racket[#f], the functions are assigned to variables in
-alphabetical order.
-
-As in @racket[parse-org-tbn], @racket[func-names] cannot be
-@racket[#t] if @racket[headers] is @racket[#f].  The function does not
-check this condition.
-
-@ex[
-(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
-]}
-
-@defproc[(read-org-sbn [str String]
-		       [#:headers headers Boolean #t]
-		       [#:func-names func-names Boolean #t])
-		       TBN]{
-
-Like @racket[read-org-tbn], but reads an SBN from the input string,
-i.e. all the numbers are taken to be the weights, and the threshold is
-set to 0.
-
-@ex[
-(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
-]}
-
-@defproc[(tbn->lists [tbn TBN]
-		     [#:headers headers Boolean #t]
-		     [#:func-names func-names Boolean #t])
-		     (Listof (Listof (U Symbol Real)))]{
-
-Given a @racket[tbn], produces a list of lists of numbers or symbols,
-containing the description of the functions of the TBN.  This list can
-be read back by @racket[parse-org-tbn], and Org-mode can interpret it
-as a table.
-
-Similarly to @racket[parse-org-tbn], if @racket[#:headers] is
-@racket[#f], this function does not print the names of the inputs of
-the TBFs.  If @racket[#:headers] is @racket[#t], the output starts by
-a list giving the names of the variables, as well as the symbol
-@racket['θ] to represent the column giving the thresholds of the TBF.
-If @racket[#:func-names] is @racket[#t], the first column of the table
-gives the name of the variable which the corresponding TBF updates.
-
-If both @racket[#:func-names] and @racket[#:headers] are @racket[#t],
-the first cell of the first column contains the symbol
-@racket['-].
-
-@ex[
-(tbn->lists (hash 'a (tbf/state (hash 'b 1) 0)
-                  'b (tbf/state (hash 'a -1) -1)))
-]}
-
-@defproc[(sbn->lists [sbn TBN]
-		     [#:headers headers Boolean #t]
-		     [#:func-names func-names Boolean #t])
-		     (Listof (Listof (U Symbol Real)))]{
-
-Like @racket[tbn->lists], but does not show the thresholds—an
-adaptation for printing SBNs.
-
-@ex[
-(sbn->lists (hash 'a (tbf/state (hash 'b 1) 0)
-                  'b (tbf/state (hash 'a -1) 0)))
-]}
-
-@section{Miscellaneous utilities}
-
-@defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])
-				   (Listof (Listof (Listof Integer)))]{
-
-Given the truth table @racket[tt] of a Boolean function, groups the
-lines by the @italic{N}umber of @italic{A}ctivated @italic{I}nputs—the
-number of inputs which are 1 in the input vector.
-
-@ex[
-(group-truth-table-by-nai '((0 0 0 1)
-                            (0 0 1 1)
-                            (0 1 0 0)
-                            (0 1 1 1)
-                            (1 0 0 0)
-                            (1 0 1 0)
-                            (1 1 0 1)
-                            (1 1 1 0)))
-]}

scribblings/utils.scrbl

@@ -1,26 +1,7 @@
 #lang scribble/manual
 @(require scribble/example racket/sandbox
-	  (for-label typed/racket/base graph
-	  	     "../utils.rkt"
-		     (only-in typed/graph Graph)
-		     (only-in racket/set set)
-		     (only-in racket/stream stream->list stream-take)
-		     (only-in typed/racket/class class super-new new send)))
-
-@(define utils-evaluator
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 500])
-   (make-evaluator 'typed/racket #:requires '("utils.rkt"))))
-
-@(define-syntax-rule (ex . args)
-  (examples #:eval utils-evaluator . args))
-
-@(define-syntax-rule (deftypeform . args)
-  (defform #:kind "type" . args))
-
-@(define-syntax-rule (deftype . args)
-  (defidform #:kind "polymorphic type" . args))
+	  (for-label typed/racket/base graph "../utils.rkt"
+	  	     (only-in racket/set set)))
 
 @title[#:tag "utils"]{dds/utils: Various Utilities}
 
@@ -30,104 +11,27 @@ This module defines miscellaneous utilities, supporting the other modules of
 the package: evaluating sexps, manipulating lists,
 @hyperlink["https://orgmode.org/"]{Org-mode} interoperability, etc.
 
-@section{Base types}
 
-@deftype[Variable]{
+@(define utils-evaluator
+  (parameterize ([sandbox-output 'string]
+  		 [sandbox-error-output 'string]
+		 [sandbox-memory-limit 50])
+   (make-evaluator 'typed/racket #:requires '("utils.rkt"))))
+
+@section{Base Types}
+@defidform[Variable]{
 
 Any Racket symbol.  Designates a variable in a discrete dynamical network.
 
 }
 
-@deftypeform[(VariableMapping A)]{
+@defform[(VariableMapping A)]{
 
 An immutable mapping (a hash table) assigning elements of type @racket[A] to
 the variables.
 
 }
 
-@defform[(NonemptyListof a)]{
-
-A @racket[(Listof a)] which contains at least one element.
-
-}
-
-@section{Type utilities}
-
-Typed Racket's @racket[cast] should only be used as a last resort, because it
-installs two contracts which may have a significant performance penalty.
-See
-@hyperlink["https://racket.discourse.group/t/managing-cast-performance-penalty/905"]{this
-discussion} for more details.  The best approach is to use
-@hyperlink["https://docs.racket-lang.org/ts-guide/occurrence-typing.html"]{occurrence
-typing} either via a direct @racket[if] check using a predicate, or using
-@racket[assert].
-
-@defform[(assert-type expr type)]{
-
-@racket[assert] that the type of @racket[expr] is @racket[type].
-
-@ex[
-(define some-number : Any 1)
-(assert-type some-number Integer)
-(assert-type some-number Positive-Integer)
-(eval:error (assert-type some-number Zero1))
-]}
-
-@deftogether[(@defform[(for/first/typed type-ann (for-clause ...) expr ...+)])
-              @defform[(for*/first/typed type-ann (for-clause ...) expr ...+)]]{
-
-Typed versions of @racket[for/first] and @racket[for*/first].
-
-@ex[
-(for/first/typed : (Option Integer)
-                 ([i (in-range 1 10)]
-                  #:when (zero? (modulo i 5)))
-  (* i 3))
-(for*/first/typed : (Option (Pairof Integer Integer))
-                  ([i (in-range 1 10)]
-                   [j (in-range 1 10)]
-                   #:when (> (+ i j) 5))
-  (cons i j))
-]
-
-The implementation of these macros is a simplified version the definition of
-@hyperlink["https://github.com/racket/typed-racket/blob/9d3264c97aa63b6a7163a219937b88a612add8ab/typed-racket-lib/typed-racket/base-env/prims.rkt#L512"]{@racket[define-for/acc:-variant]}.
-
-}
-
-@defform[(define/abstract/error method-name args ...)]{
-
-In a typed class, defines a public method @racket[method-name] with the
-arguments @racket[args] and with the body announcing that this method
-is abstract.
-
-@ex[
-(define my-abstract-class%
-  (class object%
-    (super-new)
-
-    (: abstract-increment (-> Integer Integer))
-    (define/abstract/error (abstract-increment x))))
-
-(define obj (new my-abstract-class%))
-(eval:error (send obj abstract-increment 1))
-]}
-
-@defform[(relax-arg-type/any name arg-type)]{
-
-Defines a unary anonymous function whose argument type is @racket[Any], and
-which calls @racket[name], with the argument coerced to @racket[arg-type].
-
-@ex[
-(relax-arg-type/any add1 Number)
-]
-
-The main use of this macro is to allow easily passing different one-argument
-functions as arguments of the type @racket[(-> Any Any)].  See for example
-@racket[update-graph].
-
-}
-
 @section{Hashtable injection}
 
 This section defines some utilities to streamline the usage of hash tables
@@ -139,7 +43,7 @@ explicit @racket[hash-ref] calls.
 Temporarily injects the mappings from the given hash table as bindings in
 a namespace including @racket[racket/base] and then evaluates the expression.
 
-@ex[
+@examples[#:eval utils-evaluator
 (let ([ht (hash 'a 1 'b 1)])
   (eval-with ht '(+ b a 1)))
 ]
@@ -148,7 +52,7 @@ The local bindings from the current lexical scope are not
 conserved.  Therefore, the following outputs an error about a
 missing identifier:
 
-@ex[
+@examples[#:eval utils-evaluator
 (eval:error
 (let ([ht (hash 'a 1 'b 1)]
       [z 1])
@@ -160,7 +64,7 @@ missing identifier:
 Like @racket[eval-with], but returns only the first value computed by
 @racket[expr].
 
-@ex[
+@examples[#:eval utils-evaluator
 (let ([ht (hash 'a 1 'b 1)])
   (eval1-with ht '(+ b a 1)))
 ]}
@@ -172,9 +76,9 @@ Given a @racket[VariableMapping] and a sequence of symbols, binds these symbols
 to the values they are associated with in the hash table, then puts the body in
 the context of these bindings.
 
-@ex[
-(define env #hash((a . 1) (b . 2)))
-(auto-hash-ref/explicit (env a b) (+ a (* 2 b)))
+@examples[#:eval utils-evaluator
+(let ([ht #hash((a . 1) (b . 2))])
+  (auto-hash-ref/explicit (ht a b) (+ a (* 2 b))))
 ]
 
 Note that only one expression can be supplied in the body.
@@ -188,9 +92,9 @@ Given an expression and a @racket[VariableMapping], looks up the symbols with
 a leading semicolon and binds them to the value they are associated with in the
 hash table.
 
-@ex[
-(define env #hash((a . 1) (b . 2)))
-(auto-hash-ref/: env (+ :a (* 2 :b)))
+@examples[#:eval utils-evaluator
+(let ([ht #hash((a . 1) (b . 2))])
+  (auto-hash-ref/: ht (+ :a (* 2 :b))))
 ]
 
 Thus the symbol @racket[:a] is matched to the key @racket['a] in the
@@ -200,39 +104,6 @@ Note that only one expression can be supplied in the body.
 
 }
 
-@deftogether[(@defform*[((lambda/: body) (lambda/: type body))]
-              @defform*[((λ/: body) (λ/: type body))])]{
-
-Defines an anonymous function with the body @racket[body], taking a hash table
-as an argument, and applying @racket[auto-hash-ref/:] to @racket[body] in the
-context of this hash table.
-
-@ex[
-(let ([ht (hash 'a 1 'b 2)])
-  ((λ/: (+ :a :b)) ht))
-]
-
-If the optional annotation @racket[type] is specified, the only argument of the
-resulting lambda will be of type @racket[type].
-
-@ex[
-(let ([ht (hash 'a 1 'b 2)])
-  ((λ/: (HashTable Symbol Natural) (+ :a :b)) ht))
-]}
-
-@defform*[((define/: name body)
-           (define/: name type body))]{
-
-A shortcut for @racket[(define name (lambda/: body))], with the optional
-type annotation.
-
-@ex[
-(let ([ht (hash 'a 1 'b 2)])
-  (: f (-> (HashTable Symbol Natural) Natural))
-  (define/: f (+ :a :b))
-  (f ht))
-]}
-
 @section{Analysis of quoted expressions}
 
 @defproc[(extract-symbols [form Any]) (Listof Symbol)]{
@@ -240,7 +111,7 @@ type annotation.
 Produces a list of symbols appearing in the quoted expression
 passed in the first argument.
 
-@ex[
+@examples[#:eval utils-evaluator
 (extract-symbols '(1 (2 3) x (y z 3)))
 ]
 
@@ -263,7 +134,7 @@ for examples of usage.
 Converts any value to string by calling @racket[display] on it and capturing
 the result in a string.
 
-@ex[
+@examples[#:eval utils-evaluator
 (any->string '(a 1 (x y)))
 ]}
 
@@ -271,7 +142,7 @@ the result in a string.
 
 Converts all the values of a @racket[VariableMapping] to string.
 
-@ex[
+@examples[#:eval utils-evaluator
 (stringify-variable-mapping (hash 'a '(and a b) 'b '(not b)))
 ]}
 
@@ -279,10 +150,11 @@ Converts all the values of a @racket[VariableMapping] to string.
 
 Reads any value from string.
 
-@ex[
+@examples[#:eval utils-evaluator
 (string->any "(or b (not a))")
 ]}
 
+
 @defproc[(map-sexp [func (-> Any Any)] [sexp Any]) Any]{
 
 Given a @racket[Sexp], applies the @racket[func] to any object which is not
@@ -292,7 +164,7 @@ a list.
 every non-list element of @racket[sexp].  If this is not the case, a contract
 violation for func will be generated.
 
-@ex[
+@examples[#:eval utils-evaluator
 (map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3))
 ]}
 
@@ -303,7 +175,7 @@ Reads a @racket[sexp] from a string produced by Org-mode for a named table.
 
 @racket[unorg] is a shortcut for @racket[read-org-sexp].
 
-@ex[
+@examples[#:eval utils-evaluator
 (unorg "(#t \"#t\" \"#t \" '(1 2 \"#f\"))")
 ]}
 
@@ -320,7 +192,7 @@ Given a list of pairs of strings and some other values (possibly strings),
 converts the first element of each pair to a string, and reads the second
 element with @racket[string->any] or keeps it as is if it is not a string.
 
-@ex[
+@examples[#:eval utils-evaluator
 (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))")))
 ]}
 
@@ -332,16 +204,22 @@ produces from tables.
 
 @racket[unorgv] is a synonym of @racket[read-org-variable-mapping].
 
-@ex[
+@examples[#:eval utils-evaluator
 (read-org-variable-mapping
   "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))")
 ]}
 
+@defproc[(dotit [graph Graph]) Void]{
+
+Typeset the graph via graphviz and display it.
+
+}
+
 @defproc[(read-symbol-list (str String)) (Listof Symbol)]{
 
 Reads a list of symbols from a string.
 
-@ex[
+@examples[#:eval utils-evaluator
 (read-symbol-list "a b c")
 ]}
 
@@ -351,7 +229,7 @@ Removes the first and the last symbol of a given string.
 
 Useful for removing the parentheses in string representations of lists.
 
-@ex[
+@examples[#:eval utils-evaluator
 (drop-first-last "(a b)")
 ]}
 
@@ -360,334 +238,47 @@ Useful for removing the parentheses in string representations of lists.
 Converts a list of sets of symbols to a list of strings containing
 those symbols.
 
-@ex[
+@examples[#:eval utils-evaluator
 (list-sets->list-strings (list (set 'x 'y) (set 'z) (set) (set 't)))
 ]}
 
-@section[#:tag "utils_Pretty_printing"]{Pretty printing}
+@section{Additional graph utilities}
 
-@defproc[(pretty-print-set [s (U (Setof Any) (Listof Any))]) String]{
+Apply a transformation to every vertex in the unweighted graph, return the new
+graph.  If the transformation function maps two vertices to the same values,
+these vertices will be merged in the resulting graph.  The transformation
+function may be called multiple times for the same vertex.
+
+This function does not rely on rename-vertex!, so it can be used to permute
+vertex labels.
+
+@section{Pretty printing}
+
+@defproc[(pretty-print-set (s (Setof Any))) String]{
 
 Pretty prints a set by listing its elements in alphabetic order.
 
-@ex[
+@examples[#:eval utils-evaluator
 (pretty-print-set (set 'a 'b 1))
-(pretty-print-set (list 'a 'b 1))
 ]}
 
-@defproc[(pretty-print-set-sets [ms (U (Listof (Setof Any)) (Setof (Setof Any)))])
-				String]{
+@defproc[(pretty-print-set-sets (ms (Setof (Setof Any)))) String]{
 
 Pretty-prints a set of sets of symbols.
 
 Typically used for pretty-printing the annotations on the edges of
 a state graph.
 
-@ex[
+@examples[#:eval utils-evaluator
 (pretty-print-set-sets (set (set 'a 'b) (set 'c)))
-(pretty-print-set-sets (list (set 'a 'b) (set 'c)))
-]}
-
-@section{Additional graph utilities}
-
-All examples in this section depend on @racket[typed/graph]:
-
-@ex[
-(require typed/graph)
-]
-
-@defproc[(dotit [graph Graph]) Void]{
-
-Typesets the graph via @racket[graphviz] and @racket[display]s it.
-
-@ex[
-(dotit (weighted-graph/directed '((1 a b) (2 b c))))
-]}
-
-@defproc[(update-vertices/unweighted [graph Graph] [func (-> Any Any)]) Graph]{
-
-Applies a transformation to every vertex in the unweighted graph and returns
-the new graph.
-
-If the transformation function maps two vertices to the same values, these
-vertices will be merged in the resulting graph.  The transformation function
-may be called multiple times for the same vertex.
-
-This function does not rely on @racket[rename-vertex!], so it can be used to
-permute vertex labels.
-
-@ex[
-(define g (directed-graph '((a b) (b c))))
-(define (double-labels [x : Any])
-  (define x-str (symbol->string (cast x Symbol)))
-  (string->symbol (string-append x-str x-str)))
-(dotit (update-vertices/unweighted g double-labels))
-]}
-
-@defproc[(update-graph [graph Graph]
-		       [#:v-func v-func (-> Any Any) identity]
-		       [#:e-func e-func (-> Any Any) identity])
-		       Graph]{
-
-Given a (directed) graph, apply the transformation @racket[v-func] to every
-vertex label and, if the graph is a weighted graph, the transformation
-@racket[e-func] to every edge label.  Both transformations default to identity
-functions.  If @racket[graph] is an weighted graph, the result is a weighted
-graph.  If @racket[graph] is an unweighted graph, the result is an
-unweighted graph.
-
-@ex[
-(define g (weighted-graph/directed '((10 a b) (11 b c))))
-(define (double-labels [x : Any])
-  (define x-str (symbol->string (cast x Symbol)))
-  (string->symbol (string-append x-str x-str)))
-(define (double-edges [x : Any])
-  (* 2 (cast x Number)))
-(dotit (update-graph g #:v-func double-labels #:e-func double-edges))
 ]}
 
 @section{Additional list and hash map utilities}
 
-@defproc[(collect-by-key [keys (Listof a)] [vals (Listof b)])
-			 (Values (Listof a) (Listof (Listof b)))]{
-
-Given a list of keys and the corresponding values, collects all the values
-associated to any given key and returns a list of keys without duplicates, and
-a list containing the corresponding list of values.
-
-If @racket[keys] can be treated as edges (i.e. pairs of vertices), the results
-produced by this function are suitable for graph constructors.
-
-@ex[
-(collect-by-key '(a b a) '(1 2 3))
-]}
-
-@defproc[(collect-by-key/sets [keys (Listof a)] [vals (Listof b)])
-			      (Values (Listof a) (Listof (Setof b)))]{
-
-Like @racket[collect-by-key], but produce a list of sets instead of a list
-of lists.
-
-@ex[
-(collect-by-key/sets '(a b a) '(1 2 3))
-]}
-
-@defproc[(ht-values/list->set [ht (HashTable a (Listof b))])
-			      (HashTable a (Setof b))]{
-
-Converts the values of a hash table from lists to sets.
-
-@ex[
-(ht-values/list->set #hash((a . (1 1))))
-]}
-
-@defproc[(hash->list/ordered [ht (HashTable a b)])
-			     (Listof (Pairof a b))]{
-
-
-Returns the key-value pairs of a given hash table in the order in which the
-hash table orders them for @racket[hash-map].
-
-@bold{TODO:} Remove after Typed Racket has caught up with Racket 8.4, in which
-@racket[hash->list] gets a new optional argument @racket[try-order?].
-
-@ex[
-(hash->list/ordered #hash((b . 1) (a . 1)))
-]}
-
-@defproc[(hash-replace-keys/ordered [ht (Immutable-HashTable (K1 V))]
-				    [new-keys (Listof K2)])
-				    (Immutable-HashTable K2 V)]{
-
-Replaces the keys in @racket[ht] by the keys in @racket[new-keys].
-
-The key-value pairs of the hash table @racket[ht] are processed in the
-order produced by @racket[hash-map] with @racket[#:try-order?] set to
-@racket[#t].
-
-@ex[
-(hash-replace-keys/ordered (hash 'a 1 'b 2) '(x y))
-]}
-
-@defproc[(multi-split-at [lists (Listof (Listof a))]
-			 [pos Integer])
-			 (Values (Listof (Listof a)) (Listof (Listof a)))]{
-
-Given a list of lists, splits every single list at the given position, and then
-returns two lists of lists: one consisting of the first halves, and the one
-consisting of the second halves.
-
-@ex[
-(multi-split-at '((1 2 3) (a b c)) 2)
-]}
-
-@defproc[(lists-transpose [lists (List (Listof a) ... a)])
-			  (Listof (List a ... a))]{
-
-Transposes a list of lists.  The length of the resulting list is the length of
-the shortest list in @racket[lists].
-
-This function is essentially @racket[in-parallel], wrapped in
-a couple conversions.
-
-@ex[
-(lists-transpose '((a b) (1 2)))
-(lists-transpose '((a b) (1 2 3) (#t)))
-]
-
-As of 2022-04-07, Typed Racket cannot convert the type of
-@racket[lists-transpose] to a contract.  The @seclink["utils/untyped"]{untyped
-submodule} provides a version of this function which can be used in
-untyped code.
-
-}
-
-@defproc[(append-lists [lsts (Listof (List (Listof a) (Listof a)))])
-		       (Listof (Listof a))]{
-
-@racket[lsts] is a list of rows, in which each row is split in two halves.
-The function returns the list of the same rows, with the two halves appended.
-
-@ex[
-(append-lists '(((1 2) (a b))
-                ((3 4) (c d))))
-]}
+@section{Functions and procedures}
 
 @section{Randomness}
 
-@defproc*[([(in-random) (Sequenceof Flonum)]
-	   [(in-random [k Integer]) (Sequenceof Nonnegative-Fixnum)]
-	   [(in-random [min Integer] [max Integer]) (Sequenceof Nonnegative-Fixnum)])]{
-
-Generates a stream of (inexact) random numbers.  The meaning of the arguments
-is the same as for the function @racket[random]:
-
-@itemlist[
-
-@item{@racket[(in-random)] — a stream of random inexact numbers between
-0 and 1,}
-
-@item{@racket[(in-random k)] — a stream of random exact integers in the range
-@racket[0] to @racket[k]-1.}
-
-@item{@racket[(in-random min max)] — a stream of random exact integers the
-range @racket[min] to @racket[max]-1.}
-
-]
-
-@ex[
-(require typed/racket/stream)
-(stream->list (stream-take (in-random) 5))
-(stream->list (stream-take (in-random 10) 5))
-(stream->list (stream-take (in-random 5 10) 5))
-]}
-
 @section{Additional stream utilities}
 
-@defproc[(cartesian-product-2/stream [s1 (Sequenceof a)]
-				     [s2 (Sequenceof b)])
-				     (Sequenceof (Pair a b))]{
-
-Generates a stream containing all the pairs of the elements from @racket[s1]
-and @racket[s2].  The elements of @racket[s2] are enumerated in order for every
-element of the @racket[s1], taken in order as well.
-
-@ex[
-(require typed/racket/stream)
-(stream->list (cartesian-product-2/stream (in-range 1 5) '(a b)))
-]
-
-The streams can be infinite.  If the second stream is infinite, only the first
-element of @racket[s1] will be enumerated.
-
-@ex[
-(stream->list (stream-take (cartesian-product-2/stream '(a b) (in-naturals)) 10))
-]}
-
-@defproc[(cartesian-product/stream [ss (Listof (Sequenceof a))])
-				   (Sequenceof (Listof a))]{
-
-Generates a stream containing all the elements of the Cartesian product between
-the streams of @racket[ss].
-
-This function relies on @racket[cartesian-product-2/stream] to build the
-Cartesian product, so it has the same properties with respect to the order in
-which the streams are enumerated.
-
-Union types can be used to build the Cartesian product of streams containing
-values of different types.
-
-@ex[
-(stream->list (cartesian-product/stream (list (in-range 3) (in-range 4 6) '(a b))))
-]}
-
 @section{Boolean operations}
-
-@defproc[(boolean-power [n Integer])
-			(Listof (Listof Boolean))]{
-
-Returns the @racket[n]-th Cartesian power of the Boolean domain.
-
-@ex[
-(boolean-power 2)
-]}
-
-@defproc[(boolean-power/stream [n Integer])
-			       (Sequenceof (Listof Boolean))]{
-
-Like @racket[boolean-power], but returns a stream.
-
-@ex[
-(stream->list (boolean-power/stream 2))
-]}
-
-@defproc[(any->01 [x Any]) (U Zero One)]{
-
-Converts any non-@racket[#f] value to 1 and @racket[#f] to 0.
-
-@ex[
-(any->01 #t)
-(any->01 #f)
-(any->01 'hello)
-]}
-
-@defproc[(01->boolean [x (U Zero One)]) Boolean]{
-
-Converts 0 to @racket[#f] and 1 to @racket[#t].
-
-@ex[
-(01->boolean 0)
-(01->boolean 1)
-]}
-
-@section[#:tag "utils/untyped"]{Untyped definitions}
-
-@defmodule[(submod dds/utils untyped)]
-
-@(require (for-label (only-in racket/contract/base listof any/c)))
-
-This submodule contains some functions whose types cannot be converted to
-contracts by Typed Racket.
-
-@(define utils-evaluator/untyped
-  (parameterize ([sandbox-output 'string]
-  		 [sandbox-error-output 'string]
-		 [sandbox-memory-limit 50])
-   (make-evaluator 'racket #:requires '((submod "utils.rkt" untyped)))))
-
-@(define-syntax-rule (ex/untyped . args)
-  (examples #:eval utils-evaluator/untyped . args))
-
-@defproc[(lists-transpose [lists (listof (listof any/c))])
-			  (listof (listof any/c))]{
-
-Transposes a list of lists.  The length of the resulting list is the length of
-the shortest list in @racket[lists].
-
-This function is essentially @racket[in-parallel], wrapped in
-a couple conversions.
-
-@ex/untyped[
-(lists-transpose '((a b) (1 2)))
-(lists-transpose '((a b) (1 2 3) (#t)))
-]}

tbn.rkt

@@ -1,715 +0,0 @@
-#lang typed/racket
-
-(require (except-in "utils.rkt" lists-transpose)
-         "utils.rkt" "functions.rkt" "networks.rkt"
-         typed/graph typed/racket/random)
-
-(require/typed racket/hash
-  [hash-intersect
-   (->* ((HashTable Variable Real))
-        (#:combine (-> Real Real Real))
-        #:rest (HashTable Variable Real)
-        (HashTable Variable Real))]
-  [(hash-intersect hash-intersect/tbn-tbf)
-   (->* ((HashTable Variable TBF/State))
-        (#:combine (-> TBF/State Real Real))
-        #:rest (HashTable Variable Real)
-        (HashTable Variable Real))]
-  [hash-union
-   (->* ((HashTable Variable Real))
-        (#:combine (-> Real Real Real))
-        #:rest (HashTable Variable Real)
-        (HashTable Variable Real))])
-
-(module+ test
-  (require typed/rackunit))
-
-(provide
- apply-tbf-to-state
-
- (struct-out tbf/state) TBF/State tbf/state-w tbf/state-θ make-tbf/state
- sbf/state? apply-tbf/state compact-tbf
-
- lists+vars->tbfs/state lists+headers->tbfs/state lists->tbfs/state
- lists+vars->sbfs/state lists+headers->sbfs/state lists->sbfs/state
- read-org-tbfs/state read-org-tbfs/state+headers
- tbfs/state->lists tbfs/state->lists+headers lists->tbfs/state/opt-headers
- sbfs/state->lists sbfs/state->lists+headers
-
- tabulate-tbfs/state tabulate-tbfs/state+headers
- tabulate-tbf/state tabulate-tbf/state+headers
-
- group-truth-table-by-nai
-
- TBN sbn? tbn->network
- build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
- tbn-interaction-graph pretty-print-tbn-interaction-graph
- sbn-interaction-graph
- parse-org-tbn read-org-tbn read-org-sbn tbn->lists sbn->lists
- )
-
-(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
-(define (apply-tbf-to-state tbf st)
-  (apply-tbf tbf (list->vector
-                  (hash-map st (λ (_ [val : (U Zero One)]) val) #t))))
-
-(module+ test
-  (test-case "apply-tbf-to-state"
-    (define st (hash 'x1 0 'x2 1))
-    (define f (tbf #(1 1) 1))
-    (check-equal? (apply-tbf-to-state f st) 0)))
-
-(struct tbf/state ([weights : (VariableMapping Real)]
-                   [threshold : Real])
-  #:transparent
-  #:type-name TBF/State)
-(define tbf/state-w tbf/state-weights)
-(define tbf/state-θ tbf/state-threshold)
-
-(: make-tbf/state (-> (Listof (Pairof Variable Real)) Real TBF/State))
-(define (make-tbf/state pairs threshold)
-  (tbf/state (make-immutable-hash pairs) threshold))
-
-(module+ test
-  (test-case "tbf/state"
-    (define f (make-tbf/state '((x1 . 1) (x2 . 1)) 1))
-    (check-equal? (tbf/state-w f) #hash((x1 . 1) (x2 . 1)))
-    (check-equal? (tbf/state-θ f) 1)))
-
-(: sbf/state? (-> TBF/State Boolean))
-(define (sbf/state? tbfs) (zero? (tbf/state-θ tbfs)))
-
-(module+ test
-  (test-case "sbf/state?"
-    (check-true (sbf/state? (tbf/state (hash 'a -1 'b 1) 0)))
-    (check-false (sbf/state? (tbf/state (hash 'a -1 'b 1) 1)))))
-
-(: apply-tbf/state (-> TBF/State (State (U Zero One)) (U Zero One)))
-(define (apply-tbf/state tbfs st)
-  (any->01
-   (> (apply + (hash-values (hash-intersect (tbf/state-w tbfs) st #:combine *)))
-      (tbf/state-θ tbfs))))
-
-(module+ test
-  (test-case "apply-tbf/state"
-    (define st1 (hash 'a 1 'b 0 'c 1))
-    (define st2 (hash 'a 1 'b 1 'c 0))
-    (define tbf (make-tbf/state '((a . 2) (b . -2)) 1))
-    (check-equal? (apply-tbf/state tbf st1) 1)
-    (check-equal? (apply-tbf/state tbf st2) 0)))
-
-(: compact-tbf (-> TBF/State TBF/State))
-(define (compact-tbf tbf)
-  (tbf/state
-   (for/hash : (VariableMapping Real)
-             ([(k v) (in-hash (tbf/state-w tbf))]
-              #:unless (zero? v))
-     (values k v))
-   (tbf/state-θ tbf)))
-
-(module+ test
-  (test-case "compact-tbf"
-    (check-equal? (compact-tbf (tbf/state (hash 'a 0 'b 1 'c 2 'd 0) 2))
-                  (tbf/state '#hash((b . 1) (c . 2)) 2))))
-
-(: lists+vars->tbfs/state (-> (Listof Variable) (Listof (Listof Real))
-                              (Listof TBF/State)))
-(define (lists+vars->tbfs/state vars lsts)
-  (for/list ([lst (in-list lsts)])
-    (define-values (ws θ) (split-at-right lst 1))
-    (make-tbf/state (for/list ([x (in-list vars)]
-                               [w (in-list ws)])
-                      (cons x w))
-                    (car θ))))
-
-(module+ test
-  (test-case "lists+vars->tbfs/state"
-    (check-equal? (lists+vars->tbfs/state '(x y) '((1 2 3) (1 1 2)))
-                  (list (tbf/state '#hash((x . 1) (y . 2)) 3)
-                        (tbf/state '#hash((x . 1) (y . 1)) 2)))))
-
-(: lists+headers->tbfs/state (-> (Pairof (Listof Variable) (Listof (Listof Real)))
-                                 (Listof TBF/State)))
-(define (lists+headers->tbfs/state lsts+headers)
-  (lists+vars->tbfs/state (drop-right (car lsts+headers) 1)
-                          (cdr lsts+headers)))
-
-(module+ test
-  (test-case "lists+headers->tbfs/state"
-    (check-equal? (lists+headers->tbfs/state '((x y f) (1 2 3) (1 1 2)))
-                  (list (tbf/state '#hash((x . 1) (y . 2)) 3)
-                        (tbf/state '#hash((x . 1) (y . 1)) 2)))))
-
-(: lists->tbfs/state (-> (Listof (Listof Real)) (Listof TBF/State)))
-(define (lists->tbfs/state lsts)
-  (lists+vars->tbfs/state
-   (for/list ([i (in-range (length (car lsts)))])
-     (string->symbol (format "x~a" i)))
-   lsts))
-
-(module+ test
-  (test-case "lists->tbfs/state"
-    (check-equal? (lists->tbfs/state '((1 2 3) (1 1 2)))
-                  (list (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
-                        (tbf/state '#hash((x0 . 1) (x1 . 1)) 2)))))
-
-(: lists->tbfs/state/opt-headers (-> (Listof (Listof (U Variable Real)))
-                                     #:headers Boolean
-                                     (Listof TBF/State)))
-(define (lists->tbfs/state/opt-headers lsts #:headers hdr)
-  (if hdr
-      (lists+headers->tbfs/state
-       (assert-type lsts (Pairof (Listof Variable) (Listof (Listof Real)))))
-      (lists->tbfs/state
-       (assert-type lsts (Listof (Listof Real))))))
-
-(module+ test
-  (test-case "lists->tbfs/state/opt-headers"
-    (check-equal?
-     (lists->tbfs/state/opt-headers '((1 2 3) (1 1 2)) #:headers #f)
-     (list (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
-           (tbf/state '#hash((x0 . 1) (x1 . 1)) 2)))
-    (check-equal?
-     (lists->tbfs/state/opt-headers '((x y f) (1 2 3) (1 1 2)) #:headers #t)
-     (list (tbf/state '#hash((x . 1) (y . 2)) 3)
-           (tbf/state '#hash((x . 1) (y . 1)) 2)))))
-
-(: lists+vars->sbfs/state (-> (Listof Variable) (Listof (Listof Real))
-                              (Listof TBF/State)))
-(define (lists+vars->sbfs/state vars lsts)
-  (for/list ([lst (in-list lsts)])
-    (make-tbf/state (map (inst cons Variable Real) vars lst) 0)))
-
-(module+ test
-  (test-case "lists+vars->sbfs/state"
-    (check-equal? (lists+vars->sbfs/state '(x y) '((1 2) (1 1)))
-                  (list (tbf/state '#hash((x . 1) (y . 2)) 0)
-                        (tbf/state '#hash((x . 1) (y . 1)) 0)))))
-
-(: lists+headers->sbfs/state (-> (Pairof (Listof Variable) (Listof (Listof Real)))
-                                 (Listof TBF/State)))
-(define (lists+headers->sbfs/state lsts)
-  (lists+vars->sbfs/state (car lsts) (cdr lsts)))
-
-(module+ test
-  (test-case "lists+headers->sbfs/state"
-    (check-equal? (lists+headers->sbfs/state '((x y) (1 2) (1 1)))
-                  (list (tbf/state '#hash((x . 1) (y . 2)) 0)
-                        (tbf/state '#hash((x . 1) (y . 1)) 0)))))
-
-(: lists->sbfs/state (-> (Listof (Listof Real)) (Listof TBF/State)))
-(define (lists->sbfs/state lsts)
-  (lists+vars->sbfs/state
-   (for/list ([i (in-range (length (car lsts)))])
-     (string->symbol (format "x~a" i)))
-   lsts))
-
-(module+ test
-  (test-case "lists->sbfs/state"
-    (check-equal? (lists->sbfs/state '((1 2) (1 1)))
-                  (list
-                   (tbf/state '#hash((x0 . 1) (x1 . 2)) 0)
-                   (tbf/state '#hash((x0 . 1) (x1 . 1)) 0)))))
-
-(: read-org-tbfs/state (-> String (Listof TBF/State)))
-(define (read-org-tbfs/state str)
-  (lists->tbfs/state
-   (assert-type (read-org-sexp str)
-                (Listof (Listof Real)))))
-
-(module+ test
-  (test-case "read-org-tbfs/state"
-    (check-equal? (read-org-tbfs/state "((1 2 3) (1 1 2))")
-                  (list (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
-                        (tbf/state '#hash((x0 . 1) (x1 . 1)) 2)))))
-
-(: read-org-tbfs/state+headers (-> String (Listof TBF/State)))
-(define (read-org-tbfs/state+headers str)
-  (lists+headers->tbfs/state
-   (assert-type (read-org-sexp str)
-                (Pairof (Listof Variable) (Listof (Listof Real))))))
-
-(module+ test
-  (test-case "read-org-tbfs/state+headers"
-    (check-equal? (read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))")
-                  (list (tbf/state '#hash((a . 1) (b . 2)) 3)
-                        (tbf/state '#hash((a . 1) (b . 1)) 2)))))
-
-(: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
-(define (tbfs/state->lists tbfs)
-  (for/list ([tbf (in-list tbfs)])
-    (append (hash-map (tbf/state-w tbf) (λ (_ [w : Real]) w) #t)
-            (list (tbf/state-θ tbf)))))
-
-(module+ test
-  (test-case "tbfs/state->lists"
-    (check-equal?
-     (tbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 3)
-                              (tbf/state (hash 'a -2 'b 1) 1)))
-     '((1 2 3) (-2 1 1)))))
-
-(: tbfs/state->lists+headers (-> (Listof TBF/State)
-                                 (Pairof (Listof Variable)
-                                         (Listof (Listof Real)))))
-(define (tbfs/state->lists+headers tbfs)
-  (cons (append (hash-map (tbf/state-w (car tbfs))
-                          (λ ([x : Symbol] _) x) #t)
-                '(θ))
-        (tbfs/state->lists tbfs)))
-
-(module+ test
-  (test-case "tbfs/state->list+headers"
-    (check-equal?
-     (tbfs/state->lists+headers (list (tbf/state (hash 'a 1 'b 2) 3)
-                                      (tbf/state (hash 'a -2 'b 1) 1)))
-     '((a b θ)
-       (1 2 3)
-       (-2 1 1)))))
-
-(: sbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
-(define (sbfs/state->lists tbfs)
-  (for/list ([tbf (in-list tbfs)])
-    (hash-map (tbf/state-w tbf) (λ (_ [w : Real]) w) #t)))
-
-(module+ test
-  (test-case "sbfs/state->lists"
-    (check-equal?
-     (sbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 0)
-                              (tbf/state (hash 'a -2 'b 1) 0)))
-     '((1 2) (-2 1)))))
-
-(: sbfs/state->lists+headers (-> (Listof TBF/State)
-                                 (Pairof (Listof Variable)
-                                         (Listof (Listof Real)))))
-(define (sbfs/state->lists+headers tbfs)
-  (cons (hash-map (tbf/state-w (car tbfs))
-                  (λ ([x : Symbol] _) x) #t)
-        (sbfs/state->lists tbfs)))
-
-(module+ test
-  (test-case "sbfs/state->list+headers"
-    (check-equal?
-     (sbfs/state->lists+headers (list (tbf/state (hash 'a 1 'b 2) 0)
-                                      (tbf/state (hash 'a -2 'b 1) 0)))
-     '((a b)
-       (1 2)
-       (-2 1)))))
-
-(: tabulate-tbfs/state (-> (Listof TBF/State) (Listof (Listof Real))))
-(define (tabulate-tbfs/state tbfs)
-  (define vars (hash-map (tbf/state-w (car tbfs)) (λ ([x : Variable] _) x) #t))
-  (tabulate-state* (map (curry apply-tbf/state) tbfs)
-                   (make-same-domains vars '(0 1))))
-
-(module+ test
-  (test-case "tabulate-tbfs/state"
-    (check-equal? (tabulate-tbfs/state
-                   (list (tbf/state (hash 'a 1 'b 2) 2)
-                         (tbf/state (hash 'a -2 'b 2) 1)))
-                  '((0 0 0 0)
-                    (0 1 0 1)
-                    (1 0 0 0)
-                    (1 1 1 0)))))
-
-(: tabulate-tbfs/state+headers (-> (Listof TBF/State) (Pairof (Listof Variable)
-                                                              (Listof (Listof Real)))))
-(define (tabulate-tbfs/state+headers tbfs)
-  (define vars (hash-map (tbf/state-w (car tbfs)) (λ ([x : Variable] _) x) #t))
-  (tabulate-state*+headers (map (curry apply-tbf/state) tbfs)
-                           (make-same-domains vars '(0 1))))
-
-(module+ test
-  (test-case "tabulate-tbfs/state+headers"
-    (check-equal? (tabulate-tbfs/state+headers
-                   (list (tbf/state (hash 'a 1 'b 2) 2)
-                         (tbf/state (hash 'a -2 'b 2) 1)))
-                  '((a b f1 f2)
-                    (0 0 0 0)
-                    (0 1 0 1)
-                    (1 0 0 0)
-                    (1 1 1 0)))))
-
-(: tabulate-tbf/state (-> TBF/State (Listof (Listof Real))))
-(define (tabulate-tbf/state tbf)
-  (tabulate-tbfs/state (list tbf)))
-
-(module+ test
-  (test-case "tabulate-tbf/state"
-    (check-equal? (tabulate-tbf/state (tbf/state (hash 'a 1 'b 2) 2))
-                  '((0 0 0)
-                    (0 1 0)
-                    (1 0 0)
-                    (1 1 1)))))
-
-(: tabulate-tbf/state+headers (-> TBF/State (Pairof (Listof Variable)
-                                                    (Listof (Listof Real)))))
-(define (tabulate-tbf/state+headers tbf)
-  (tabulate-tbfs/state+headers (list tbf)))
-
-(module+ test
-  (test-case "tabulate-tbf/state+headers"
-    (check-equal? (tabulate-tbf/state+headers (tbf/state (hash 'a 1 'b 2) 2))
-                  '((a b f1)
-                    (0 0 0)
-                    (0 1 0)
-                    (1 0 0)
-                    (1 1 1)))))
-
-(: group-truth-table-by-nai (-> (Listof (Listof Integer))
-                                (Listof (Listof (Listof Integer)))))
-(define (group-truth-table-by-nai tt)
-  (: sum (-> (Listof Integer) Integer))
-  (define (sum xs) (foldl + 0 xs))
-  (group-by (λ ([row : (Listof Integer)])
-              (drop-right row 1))
-            tt
-            (λ ([in1 : (Listof Integer)] [in2 : (Listof Integer)])
-              (= (sum in1) (sum in2)))))
-
-(module+ test
-  (test-case "group-truth-table-by-nai"
-    (check-equal? (group-truth-table-by-nai '((0 0 0 1)
-                                              (0 0 1 1)
-                                              (0 1 0 0)
-                                              (0 1 1 1)
-                                              (1 0 0 0)
-                                              (1 0 1 0)
-                                              (1 1 0 1)
-                                              (1 1 1 0)))
-                  '(((0 0 0 1))
-                    ((0 0 1 1) (0 1 0 0) (1 0 0 0))
-                    ((0 1 1 1) (1 0 1 0) (1 1 0 1))
-                    ((1 1 1 0))))))
-
-(define-type TBN (HashTable Variable TBF/State))
-
-(: sbn? (-> TBN Boolean))
-(define (sbn? tbn) (andmap sbf/state? (hash-values tbn)))
-
-(module+ test
-  (test-case "sbn?"
-    (define f1 (tbf/state (hash 'a -1 'b 1) 0))
-    (define f2 (tbf/state (hash 'a -1 'b 1) 1))
-    (check-true (sbn? (hash 'a f1 'b f1)))
-    (check-false (sbn? (hash 'a f1 'b f2))))
-  )
-
-(: tbn->network (-> TBN (Network (U Zero One))))
-(define (tbn->network tbn)
-  (make-01-network
-   (for/hash : (VariableMapping (UpdateFunction (U Zero One)))
-             ([(x tbfx) (in-hash tbn)])
-     (values x (λ ([s : (State (U Zero One))])
-                 (apply-tbf/state tbfx s))))))
-
-(module+ test
-  (test-case "tbn->network"
-    (define tbn-form (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
-                           'b (tbf/state (hash 'a -1 'b 1) 1)))
-    (define tbn (tbn->network tbn-form))
-    (define s (hash 'a 0 'b 1))
-    (check-equal? (update tbn s '(a b))
-                  #hash((a . 1) (b . 0)))
-    (check-equal? (network-domains tbn)
-                  #hash((a . (0 1)) (b . (0 1))))))
-
-(: build-tbn-state-graph (-> TBN Graph))
-(define (build-tbn-state-graph tbn)
-  (pretty-print-state-graph
-   ((inst build-full-state-graph (U Zero One))
-    ((inst make-syn-dynamics (U Zero One))
-     (tbn->network tbn)))))
-
-(module+ test
-  (test-case "build-tbn-state-graph"
-    (check-equal? (graphviz
-                   (build-tbn-state-graph
-                    (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
-                          'b (tbf/state (hash 'a -1 'b 1) 1))))
-                  "digraph G {\n\tnode0 [label=\"a:0 b:0\"];\n\tnode1 [label=\"a:1 b:1\"];\n\tnode2 [label=\"a:0 b:1\"];\n\tnode3 [label=\"a:1 b:0\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0 [];\n\t\tnode2 -> node3 [];\n\t\tnode3 -> node0 [];\n\t}\n}\n")))
-
-(: normalized-tbn? (-> TBN Boolean))
-(define (normalized-tbn? tbn)
-  (define tbn-vars (hash-keys tbn))
-  (for/and ([tbf (in-list (hash-values tbn))])
-    (set=? tbn-vars (hash-keys (tbf/state-w tbf)))))
-
-(module+ test
-  (test-case "normalized-tbn?"
-    (check-true (normalized-tbn?
-                 (hash 'x (tbf/state (hash 'x 0 'y -1) -1)
-                       'y (tbf/state (hash 'x -1 'y 0) -1))))
-    (check-false (normalized-tbn?
-                  (hash 'x (tbf/state (hash 'x 0 ) -1)
-                        'y (tbf/state (hash 'y 0) -1))))))
-
-(: normalize-tbn (-> TBN TBN))
-(define (normalize-tbn tbn)
-  (define vars-0 (for/hash : (VariableMapping Real)
-                           ([(x _) (in-hash tbn)])
-                   (values x 0)))
-  (: normalize-tbf (-> TBF/State TBF/State))
-  (define (normalize-tbf tbf)
-    ;; Only keep the inputs which are also the variables of tbn.
-    (define w-pruned (hash-intersect/tbn-tbf
-                      tbn
-                      (tbf/state-w tbf)
-                      #:combine (λ (_ w) w)))
-    ;; Put in the missing inputs with weight 0.
-    (define w-complete
-      (assert-type (hash-union vars-0 w-pruned #:combine (λ (_ w) w))
-                   (VariableMapping Real)))
-    (tbf/state w-complete (tbf/state-θ tbf)))
-  (for/hash : TBN ([(x tbf) (in-hash tbn)])
-    (values x (normalize-tbf tbf))))
-
-(module+ test
-  (test-case "normalize-tbn"
-    (check-equal? (normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
-                                       'y (tbf/state (hash 'y 3) 1)))
-                  (hash 'x (tbf/state (hash 'x 2 'y 0) -1)
-                        'y (tbf/state (hash 'x 0 'y 3) 1)))))
-
-(: compact-tbn (-> TBN TBN))
-(define (compact-tbn tbn)
-  (: remove-0-non-var (-> TBF/State TBF/State))
-  (define (remove-0-non-var tbf)
-    (tbf/state (for/hash : (VariableMapping Real)
-                         ([(x w) (in-hash (tbf/state-w tbf))]
-                          #:when (hash-has-key? tbn x)
-                          #:unless (zero? w))
-                 (values x w))
-               (tbf/state-θ tbf)))
-  (for/hash : TBN ([(x tbf) (in-hash tbn)])
-    (values x (remove-0-non-var tbf))))
-
-(module+ test
-  (test-case "compact-tbn"
-    (check-equal?
-     (compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
-                        'b (tbf/state (hash 'a -1 'b 1) -1)))
-     (hash
-      'a
-      (tbf/state '#hash((b . 1)) 0)
-      'b
-      (tbf/state '#hash((a . -1) (b . 1)) -1)))))
-
-(: tbn-interaction-graph (->* (TBN) (#:zero-edges Boolean) Graph))
-(define (tbn-interaction-graph tbn #:zero-edges [zero-edges #t])
-  (define ntbn (normalize-tbn tbn))
-  (define ig (weighted-graph/directed
-              (if zero-edges
-                  (for*/list : (Listof (List Real Variable Variable))
-                             ([(tar tbf) (in-hash ntbn)]
-                              [(src w) (in-hash (tbf/state-w tbf))])
-                    (list w src tar))
-                  (for*/list  : (Listof (List Real Variable Variable))
-                              ([(tar tbf) (in-hash ntbn)]
-                               [(src w) (in-hash (tbf/state-w tbf))]
-                               #:unless (zero? w))
-                    (list w src tar)))))
-  (update-graph
-   ig #:v-func (λ (x) (cons x (tbf/state-θ (hash-ref ntbn (assert-type x Variable)))))))
-
-(module+ test
-  (test-case "tbn-interaction-graph"
-    (define tbn (hash 'a (tbf/state (hash 'b 1) 0)
-                      'b (tbf/state (hash 'a -1) -1)))
-    (check-equal? (graphviz (tbn-interaction-graph tbn))
-                  "digraph G {\n\tnode0 [label=\"'(b . -1)\"];\n\tnode1 [label=\"'(a . 0)\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"0\"];\n\t\tnode1 -> node1 [label=\"0\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode1 -> node0 [label=\"-1\"];\n\t}\n}\n")
-    (check-equal? (graphviz (tbn-interaction-graph tbn #:zero-edges #f))
-                  "digraph G {\n\tnode0 [label=\"'(b . -1)\"];\n\tnode1 [label=\"'(a . 0)\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode1 -> node0 [label=\"-1\"];\n\t}\n}\n")))
-
-(: pretty-print-tbn-interaction-graph (-> Graph Graph))
-(define (pretty-print-tbn-interaction-graph ig)
-  (update-graph ig #:v-func (match-lambda
-                              [(cons var weight) (~a var ":" weight)])))
-
-(module+ test
-  (test-case "pretty-print-tbn-interaction-graph"
-    (define tbn (hash 'a (tbf/state (hash 'b 1) 0)
-                      'b (tbf/state (hash 'a -1) -1)))
-    (check-equal? (graphviz (pretty-print-tbn-interaction-graph
-                             (tbn-interaction-graph tbn)))
-                  "digraph G {\n\tnode0 [label=\"a:0\"];\n\tnode1 [label=\"b:-1\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"0\"];\n\t\tnode1 -> node1 [label=\"0\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"-1\"];\n\t\tnode1 -> node0 [label=\"1\"];\n\t}\n}\n")))
-
-(: sbn-interaction-graph (-> TBN Graph))
-(define (sbn-interaction-graph sbn #:zero-edges [zero-edges #t])
-  (update-graph (tbn-interaction-graph sbn #:zero-edges zero-edges)
-                #:v-func (match-lambda
-                           [(cons var _) var])))
-
-(module+ test
-  (test-case "sbn-interaction-graph"
-    (define sbn (hash 'a (tbf/state (hash 'b 2) 0)
-                      'b (tbf/state (hash 'a 2) 0)))
-    (check-equal? (graphviz (sbn-interaction-graph sbn))
-                  "digraph G {\n\tnode0 [label=\"a\"];\n\tnode1 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node1 [label=\"2\"];\n\t\tnode0 -> node0 [label=\"0\"];\n\t\tnode1 -> node1 [label=\"0\"];\n\t}\n\tsubgraph D {\n\t}\n}\n")))
-
-(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
-                      (#:headers Boolean
-                       #:func-names Boolean)
-                      TBN))
-(define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t])
-  (cond [func-names
-         (define-values (vars rows) (multi-split-at tab 1))
-         (define tbfs (lists->tbfs/state/opt-headers rows #:headers headers))
-         (for/hash : TBN
-                   ([tbf (in-list tbfs)]
-                    [var (in-list (cdr vars))])
-           (values (assert-type (car var) Variable) tbf))]
-        [else
-         (define tbfs (lists->tbfs/state/opt-headers tab #:headers headers))
-         (define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
-         (for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)])
-           (values (assert-type var Variable) tbf))]))
-
-(module+ test
-  (test-case "parse-org-tbn"
-    (check-equal?
-     (parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
-     (hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
-           'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1)))
-    (check-equal?
-     (parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
-     (hash
-      'a
-      (tbf/state '#hash((a . 1) (b . 2)) 3)
-      'b
-      (tbf/state '#hash((a . 3) (b . 2)) 1)))
-    (check-equal?
-     (parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3))
-                    #:headers #t
-                    #:func-names #t)
-     (hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3)
-           'b (tbf/state '#hash((a . 3) (b . 2)) 1)))))
-
-(: read-org-tbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
-(define (read-org-tbn str
-                      #:headers [headers #t]
-                      #:func-names [func-names #t])
-  (parse-org-tbn (assert-type (read-org-sexp str)
-                              (Listof (Listof (U Symbol Real))))
-                 #:headers headers
-                 #:func-names func-names))
-
-(module+ test
-  (test-case "read-org-tbn"
-    (check-equal?
-     (read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
-     (hash
-      'x
-      (tbf/state '#hash((x . 0) (y . -1)) -1)
-      'y
-      (tbf/state '#hash((x . -1) (y . 0)) -1)))
-    (check-equal?
-     (read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f)
-     (hash
-      'x
-      (tbf/state '#hash((x . -1) (y . 0)) -1)
-      'y
-      (tbf/state '#hash((x . 0) (y . -1)) -1)))
-    (check-equal?
-     (read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f)
-     (hash
-      'x0
-      (tbf/state '#hash((x0 . -1) (x1 . 0)) -1)
-      'x1
-      (tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
-
-(: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
-(define (read-org-sbn str
-                      #:headers [headers #t]
-                      #:func-names [func-names #t])
-  (define sexp (assert-type (read-org-sexp str)
-                            (Listof (Listof (U Symbol Real)))))
-  ;; Inject the 0 thresholds into the rows of the sexp we have just read.
-  (: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real)))))
-  (define (inject-0 rows)
-    (for/list : (Listof (Listof (U Symbol Real)))
-              ([row (in-list rows)]) (append row '(0))))
-  (define sexp-ready (if headers
-                         (cons (append (car sexp) '(θ)) (inject-0 (cdr sexp)))
-                         (inject-0 sexp)))
-  (parse-org-tbn sexp-ready #:headers headers #:func-names func-names))
-
-(module+ test
-  (test-case "read-org-sbn"
-    (check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
-                  (hash
-                   'x
-                   (tbf/state '#hash((x . 0) (y . -1)) 0)
-                   'y
-                   (tbf/state '#hash((x . -1) (y . 0)) 0)))
-    (check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f)
-                  (hash
-                   'x
-                   (tbf/state '#hash((x . -1) (y . 0)) 0)
-                   'y
-                   (tbf/state '#hash((x . 0) (y . -1)) 0)))
-    (check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f)
-                  (hash
-                   'x0
-                   (tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
-                   'x1
-                   (tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
-
-(: tbn->lists (->* (TBN) (#:headers Boolean
-                          #:func-names Boolean)
-                   (Listof (Listof (U Symbol Real)))))
-(define (tbn->lists tbn
-                    #:headers [headers #t]
-                    #:func-names [func-names #t])
-  (define ntbn (normalize-tbn tbn))
-  (define vars-tbfs (hash-map ntbn (λ ([x : Variable] [tbf : TBF/State])
-                                     (cons x tbf)) #t))
-  (define tbfs (map (inst cdr Variable TBF/State) vars-tbfs))
-  (define tbfs-table ((if headers
-                          tbfs/state->lists+headers
-                          tbfs/state->lists) tbfs))
-  (cond
-    [(eq? func-names #t)
-     (define vars (map (inst car Variable TBF/State) vars-tbfs))
-     (define col-1 (if headers (cons '- vars) vars))
-     (for/list ([var (in-list col-1)] [row (in-list tbfs-table)])
-       (cons var row))]
-    [else
-     tbfs-table]))
-
-(module+ test
-  (test-case "tbn->lists"
-    (define tbn (hash 'a (tbf/state (hash 'b 1) 0)
-                      'b (tbf/state (hash 'a -1) -1)))
-    (check-equal? (tbn->lists tbn)
-                  '((- a b θ) (a 0 1 0) (b -1 0 -1)))
-    (check-equal? (tbn->lists tbn #:headers #f)
-                  '((a 0 1 0) (b -1 0 -1)))
-    (check-equal? (tbn->lists tbn #:func-names #f)
-                  '((a b θ) (0 1 0) (-1 0 -1)))
-    (check-equal? (tbn->lists tbn #:headers #f #:func-names #f)
-                  '((0 1 0) (-1 0 -1)))))
-
-(: sbn->lists (->* (TBN) (#:headers Boolean
-                          #:func-names Boolean)
-                   (Listof (Listof (U Symbol Real)))))
-(define (sbn->lists sbn
-                    #:headers [headers #t]
-                    #:func-names [func-names #t])
-  (define tab (tbn->lists sbn #:headers headers #:func-names func-names))
-  (define-values (tab-no-θ _)
-    (multi-split-at tab (sub1 (length (car tab)))))
-  tab-no-θ)
-
-(module+ test
-  (test-case "sbn->lists"
-    (define sbn (hash 'a (tbf/state (hash 'b 2) 0)
-                      'b (tbf/state (hash 'a 2) 0)))
-    (check-equal? (sbn->lists sbn)
-                  '((- a b) (a 0 2) (b 2 0)))
-    (check-equal? (sbn->lists sbn #:headers #f)
-                  '((a 0 2) (b 2 0)))
-    (check-equal? (sbn->lists sbn #:func-names #f)
-                  '((a b) (0 2) (2 0)))
-    (check-equal? (sbn->lists sbn #:headers #f #:func-names #f)
-                  '((0 2) (2 0)))))
-

utils-untyped.rkt

@@ -0,0 +1,693 @@
+#lang racket
+
+;;; dds/utils
+
+;;; Various utilities.
+
+(require
+ graph
+ (for-syntax syntax/parse racket/list))
+
+(provide
+ ;; Functions
+ (contract-out [update-vertices/unweighted (-> graph? (-> any/c any/c) graph?)]
+               [update-graph (->* (graph?)
+                                  (#:v-func (-> any/c any/c)
+                                   #:e-func (-> any/c any/c))
+                                  graph?)]
+               [collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (listof any/c))))]
+               [collect-by-key/sets (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (set/c any/c))))]
+
+               [ht-values/list->set (-> (hash/c any/c (listof any/c)) (hash/c any/c (set/c any/c)))]
+               [hash->list/ordered (-> hash? (listof (cons/c any/c any/c)))]
+               [multi-split-at (-> (listof (listof any/c)) number?
+                                   (values (listof (listof any/c)) (listof (listof any/c))))]
+               [lists-transpose (-> (listof (listof any/c)) (listof (listof any/c)))]
+               [procedure-fixed-arity? (-> procedure? boolean?)]
+               [in-random (case-> (-> (stream/c (and/c real? inexact? (>/c 0) (</c 1))))
+                                  (-> (integer-in 1 4294967087) (stream/c exact-nonnegative-integer?))
+                                  (-> exact-integer? (integer-in 1 4294967087)
+                                      (stream/c exact-nonnegative-integer?)))]
+               [cartesian-product/stream (->* () #:rest (listof stream?) stream?)]
+               [boolean-power (-> number? (listof (listof boolean?)))]
+               [boolean-power/stream (-> number? (stream/c (listof boolean?)))]
+               [any->01 (-> any/c (or/c 0 1))]
+               [01->boolean (-> (or/c 0 1) boolean?)]))
+
+(module+ test
+  (require rackunit))
+
+
+;;; ===================
+;;; HashTable Injection
+;;; ===================
+
+;;; This section of the file contains some utilities to streamline the
+;;; usage of hash tables mapping symbols to values.  The goal is
+;;; essentially to avoid having to write explicit hash-ref calls.
+
+;;; A variable mapping is a hash table mapping symbols to values.
+(define (variable-mapping? dict) (hash/c symbol? any/c))
+
+;;; Given a (HashTable Symbol a) and a sequence of symbols, binds
+;;; these symbols to the values they are associated to in the hash
+;;; table, then puts the body in the context of these bindings.
+;;;
+;;; > (let ([ht #hash((a . 1) (b . 2))])
+;;;     (auto-hash-ref/explicit (ht a b) (+ a (* 2 b))))
+;;; 5
+;;;
+;;; Note that only one expression can be supplied in the body.
+(define-syntax (auto-hash-ref/explicit stx)
+  (syntax-parse stx
+    [(_ (ht:id xs:id ...) body:expr)
+     #`(let #,(for/list ([x (syntax->list #'(xs ...))])
+                #`[#,x (hash-ref ht '#,x)])
+         body)]))
+
+(module+ test
+  (test-case "auto-hash-ref/explicit"
+    (define mytable #hash((a . 3) (b . 4)))
+    (check-equal? (auto-hash-ref/explicit (mytable b a)
+                                          (* a b))
+                  12)
+    (define ht #hash((a . #t) (b . #f)))
+    (check-equal? (auto-hash-ref/explicit (ht a b)
+                                          (and (not a) b))
+                  #f)))
+
+;;; Given an expression and a (HashTable Symbol a), looks up the
+;;; symbols with a leading semicolon and binds them to the value they
+;;; are associated to in the hash table.
+;;;
+;;; > (let ([ht #hash((a . 1) (b . 2))])
+;;;      (auto-hash-ref/: ht (+ :a (* 2 :b))))
+;;; 5
+;;;
+;;; Note that the symbol :a is matched to the key 'a in the hash
+;;; table.
+;;;
+;;; Note that only one expression can be supplied in the body.
+(define-syntax (auto-hash-ref/: stx)
+  (syntax-parse stx
+    [(_ ht:id body)
+     (let* ([names/: (collect-colons (syntax->datum #'body))])
+       #`(let #,(for/list ([x names/:])
+                  ;; put x in the same context as body
+                  #`[#,(datum->syntax #'body x)
+                     (hash-ref ht '#,(strip-colon x))])
+           body))]))
+
+(module+ test
+  (test-case "auto-hash-ref/:"
+    (define ht1 #hash((x . #t) (y . #t) (t . #f)))
+    (define z #t)
+    (check-equal? (auto-hash-ref/: ht1
+                                   (and :x (not :y) z (or (and :t) :x)))
+                  #f)
+    (define ht2 #hash((a . 1) (b . 2)))
+    (check-equal? (auto-hash-ref/: ht2 (+ :a (* 2 :b)))
+                  5)))
+
+;;; The helper functions for auto-hash-ref/:.
+(begin-for-syntax
+  ;; Collect all the symbols starting with a colon in datum.
+  (define (collect-colons datum)
+    (remove-duplicates
+     (flatten
+      (for/list ([token datum])
+        (cond
+          [(symbol? token)
+           (let ([name (symbol->string token)])
+             (if (eq? #\: (string-ref name 0))
+                 token
+                 '()))]
+          [(list? token)
+           (collect-colons token)]
+          [else '()])))))
+
+  ;; Strip the leading colon off x.
+  (define (strip-colon x)
+    (let ([x-str (symbol->string x)])
+      (if (eq? #\: (string-ref x-str 0))
+          (string->symbol (substring x-str 1))
+          x))))
+
+;;; Temporarily injects the mappings from the given hash table as
+;;; bindings in a namespace including racket/base and then evaluates
+;;; the expression.
+;;;
+;;; > (let ([ht #hash((a . 1) (b . 1))])
+;;;     (eval-with ht '(+ b a 1)))
+;;; 3
+;;;
+;;; The local bindings from the current lexical scope are not
+;;; conserved.  Therefore, the following outputs an error about a
+;;; missing identifier:
+;;;
+;;; > (let ([ht #hash((a . 1) (b . 1))]
+;;;         [z 1])
+;;;     (eval-with ht '(+ b z a 1)))
+;;;
+(define (eval-with ht expr)
+  (parameterize ([current-namespace (make-base-namespace)])
+    (for ([(x val) ht]) (namespace-set-variable-value! x val))
+    (eval expr)))
+
+(module+ test
+  (test-case "eval-with"
+    (check-equal? (let ([ht #hash((a . 1) (b . 1))])
+                    (eval-with ht '(+ b a 1)))
+                  3)))
+
+;;; Same as eval-with, but returns only the first value produced by
+;;; the evaluated expression.
+(define (eval-with1 ht expr)
+  (let ([vals (call-with-values (λ () (eval-with ht expr))
+                                (λ vals vals))])
+    (car vals)))
+
+
+;;; ==============================
+;;; Analysis of quoted expressions
+;;; ==============================
+
+;;; Produces a list of symbols appearing in the quoted expression
+;;; passed in the first argument.
+(define (extract-symbols form)
+  (match form
+    [(? symbol?) (list form)]
+    [(? list?) (flatten (for/list ([x form])
+                          (extract-symbols x)))]
+    [else '()]))
+
+(module+ test
+  (test-case "extract-symbols"
+    (check-equal? (extract-symbols '(1 (2 3) x (y z 3)))
+                  '(x y z))))
+
+
+;;; =========================
+;;; Interaction with Org-mode
+;;; =========================
+
+;;; Org-mode supports laying out the output of code blocks as tables,
+;;; which is very practical for various variable mappings (e.g.,
+;;; states).  However, when the hash table maps variables to lists,
+;;; Org-mode will create a column per list element, which may or may
+;;; not be the desired effect.  In this section I define some
+;;; utilities for nicer interoperation with Org-mode tables.  I also
+;;; define some shortcuts to reduce the number of words to type when
+;;; using dds with Org-mode.  See example.org for examples of usage.
+
+;;; Converts any value to string.
+(define (any->string x)
+  (with-output-to-string (λ () (display x))))
+
+(module+ test
+  (test-case "any->string"
+   (check-equal? (any->string 'a) "a")
+   (check-equal? (any->string '(a 1 (x y))) "(a 1 (x y))")
+   (check-equal? (any->string "hello") "hello")))
+
+;;; A string variable mapping is a mapping from variables to strings.
+(define (string-variable-mapping? dict) (hash/c symbol? string?))
+
+;;; Converts all the values of a variable mapping to string.
+(define (stringify-variable-mapping ht)
+  (for/hash ([(key val) ht]) (values key (any->string val))))
+
+(module+ test
+  (test-case "stringify-variable-mapping"
+    (define mp (stringify-variable-mapping #hash((a . (and a b)) (b . (not b)))))
+    (check-equal? (hash-ref mp 'a) "(and a b)")
+    (check-equal? (hash-ref mp 'b) "(not b)")))
+
+;;; Reads any value from string.
+(define (string->any str)
+  (with-input-from-string str (λ () (read))))
+
+(module+ test
+  (test-case "string->any"
+    (check-equal? (string->any "(or b (not a))") '(or b (not a)))
+    (check-equal? (string->any "14") 14)))
+
+;;; Given a sexp, converts all "#f" to #f and "#t" to #t.
+;;;
+;;; When I read Org-mode tables, I pump them through a call to the
+;;; prin1 because the elisp sexp seems incompatible with Racket.  On
+;;; the other hand, Racket Booleans seem to upset elisp a little, so
+;;; prin1 wraps them in additional double quotes.  This function
+;;; removes those quotes.
+(define/match (handle-org-booleans datum)
+  [("#t") #t]
+  [("#f") #f]
+  [((? list?)) (map handle-org-booleans datum)]
+  [ (_) datum])
+
+;;; Given a sexp, applies the given function to any object which is
+;;; not a list.
+;;;
+;;; The contract of this function will not check whether func is
+;;; indeed applicable to every non-list element of the sexp.  If this
+;;; is not the case, a contract violation for func will be generated.
+(define (map-sexp func sexp)
+  (match sexp
+    [(? list?) (map ((curry map-sexp) func) sexp)]
+    [datum (func datum)]))
+
+(module+ test
+  (test-case "map-sexp"
+    (check-equal? (map-sexp add1 '(1 2 (4 10) 3)) '(2 3 (5 11) 4))))
+
+;;; Reads a sexp from a string produced by Org-mode for a named table.
+;;; See example.org for examples.
+(define read-org-sexp
+  (compose ((curry map-sexp) (match-lambda
+                               [(and (? string?) str) (string->any str)]
+                               [x x]))
+           string->any))
+
+;;; A shortcut for read-org-sexp.
+(define unorg read-org-sexp)
+
+(module+ test
+  (test-case "read-org-sexp"
+    (check-equal? (read-org-sexp "((\"a\" \"(and a b)\") (\"b\" \"(or b (not a))\"))")
+                  '((a (and a b)) (b (or b (not a)))))
+    (check-equal? (read-org-sexp "(#t \"#t\" \"#t \" '(1 2 \"#f\"))")
+                  '(#t #t #t '(1 2 #f)))))
+
+;;; A contract allowing pairs constructed via cons or via list.
+(define (general-pair/c key-contract val-contract)
+  (or/c (list/c key-contract val-contract)
+        (cons/c key-contract val-contract)))
+
+;;; Given a list of pairs of strings and some other values (possibly
+;;; strings), converts the first element of each pair to a string, and
+;;; reads the second element with string->any or keeps it as is if it
+;;; is not a string.
+(define (unstringify-pairs pairs)
+  (for/list ([p pairs])
+    (match p
+      [(list key val)
+       (cons (string->symbol key) (if (string? val)
+                                      (string->any val)
+                                      val))]
+      [(cons key val)                   ; also handle improper pairs
+       (cons (string->symbol key) (if (string? val)
+                                      (string->any val)
+                                      val))])))
+
+(module+ test
+  (test-case "unstringify-pairs"
+    (check-equal? (unstringify-pairs '(("a" . "1") ("b" . "(and a (not b))")))
+                  '((a . 1) (b . (and a (not b)))))
+    (check-equal? (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))")))
+                  '((a . 1) (b . (and a (not b)))))))
+
+;;; Reads a variable mapping from a string, such as the one which
+;;; Org-mode produces from tables.
+(define read-org-variable-mapping
+  (compose make-immutable-hash unstringify-pairs string->any))
+
+(module+ test
+  (test-case "read-org-variable-mapping"
+    (define m1 (read-org-variable-mapping "((\"a\" \"(and a b)\") (\"b\" \"(or b (not a))\"))"))
+    (define m2 (read-org-variable-mapping "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))"))
+    (define m3 (unorgv "((\"a\" . \"(and a b)\") (\"b\" . \"(or b (not a))\"))"))
+    (check-equal? (hash-ref m1 'a) '(and a b))
+    (check-equal? (hash-ref m2 'a) '(and a b))
+    (check-equal? (hash-ref m3 'a) '(and a b))
+    (check-equal? (hash-ref m1 'b) '(or b (not a)))
+    (check-equal? (hash-ref m2 'b) '(or b (not a)))
+    (check-equal? (hash-ref m3 'b) '(or b (not a)))))
+
+;;; A synonym for read-org-variable-mapping.
+(define unorgv read-org-variable-mapping)
+
+;;; Typeset the graph via graphviz and display it.
+(define dotit (compose display graphviz))
+
+;;; Reads a list of symbols from a string.
+(define (read-symbol-list str)
+  (string->any (string-append "(" str ")")))
+
+(module+ test
+  (test-case "read-symbol-list"
+    (check-equal? (read-symbol-list "a b c") '(a b c))))
+
+;;; Removes the first and the last symbol of a given string.
+;;;
+;;; Useful for removing the parentheses in string representations of
+;;; lists.
+(define (drop-first-last str)
+  (substring str 1 (- (string-length str) 1)))
+
+(module+ test
+  (test-case "drop-first-last"
+    (check-equal? (drop-first-last "(a b)") "a b")))
+
+;;; Converts a list of sets of symbols to a list of strings containing
+;;; those symbols.
+(define (list-sets->list-strings lst)
+  (map (compose drop-first-last any->string set->list) lst))
+
+(module+ test
+  (test-case "list-sets->list-strings"
+    (check-equal? (list-sets->list-strings (list (set 'x 'y) (set 'z) (set) (set 't)))
+                  '("y x" "z" "" "t"))))
+
+;;; Pretty-prints a set of sets of symbols.
+;;;
+;;; Typically used for pretty-printing the annotations on the edges of
+;;; the state graph.
+(define (pretty-print-set-sets ms)
+  (string-join (for/list ([m ms]) (format "{~a}" (pretty-print-set m))) ""))
+
+(module+ test
+  (test-case "pretty-print-set-sets"
+    (check-equal? (pretty-print-set-sets (set (set 'a 'b) (set 'c))) "{a b}{c}")))
+
+
+;;; ==========================
+;;; Additional graph utilities
+;;; ==========================
+
+;;; Apply a transformation to every vertex in the unweighted graph,
+;;; return the new graph.  If the transformation function maps two
+;;; vertices to the same values, these vertices will be merged in the
+;;; resulting graph.  The transformation function may be called
+;;; multiple times for the same vertex.
+;;;
+;;; This function does not rely on rename-vertex!, so it can be used
+;;; to permute vertex labels.
+(define (update-vertices/unweighted gr func)
+  (unweighted-graph/directed
+   (for/list ([e (in-edges gr)])
+     (match-let ([(list u v) e])
+       (list (func u) (func v))))))
+
+(module+ test
+  (test-case "update-vertices/unweighted"
+    (define gr1 (directed-graph '((a b) (b c))))
+    (define gr2 (undirected-graph '((a b) (b c))))
+    (define dbl (λ (x) (let ([x-str (symbol->string x)])
+                         (string->symbol (string-append x-str x-str)))))
+    (define new-gr1 (update-vertices/unweighted gr1 dbl))
+    (define new-gr2 (update-vertices/unweighted gr2 dbl))
+
+    (check-false (has-vertex? new-gr1 'a))
+    (check-true (has-vertex? new-gr1 'aa))
+    (check-false (has-vertex? new-gr1 'b))
+    (check-true (has-vertex? new-gr1 'bb))
+    (check-false (has-vertex? new-gr1 'c))
+    (check-true (has-vertex? new-gr1 'cc))
+    (check-true (has-edge? new-gr1 'aa 'bb))
+    (check-true (has-edge? new-gr1 'bb 'cc))
+
+    (check-true (has-edge? new-gr2 'aa 'bb))
+    (check-true (has-edge? new-gr2 'bb 'aa))
+    (check-true (has-edge? new-gr2 'bb 'cc))
+    (check-true (has-edge? new-gr2 'cc 'bb))))
+
+;;; Given a graph, apply a transformation v-func to every vertex label
+;;; and, if the graph is a weighted graph, the transformation e-func
+;;; to every edge label.  Both transformations default to identity
+;;; functions.  If gr is an weighted graph, the result is a weighted
+;;; graph.  If gr is an unweighted graph, the result is an unweighted
+;;; graph.
+(define (update-graph gr
+                      #:v-func [v-func identity]
+                      #:e-func [e-func identity])
+  (define edges
+    (for/list ([e (in-edges gr)])
+      (match-let ([(list u v) e])
+        (cond
+          [(unweighted-graph? gr) (list (v-func u) (v-func v))]
+          [else (list (e-func (edge-weight gr u v))
+                      (v-func u) (v-func v))]))))
+  (cond
+    [(unweighted-graph? gr) (unweighted-graph/directed edges)]
+    [else
+     (weighted-graph/directed edges)]))
+
+(module+ test
+  (test-case "update-graph"
+    (define gr1 (directed-graph '((a b) (b c))))
+    (define gr2 (undirected-graph '((a b) (b c))))
+    (define dbl (λ (x) (let ([x-str (symbol->string x)])
+                         (string->symbol (string-append x-str x-str)))))
+    (define new-gr1-ug (update-graph gr1 #:v-func dbl))
+    (define new-gr2-ug (update-graph gr2 #:v-func dbl))
+    (define gr3 (weighted-graph/directed '((10 a b) (11 b c))))
+    (define new-gr3 (update-graph gr3 #:v-func dbl #:e-func (λ (x) (* 2 x))))
+
+    (check-false (has-vertex? new-gr1-ug 'a))
+    (check-true (has-vertex? new-gr1-ug 'aa))
+    (check-false (has-vertex? new-gr1-ug 'b))
+    (check-true (has-vertex? new-gr1-ug 'bb))
+    (check-false (has-vertex? new-gr1-ug 'c))
+    (check-true (has-vertex? new-gr1-ug 'cc))
+    (check-true (has-edge? new-gr1-ug 'aa 'bb))
+    (check-true (has-edge? new-gr1-ug 'bb 'cc))
+
+    (check-true (has-edge? new-gr2-ug 'aa 'bb))
+    (check-true (has-edge? new-gr2-ug 'bb 'aa))
+    (check-true (has-edge? new-gr2-ug 'bb 'cc))
+    (check-true (has-edge? new-gr2-ug 'cc 'bb))
+
+    (check-true (has-edge? new-gr3 'aa 'bb))
+    (check-false (has-edge? new-gr3 'bb 'aa))
+    (check-true (has-edge? new-gr3 'bb 'cc))
+    (check-false (has-edge? new-gr3 'cc 'bb))
+    (check-equal? (edge-weight new-gr3 'aa 'bb) 20)
+    (check-equal? (edge-weight new-gr3 'bb 'cc) 22)))
+
+
+;;; ===============
+;;; Pretty printing
+;;; ===============
+
+;;; Pretty print a set by listing its elements in alphabetic order.
+(define (pretty-print-set s)
+  (string-join (sort (set-map s any->string) string<?)))
+
+(module+ test
+  (test-case "pretty-print-set"
+    (check-equal? (pretty-print-set (set 'a 'b 1)) "1 a b")))
+
+
+;;; ======================================
+;;; Additional list and hash map utilities
+;;; ======================================
+
+;;; Collects labels for duplicate edges into a sets of labels.
+;;;
+;;; More precisely, given a list of edges and weights, produces a new
+;;; list of edges without duplicates, and a list of lists of weights
+;;; in which each element corresponds to the edge (the input is
+;;; suitable for graph constructors).
+(define (collect-by-key edges labels)
+  (for/fold ([ht (make-immutable-hash)]
+             #:result (values (hash-keys ht) (hash-values ht)))
+            ([e edges] [l labels])
+    (hash-update ht e (λ (ls) (cons l ls)) empty)))
+
+(module+ test
+  (test-case "collect-by-key"
+    (define-values (e1 l1) (collect-by-key '((1 2) (1 3)) '(a b)))
+    (define-values (e2 l2) (collect-by-key '((1 2) (1 2)) '(a b)))
+    (check-equal? e1 '((1 2) (1 3))) (check-equal? l1 '((a) (b)))
+    (check-equal? e2 '((1 2))) (check-equal? l2 '((b a)))))
+
+;;; Like collect-by-key, but returns a list of sets of weights.
+(define (collect-by-key/sets edges labels)
+  (let-values ([(es ls) (collect-by-key edges labels)])
+    (values es (map list->set ls))))
+
+(module+ test
+  (test-case "collect-by-key/sets"
+    (define-values (e3 l3) (collect-by-key/sets '(a b a) '(1 2 1)))
+    (check-equal? e3 '(a b)) (check-equal? l3 (list (set 1) (set 2)))))
+
+;;; Converts the values of a hash table from lists to sets.
+(define (ht-values/list->set ht)
+  (for/hash ([(k v) (in-hash ht)])
+    (values k (list->set v))))
+
+(module+ test
+  (test-case "ht-values/list->set"
+    (check-equal? (ht-values/list->set #hash((a . (1 1))))
+                  (hash 'a (set 1)))))
+
+;;; Returns the key-value pairs of a given hash table in the order in
+;;; which the hash table orders them for hash-map and hash-for-each.
+(define (hash->list/ordered ht) (hash-map ht cons #t))
+
+(module+ test
+  (test-case "hash->list/ordered"
+    (check-equal? (hash->list/ordered #hash((b . 1) (a . 1)))
+                  '((a . 1) (b . 1)))))
+
+;;; Given a list of lists, splits every single list at the given
+;;; position, and then returns two lists: one consisting of the first
+;;; halves, and the one consisting of the second halves.
+(define (multi-split-at lsts pos)
+  (for/fold ([lefts '()]
+             [rights '()]
+             #:result (values (reverse lefts) (reverse rights)))
+            ([lst (in-list lsts)])
+    (define-values (left right) (split-at lst pos))
+    (values (cons left lefts) (cons right rights))))
+
+(module+ test
+  (test-case "multi-split-at"
+    (define-values (l1 l2) (multi-split-at '((1 2 3) (a b c)) 2))
+    (check-equal? l1 '((1 2) (a b))) (check-equal? l2 '((3) (c)))))
+
+;;; Given a list of lists of the same length, transposes them.
+;;;
+;;; > (lists-transpose '((1 2) (a b)))
+;;; '((1 a) (2 b))
+;;;
+;;; This function is essentially in-parallel, wrapped in a couple
+;;; conversions.
+(define lists-transpose
+  (compose sequence->list
+           in-values-sequence
+           ((curry apply) in-parallel)))
+
+(module+ test
+  (test-case "lists-transpose"
+    (check-equal? (lists-transpose '((1 2) (a b))) '((1 a) (2 b)))))
+
+
+;;; =========
+;;; Functions
+;;; =========
+
+;;; Returns #t if the function has fixed arity (i.e. if it does not
+;;; take a variable number of arguments).
+(define (procedure-fixed-arity? func)
+  (match (procedure-arity func)
+    [(arity-at-least _) #f] [arity #t]))
+
+(module+ test
+  (test-case "procedure-fixed-arity?"
+    (check-true (procedure-fixed-arity? not))
+    (check-false (procedure-fixed-arity? +))))
+
+
+;;; ==========
+;;; Randomness
+;;; ==========
+
+;;; Generates a stream of inexact random numbers.  The meaning of the
+;;; arguments is the same as for the function random:
+;;;
+;;; (in-randoms k) — a sequence of random exact integers in the range
+;;; 0 to k-1.
+;;;
+;;; (in-randoms min max) — a sequence of random exact integers the
+;;; range min to max-1.
+;;;
+;;; (in-randoms) — a sequence of random inexact numbers between
+;;; 0 and 1.
+(define in-random
+  (case-lambda
+    [() (for/stream ([i (in-naturals)]) (random))]
+    [(k) (for/stream ([i (in-naturals)]) (random k))]
+    [(min max) (for/stream ([i (in-naturals)]) (random min max))]))
+
+(module+ test
+  (test-case "in-random"
+    (random-seed 0)
+    (check-equal? (stream->list (stream-take (in-random 100) 10))
+                  '(85 65 20 40 89 45 54 38 26 62))
+    (check-equal? (stream->list (stream-take (in-random 50 100) 10))
+                  '(75 59 82 85 61 85 59 64 75 53))
+    (check-equal? (stream->list (stream-take (in-random) 10))
+                  '(0.1656109603231493
+                    0.9680391127132195
+                    0.051518813640790355
+                    0.755901955353936
+                    0.5923534604277275
+                    0.5513340634474264
+                    0.7022057040731392
+                    0.48375400938578744
+                    0.7538961707172924
+                    0.01828428516237329))))
+
+
+;;; ===========================
+;;; Additional stream utilities
+;;; ===========================
+
+
+;;; Returns the Cartesian product of the given streams.  The result is
+;;; a stream whose elements are the elements of the Cartesian product.
+;;;
+;;; The implementation is inspired from the implementation of
+;;; cartesian-product in racket/list.
+(define (cartesian-product/stream . ss)
+  ;; Cartesian product of two streams, produces an improper pair.
+  (define (cp-2 ss1 ss2)
+    (for*/stream ([s1 (in-stream ss1)] [s2 (in-stream ss2)]) (cons s1 s2)))
+  ;; Fold-right over the list of streams.  The value for the fold is a
+  ;; 1-value stream containing the empty list, which makes all the
+  ;; lists proper.
+  (foldr cp-2 (sequence->stream (in-value (list))) ss))
+
+(module+ test
+  (test-case "cartesian-product/stream"
+    (check-equal? (stream->list (cartesian-product/stream (in-range 3) (in-range 4 6) '(a b)))
+                  '((0 4 a)
+                    (0 4 b)
+                    (0 5 a)
+                    (0 5 b)
+                    (1 4 a)
+                    (1 4 b)
+                    (1 5 a)
+                    (1 5 b)
+                    (2 4 a)
+                    (2 4 b)
+                    (2 5 a)
+                    (2 5 b)))))
+
+
+;;; ==================
+;;; Boolean operations
+;;; ==================
+
+;;; 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))))
+
+(module+ test
+  (test-case "boolean-power"
+    (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t)))))
+
+;;; Like boolean-power, but returns a stream whose elements the
+;;; elements of the Cartesian power.
+(define (boolean-power/stream n) (apply cartesian-product/stream (make-list n '(#f #t))))
+
+(module+ test
+  (test-case "boolean-power/stream"
+    (check-equal? (stream->list (boolean-power/stream 2)) '((#f #f) (#f #t) (#t #f) (#t #t)))))
+
+;;; Converts any non-#f value to 1 and #f to 0.
+(define (any->01 x) (if x 1 0))
+
+(module+ test
+  (test-case "any->01"
+    (check-equal? (any->01 #t) 1)
+    (check-equal? (any->01 #f) 0)))
+
+;;; Converts 0 to #f and 1 to #t
+(define (01->boolean x)
+  (case x [(0) #f] [else #t]))
+
+(module+ test
+  (test-case "01->boolean"
+    (check-equal? (01->boolean 0) #f)
+    (check-equal? (01->boolean 1) #t)))

utils.rkt

@@ -1,75 +1,30 @@
 #lang typed/racket
 
-(require typed/graph typed-compose typed/racket/stream syntax/parse/define
-         (for-syntax syntax/parse racket/syntax racket/list))
+(require (for-syntax syntax/parse racket/list)
+         typed-compose
+         "graph-typed.rkt")
 
-(provide
- Variable VariableMapping GeneralPair NonemptyListof
-
- assert-type for/first/typed for*/first/typed define/abstract/error
- relax-arg-type/any
- eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
- lambda/: λ/: define/:
- extract-symbols any->string stringify-variable-mapping string->any
- handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
- read-org-variable-mapping unorgv read-symbol-list drop-first-last
- list-sets->list-strings pretty-print-set pretty-print-set-sets
- update-vertices/unweighted update-graph dotit collect-by-key
- collect-by-key/sets ht-values/list->set hash->list/ordered hash-replace-keys/ordered
- multi-split-at lists-transpose append-lists in-random cartesian-product-2/stream
- cartesian-product/stream boolean-power boolean-power/stream any->01
- 01->boolean)
+(provide Variable VariableMapping GeneralPair
+         eval-with eval1-with
+         extract-symbols
+         any->string stringify-variable-mapping string->any map-sexp
+         read-org-sexp unorg unstringify-pairs
+         read-org-variable-mapping unorgv read-symbol-list drop-first-last
+         list-sets->list-strings
+         pretty-print-set pretty-print-set-sets
+         ;; Syntax
+         auto-hash-ref/explicit auto-hash-ref/:)
 
 (module+ test
   (require typed/rackunit))
 
+;;; ===================
+;;; HashTable injection
+;;; ===================
+
 (define-type Variable Symbol)
 (define-type (VariableMapping A) (Immutable-HashTable Variable A))
 
-(define-type (NonemptyListof a) (Pairof a (Listof a)))
-
-(define-syntax-parse-rule (assert-type e:expr type:expr)
-  (assert e (make-predicate type)))
-
-(define-for-syntax (make-for/first/typed-variant folder)
-  (syntax-parser
-    #:literals (:)
-    [(_ :
-        ty:expr ; These should probably be more specific.
-        clauses:expr
-        c ...)
-     #`(#,folder : ty
-        ([result : ty #f])
-        clauses
-        #:break (not (equal? result #f))
-        c ...)]))
-
-(define-syntax for/first/typed (make-for/first/typed-variant 'for/fold))
-(define-syntax for*/first/typed (make-for/first/typed-variant 'for*/fold))
-
-(module+ test
-  (test-case "for/first/typed, for/first/typed*"
-    (check-equal? (for/first/typed : (Option Integer)
-                                   ([i (in-range 1 10)]
-                                    #:when (zero? (modulo i 5)))
-                    (* i 3))
-                  15)
-    (check-equal? (for*/first/typed : (Option (Pairof Integer Integer))
-                                    ([i (in-range 1 10)]
-                                     [j (in-range 1 10)]
-                                     #:when (> (+ i j) 5)
-                                     #:when (even? i)
-                                     #:when (even? j))
-                    (cons i j))
-                  '(2 . 4))))
-
-(define-syntax-parser define/abstract/error
-  [(_ (name:id args:id ...))
-   #`(define/public (name args ...) (error 'name "abstract method"))])
-
-(define-syntax-parse-rule (relax-arg-type/any name:id arg-type:expr)
-  (λ ([x : Any]) (name (assert-type x arg-type))))
-
 (: eval-with (-> (VariableMapping Any) Any AnyValues))
 (define (eval-with ht expr)
   (parameterize ([current-namespace (make-base-namespace)])
@@ -90,11 +45,12 @@
     (check-equal? (eval1-with ht expr)
                   4)))
 
-(define-syntax-parser auto-hash-ref/explicit
-  [(_ (ht:id keys:id ...) body:expr)
-   #`(let #,(for/list ([key (syntax->list #'(keys ...))])
-              `[,key (hash-ref ,#'ht ',key)])
-         body)])
+(define-syntax (auto-hash-ref/explicit stx)
+  (syntax-parse stx
+    [(_ (ht:id xs:id ...) body:expr)
+     #`(let #,(for/list ([x (syntax->list #'(xs ...))])
+                #`[#,x (hash-ref ht '#,x)])
+         body)]))
 
 (module+ test
   (test-case "auto-hash-ref/explicit"
@@ -107,28 +63,39 @@
                                           (and (not a) b))
                   #f)))
 
-;;; Helper functions for auto-hash-ref/:.
-(begin-for-syntax
-  (define (colon? s)
-    (and (symbol? s)
-         (eq? (string-ref (symbol->string s) 0) #\:)))
-  (define (collect-colons datum)
-    (cond [(colon? datum) (list datum)]
-          [(list? datum)
-           (remove-duplicates (flatten (for/list ([el (in-list datum)])
-                                         (collect-colons el))))]
-          [else '()]))
-  (define (strip-colon s)
-    (string->symbol (substring (symbol->string s) 1))))
-
 (define-syntax (auto-hash-ref/: stx)
   (syntax-parse stx
-    [(_ ht:id body:expr)
-     (define colons (collect-colons (syntax->datum stx)))
-     (define bindings (for/list ([key colons])
-                        `[,key (hash-ref ,#'ht ',(strip-colon key))]))
-     (with-syntax ([bindings-stx (datum->syntax #'ht bindings)])
-       #'(let bindings-stx body))]))
+    [(_ ht:id body)
+     (let* ([names/: (collect-colons (syntax->datum #'body))])
+       #`(let #,(for/list ([x names/:])
+                  ;; put x in the same context as body
+                  #`[#,(datum->syntax #'body x)
+                     (hash-ref ht '#,(strip-colon x))])
+           body))]))
+
+;;; The helper functions for auto-hash-ref/:.
+(begin-for-syntax
+  ;; Collect all the symbols starting with a colon in datum.
+  (define (collect-colons datum)
+    (remove-duplicates
+     (flatten
+      (for/list ([token datum])
+        (cond
+          [(symbol? token)
+           (let ([name (symbol->string token)])
+             (if (eq? #\: (string-ref name 0))
+                 token
+                 '()))]
+          [(list? token)
+           (collect-colons token)]
+          [else '()])))))
+
+  ;; Strip the leading colon off x.
+  (define (strip-colon x)
+    (let ([x-str (symbol->string x)])
+      (if (eq? #\: (string-ref x-str 0))
+          (string->symbol (substring x-str 1))
+          x))))
 
 (module+ test
   (test-case "auto-hash-ref/:"
@@ -141,36 +108,12 @@
     (check-equal? (auto-hash-ref/: ht2 (+ :a (* 2 :b)))
                   5)))
 
-(define-syntax-parser lambda/:
-  [(_ body:expr)
-   #:with ht (format-id #'body "ht")
-   #'(lambda (ht) (auto-hash-ref/: ht body))]
-  [(_ type:expr body:expr)
-   #:with ht (format-id #'body "ht")
-   #'(lambda ([ht : type]) (auto-hash-ref/: ht body))])
-
-(define-syntax-parser λ/:
-  [(_ body:expr) #'(lambda/: body)]
-  [(_ type:expr body:expr) #'(lambda/: type body)])
-
-(define-syntax-parser define/:
-  [(_ name:id body:expr) #'(define name (λ/: body))]
-  [(_ name:id type:expr body:expr) #'(define name (λ/: type body))])
-
-(module+ test
-  (test-case "lambda/:, λ/:, define/:"
-    (define st : (HashTable Symbol Integer) (hash 'a 1 'b 2))
-    (check-equal? ((lambda/: (+ :a :b)) st) 3)
-    (check-equal? ((lambda/: (HashTable Symbol Integer) (+ :a :b)) st) 3)
-    (check-equal? ((λ/: (HashTable Symbol Integer) (+ :a :b)) st) 3)
-
-    (: f1 (-> (HashTable Symbol Integer) Integer))
-    (define/: f1 (+ :a :b))
-    (check-equal? (f1 st) 3)
-
-    (define/: f2 (HashTable Symbol Integer) (+ :a :b))
-    (check-equal? (f2 st) 3)))
+;;; ==============================
+;;; Analysis of quoted expressions
+;;; ==============================
 
+;;; Produces a list of symbols appearing in the quoted expression
+;;; passed in the first argument.
 (: extract-symbols (-> Any (Listof Symbol)))
 (define (extract-symbols form)
   (: extract-rec (-> Any (Listof Any)))
@@ -179,30 +122,35 @@
       [(? symbol?) (list form)]
       [(? list?)
        (flatten (for/list : (Listof Any)
-                          ([x form])
+                    ([x form])
                   (extract-symbols x)))]
       [else '()]))
-  (assert-type (extract-rec form) (Listof Symbol)))
+  (cast (extract-rec form) (Listof Symbol)))
 
 (module+ test
   (test-case "extract-symbols"
     (check-equal? (extract-symbols '(1 (2 3) x (y z 3)))
                   '(x y z))))
 
+
+;;; =========================
+;;; Org-mode interoperability
+;;; =========================
+
 (: any->string (-> Any String))
 (define (any->string x)
   (with-output-to-string (λ () (display x))))
 
 (module+ test
   (test-case "any->string"
-    (check-equal? (any->string 'a) "a")
-    (check-equal? (any->string '(a 1 (x y))) "(a 1 (x y))")
-    (check-equal? (any->string "hello") "hello")))
+   (check-equal? (any->string 'a) "a")
+   (check-equal? (any->string '(a 1 (x y))) "(a 1 (x y))")
+   (check-equal? (any->string "hello") "hello")))
 
 (: stringify-variable-mapping (-> (VariableMapping Any) (VariableMapping String)))
 (define (stringify-variable-mapping ht)
   (for/hash : (VariableMapping String)
-            ([(key val) (in-hash ht)]) (values key (any->string val))))
+      ([(key val) (in-hash ht)]) (values key (any->string val))))
 
 (module+ test
   (test-case "stringify-variable-mapping"
@@ -222,9 +170,9 @@
 ;;; Given a sexp, converts all "#f" to #f and "#t" to #t.
 ;;;
 ;;; When I read Org-mode tables, I pump them through a call to the
-;;; prin1 because the Elisp sexps seems incompatible with Racket.
-;;; On the other hand, Racket Booleans seem to upset Elisp a little,
-;;; so prin1 wraps them in additional double quotes.  This function
+;;; prin1 because the elisp sexp seems incompatible with Racket.  On
+;;; the other hand, Racket Booleans seem to upset elisp a little, so
+;;; prin1 wraps them in additional double quotes.  This function
 ;;; removes those quotes.
 (: handle-org-booleans (-> Any Any))
 (define/match (handle-org-booleans datum)
@@ -233,13 +181,6 @@
   [((? list?)) (map handle-org-booleans datum)]
   [ (_) datum])
 
-(module+ test
-  (test-case "handle-org-booleans"
-    (check-equal? (handle-org-booleans "#t") #t)
-    (check-equal? (handle-org-booleans "#f") #f)
-    (check-equal? (handle-org-booleans '("#t" "#f")) '(#t #f))
-    (check-equal? (handle-org-booleans "t") "t")))
-
 (: map-sexp (-> (-> Any Any) Any Any))
 (define (map-sexp func sexp)
   (match sexp
@@ -248,10 +189,7 @@
 
 (module+ test
   (test-case "map-sexp"
-    (check-equal? (map-sexp (λ (x)
-                              (assert x number?)
-                              (add1 x))
-                            '(1 2 (4 10) 3))
+    (check-equal? (map-sexp (λ (x) (add1 (cast x Number))) '(1 2 (4 10) 3))
                   '(2 3 (5 11) 4))))
 
 (: read-org-sexp (-> String Any))
@@ -298,8 +236,7 @@
    (λ ([pairs : (Listof (Pair Symbol Any))])
      (make-immutable-hash pairs))
    (λ (sexp)
-     (assert-type sexp (Listof (GeneralPair String Any)))
-     (unstringify-pairs sexp))
+     (unstringify-pairs (cast sexp (Listof (GeneralPair String Any)))))
    string->any))
 
 ;;; A synonym for read-org-variable-mapping.
@@ -317,9 +254,12 @@
     (check-equal? (hash-ref m2 'b) '(or b (not a)))
     (check-equal? (hash-ref m3 'b) '(or b (not a)))))
 
+(: dotit (-> Graph Void))
+(define dotit (compose display graphviz))
+
 (: read-symbol-list (-> String (Listof Symbol)))
 (define (read-symbol-list str)
-  (assert-type (string->any (string-append "(" str ")")) (Listof Symbol)))
+  (cast (string->any (string-append "(" str ")")) (Listof Symbol)))
 
 (module+ test
   (test-case "read-symbol-list"
@@ -343,30 +283,12 @@
 (module+ test
   (test-case "list-sets->list-strings"
     (check-equal? (list-sets->list-strings (list (set 'x 'y) (set 'z) (set) (set 't)))
-                  '("x y" "z" "" "t"))))
+                  '("y x" "z" "" "t"))))
 
-(: pretty-print-set (-> (U (Setof Any) (Listof Any)) String))
-(define (pretty-print-set s)
-  (string-join (sort (set-map s any->string) string<?)))
 
-(module+ test
-  (test-case "pretty-print-set"
-    (check-equal? (pretty-print-set (set 'a 'b 1)) "1 a b")
-    (check-equal? (pretty-print-set (list 'a 'b 1)) "1 a b")))
-
-(: pretty-print-set-sets (-> (U (Setof (Setof Any))
-                                (Listof (Setof Any)))
-                             String))
-(define (pretty-print-set-sets ms)
-  (string-join (for/list ([m ms]) : (Listof String)
-                         (format "{~a}" (pretty-print-set m))) ""))
-
-(module+ test
-  (test-case "pretty-print-set-sets"
-    (check-equal? (pretty-print-set-sets (set (set 'a 'b) (set 'c))) "{a b}{c}")
-    (check-equal? (pretty-print-set-sets (list (set 'a 'b) (set 'c))) "{a b}{c}")))
-
-(define dotit (compose display graphviz))
+;;; ==========================
+;;; Additional graph utilities
+;;; ==========================
 
 (: update-vertices/unweighted (-> Graph (-> Any Any) Graph))
 (define (update-vertices/unweighted gr func)
@@ -378,11 +300,12 @@
 (module+ test
   (test-case "update-vertices/unweighted"
     (define gr1 (directed-graph '((a b) (b c))))
+    gr1
+#|
     (define gr2 (undirected-graph '((a b) (b c))))
-    (define (dbl [x : Any])
-      (assert x symbol?)
-      (define x-str (symbol->string x))
-      (string->symbol (string-append x-str x-str)))
+    (define dbl (λ ([x : Any])
+                  (define x-str (symbol->string (cast x Variable)))
+                  (string->symbol (string-append x-str x-str))))
     (define new-gr1 (update-vertices/unweighted gr1 dbl))
     (define new-gr2 (update-vertices/unweighted gr2 dbl))
 
@@ -398,281 +321,27 @@
     (check-true (has-edge? new-gr2 'aa 'bb))
     (check-true (has-edge? new-gr2 'bb 'aa))
     (check-true (has-edge? new-gr2 'bb 'cc))
-    (check-true (has-edge? new-gr2 'cc 'bb))))
+    (check-true (has-edge? new-gr2 'cc 'bb))
+|#))
 
-(: update-graph (->* (Graph) (#:v-func (-> Any Any) #:e-func (-> Any Any)) Graph))
-(define (update-graph gr #:v-func [v-func identity] #:e-func [e-func identity])
-  (cond
-    [(unweighted-graph? gr)
-     (unweighted-graph/directed
-      (for/list ([e (in-edges gr)]) : (Listof (List Any Any))
-                (match-let ([(list u v) e])
-                  (list (v-func u) (v-func v)))))]
-    [else
-     (weighted-graph/directed
-      (for/list ([e (in-edges gr)]) : (Listof (List Any Any Any))
-                (match-let ([(list u v) e])
-                  (list (e-func (edge-weight gr u v))
-                        (v-func u) (v-func v)))))]))
+
+;;; ===============
+;;; Pretty printing
+;;; ===============
+
+(: pretty-print-set (-> (Setof Any) String))
+(define (pretty-print-set s)
+  (string-join (sort (set-map s any->string) string<?)))
 
 (module+ test
-  (test-case "update-graph"
-    (define gr1 (directed-graph '((a b) (b c))))
-    (define gr2 (undirected-graph '((a b) (b c))))
-    (define (dbl [x : Any])
-      (assert x symbol?)
-      (define x-str (symbol->string x))
-      (string->symbol (string-append x-str x-str)))
-    (define new-gr1-ug (update-graph gr1 #:v-func dbl))
-    (define new-gr2-ug (update-graph gr2 #:v-func dbl))
-    (define gr3 (weighted-graph/directed '((10 a b) (11 b c))))
-    (define new-gr3 (update-graph gr3
-                                  #:v-func dbl
-                                  #:e-func (λ (x)
-                                             (assert x number?)
-                                             (* 2 x))))
+  (test-case "pretty-print-set"
+    (check-equal? (pretty-print-set (set 'a 'b 1)) "1 a b")))
 
-    (check-false (has-vertex? new-gr1-ug 'a))
-    (check-true (has-vertex? new-gr1-ug 'aa))
-    (check-false (has-vertex? new-gr1-ug 'b))
-    (check-true (has-vertex? new-gr1-ug 'bb))
-    (check-false (has-vertex? new-gr1-ug 'c))
-    (check-true (has-vertex? new-gr1-ug 'cc))
-    (check-true (has-edge? new-gr1-ug 'aa 'bb))
-    (check-true (has-edge? new-gr1-ug 'bb 'cc))
-
-    (check-true (has-edge? new-gr2-ug 'aa 'bb))
-    (check-true (has-edge? new-gr2-ug 'bb 'aa))
-    (check-true (has-edge? new-gr2-ug 'bb 'cc))
-    (check-true (has-edge? new-gr2-ug 'cc 'bb))
-
-    (check-true (has-edge? new-gr3 'aa 'bb))
-    (check-false (has-edge? new-gr3 'bb 'aa))
-    (check-true (has-edge? new-gr3 'bb 'cc))
-    (check-false (has-edge? new-gr3 'cc 'bb))
-    (check-equal? (edge-weight new-gr3 'aa 'bb) 20)
-    (check-equal? (edge-weight new-gr3 'bb 'cc) 22)))
-
-(: collect-by-key (All (a b) (-> (Listof a) (Listof b)
-                                 (Values (Listof a) (Listof (Listof b))))))
-(define (collect-by-key keys vals)
-  (for/fold ([ht : (HashTable a (Listof b))
-                 (make-immutable-hash)]
-             #:result (values (hash-keys ht) (hash-values ht)))
-            ([e keys]
-             [l vals])
-    ((inst hash-update a (Listof b)) ht e (λ (ls) (cons l ls)) (λ () empty))))
+(: pretty-print-set-sets (-> (Setof (Setof Any)) String))
+(define (pretty-print-set-sets ms)
+  (string-join (for/list ([m ms]) : (Listof String)
+                         (format "{~a}" (pretty-print-set m))) ""))
 
 (module+ test
-  (test-case "collect-by-key"
-    (define-values (e1 l1) (collect-by-key '((1 2) (1 3)) '(a b)))
-    (define-values (e2 l2) (collect-by-key '((1 2) (1 2)) '(a b)))
-    (check-equal? e1 '((1 2) (1 3))) (check-equal? l1 '((a) (b)))
-    (check-equal? e2 '((1 2))) (check-equal? l2 '((b a)))))
-
-(: collect-by-key/sets (All (a b) (-> (Listof a) (Listof b)
-                                      (Values (Listof a) (Listof (Setof b))))))
-(define (collect-by-key/sets edges labels)
-  (define-values (es ls) (collect-by-key edges labels))
-  (values es ((inst map (Setof b) (Listof b)) list->set ls)))
-
-(module+ test
-  (test-case "collect-by-key/sets"
-    (define-values (e3 l3) (collect-by-key/sets '(a b a) '(1 2 1)))
-    (check-equal? e3 '(b a)) (check-equal? l3 (list (set 2) (set 1)))))
-
-;;; Converts the values of a hash table from lists to sets.
-(: ht-values/list->set (All (a b) (-> (HashTable a (Listof b)) (HashTable a (Setof b)))))
-(define (ht-values/list->set ht)
-  (for/hash ([(k v) (in-hash ht)]) : (HashTable a (Setof b))
-            (values k (list->set v))))
-
-(module+ test
-  (test-case "ht-values/list->set"
-    (check-equal? (ht-values/list->set #hash((a . (1 1))))
-                  (hash 'a (set 1)))))
-
-;; TODO: Remove after Typed Racket has caught up with Racket 8.4.
-(: hash->list/ordered (All (a b) (-> (HashTable a b) (Listof (Pairof a b)))))
-(define (hash->list/ordered ht)
-  ((inst hash-map a b (Pairof a b)) ht cons #t))
-
-(module+ test
-  (test-case "hash->list/ordered"
-    (check-equal? (hash->list/ordered #hash((b . 1) (a . 1)))
-                  '((a . 1) (b . 1)))))
-
-(: hash-replace-keys/ordered (All (K1 K2 V) (-> (Immutable-HashTable K1 V) (Listof K2)
-                                                (Immutable-HashTable K2 V))))
-(define (hash-replace-keys/ordered ht new-keys)
-  (make-immutable-hash (map (λ ([new-k : K2] [pair : (Pairof K1 V)])
-                              (cons new-k (cdr pair)))
-                            new-keys
-                            (hash->list/ordered ht))))
-
-(module+ test
-  (test-case "hash-replace-keys/ordered"
-    (check-equal? (hash-replace-keys/ordered (hash 'a 1 'b 2) '(x y))
-                  '#hash((x . 1) (y . 2)))))
-
-(: multi-split-at (All (a) (-> (Listof (Listof a)) Integer
-                               (Values (Listof (Listof a)) (Listof (Listof a))))))
-(define (multi-split-at lists pos)
-  (for/fold ([lefts : (Listof (Listof a)) '()]
-             [rights : (Listof (Listof a)) '()]
-             #:result (values (reverse lefts) (reverse rights)))
-            ([lst (in-list lists)])
-    (define-values (left right) ((inst split-at a) lst pos))
-    (values (cons left lefts) (cons right rights))))
-
-(module+ test
-  (test-case "multi-split-at"
-    (define-values (l1 l2) (multi-split-at '((1 2 3) (a b c)) 2))
-    (check-equal? l1 '((1 2) (a b))) (check-equal? l2 '((3) (c)))))
-
-;; https://racket.discourse.group/t/get-to-type-apply-in-parallel-lst/683
-;;
-;; Same thread: (apply ((curry map) list) lsts), however I don't
-;; feel like typing this right now (2022-02-18).
-(: lists-transpose (All (a ...) (-> (List (Listof a) ... a) (Listof (List a ... a)))))
-(define (lists-transpose lists)
-  (sequence->list (in-values-sequence (apply in-parallel lists))))
-
-(module untyped racket
-  (provide (contract-out [lists-transpose (-> (listof (listof any/c)) (listof (listof any/c)))]))
-  (define (lists-transpose lists)
-    (sequence->list (in-values-sequence (apply in-parallel lists)))))
-
-(module+ test
-  (test-case "lists-transpose"
-    (check-equal? (lists-transpose '((1 2) (a b))) '((1 a) (2 b)))))
-
-(: append-lists (All (a) (-> (Listof (List (Listof a) (Listof a))) (Listof (Listof a)))))
-(define (append-lists lsts)
-  (for/list ([pr lsts])
-    (append (car pr) (cadr pr))))
-
-(module+ test
-  (test-case "append-lists"
-    (check-equal? (append-lists '(((1 2) (a b))
-                                  ((3 4) (c d))))
-                  '((1 2 a b)
-                    (3 4 c d)))))
-
-(: in-random (case->
-              (-> (Sequenceof Flonum))
-              (-> Integer (Sequenceof Nonnegative-Fixnum))
-              (-> Integer Integer (Sequenceof Nonnegative-Fixnum))))
-(define in-random
-  (case-lambda
-    [() (stream-cons
-         (assert-type (random) Flonum)
-         (in-random))]
-    [(k) (stream-cons
-          (assert-type (random k) Nonnegative-Fixnum)
-          (in-random k))]
-    [(min max) (stream-cons
-                (assert-type (random min max) Nonnegative-Fixnum)
-                (in-random min max))]))
-
-(module+ test
-  (test-case "in-random"
-    (random-seed 1)
-    (check-equal? (stream->list (stream-take (in-random 100) 10))
-                  '(50 84 10 99 94 88 43 41 63 50))
-    (check-equal? (stream->list (stream-take (in-random 50 100) 10))
-                  '(57 98 82 83 61 53 73 82 50 80))
-    (check-equal? (stream->list (stream-take (in-random) 10))
-                  '(0.2718099186980313
-                    0.7319496826374751
-                    0.17365244033739616
-                    0.5593031443038616
-                    0.3345256691289459
-                    0.9845704615094365
-                    0.05753824253751768
-                    0.22552976312818723
-                    0.21646500425988832
-                    0.15188352823997242))))
-
-(: cartesian-product-2/stream (All (a b) (-> (Sequenceof a) (Sequenceof b) (Sequenceof (Pair a b)))))
-(define (cartesian-product-2/stream s1 s2)
-  (: cp2-store (All (a b) (-> (Sequenceof a) (Sequenceof b) (Sequenceof b)
-                              (Sequenceof (Pair a b)))))
-  ;; The recursive implementation using s2-store as an accumulator.
-  ;; Main idea: combine the elements of s1 with the element of s2
-  ;; until they are exhausted, then restart with the next element of
-  ;; s1 and the original content of s2.
-  (define (cp2-store s1 s2 s2-store)
-    (cond
-      [(stream-empty? s1) (stream)]
-      [(stream-empty? s2) (cp2-store (stream-rest s1) s2-store s2-store)]
-      [else
-       (stream-cons (cons (stream-first s1) (stream-first s2))
-                    (cp2-store s1 (stream-rest s2) s2-store))]))
-  (cp2-store s1 s2 s2))
-
-(module+ test
-  (test-case "cartesian-product-2/stream"
-    (check-equal? (stream->list (cartesian-product-2/stream (in-range 1 5) '(a b)))
-                  '((1 . a) (1 . b) (2 . a) (2 . b) (3 . a) (3 . b) (4 . a) (4 . b)))
-    (check-equal?
-     (stream->list (stream-take (cartesian-product-2/stream '(a b) (in-naturals)) 10))
-     '((a . 0) (a . 1) (a . 2) (a . 3) (a . 4) (a . 5) (a . 6) (a . 7) (a . 8) (a . 9)))))
-
-(: cartesian-product/stream (All (a) (-> (Listof (Sequenceof a)) (Sequenceof (Listof a)))))
-(define (cartesian-product/stream ss)
-  (for/foldr ([prod (stream (list))])
-    ([s (in-list ss)])
-    (cartesian-product-2/stream s prod)))
-
-(module+ test
-  (test-case "cartesian-product/stream"
-    (check-equal? (stream->list (cartesian-product/stream '())) '(()))
-    (check-equal? (stream->list (cartesian-product/stream '((a b c))))
-                  '((a) (b) (c)))
-    (check-equal? (stream->list (cartesian-product/stream (list (in-range 3) (in-range 4 6) '(a b))))
-                  '((0 4 a)
-                    (0 4 b)
-                    (0 5 a)
-                    (0 5 b)
-                    (1 4 a)
-                    (1 4 b)
-                    (1 5 a)
-                    (1 5 b)
-                    (2 4 a)
-                    (2 4 b)
-                    (2 5 a)
-                    (2 5 b)))))
-
-(: boolean-power (-> Integer (Listof (Listof Boolean))))
-(define (boolean-power n)
-  (apply cartesian-product (make-list n '(#f #t))))
-
-(module+ test
-  (test-case "boolean-power"
-    (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t)))))
-
-(: boolean-power/stream (-> Integer (Sequenceof (Listof Boolean))))
-(define (boolean-power/stream n) (cartesian-product/stream (make-list n '(#f #t))))
-
-(module+ test
-  (test-case "boolean-power/stream"
-    (check-equal? (stream->list (boolean-power/stream 2)) '((#f #f) (#f #t) (#t #f) (#t #t)))))
-
-(: any->01 (-> Any (U Zero One)))
-(define (any->01 x)
-  (if x 1 0))
-
-(module+ test
-  (test-case "any->01"
-    (check-equal? (any->01 #t) 1)
-    (check-equal? (any->01 #f) 0)))
-
-(: 01->boolean (-> (U Zero One) Boolean))
-(define (01->boolean x)
-  (case x [(0) #f] [else #t]))
-
-(module+ test
-  (test-case "01->boolean"
-    (check-equal? (01->boolean 0) #f)
-    (check-equal? (01->boolean 1) #t)))
+  (test-case "pretty-print-set-sets"
+    (check-equal? (pretty-print-set-sets (set (set 'a 'b) (set 'c))) "{a b}{c}")))