From 181b427cd8853c82ad1769e5588d324b7c7fe412 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Tue, 3 May 2022 21:41:50 +0200
Subject: [PATCH] Add update-function-form->update-function/boolean and
 update-function-form->update-function/01.

---
 networks.rkt               | 22 ++++++++++++++++++++++
 scribblings/networks.scrbl | 27 +++++++++++++++++++++++++++
 2 files changed, 49 insertions(+)

diff --git a/networks.rkt b/networks.rkt
index d8b0938..edf9a51 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -17,6 +17,8 @@
 
    UpdateFunctionForm (struct-out network-form) NetworkForm
    update-function-form->update-function/any
+   update-function-form->update-function/boolean
+   update-function-form->update-function/01
    )
 
   (define-type (State a) (VariableMapping a))
@@ -134,6 +136,26 @@
       (define s (hash 'x #t 'y #f))
       (define f (update-function-form->update-function/any '(and x y)))
       (check-equal? (f s) #f)))
+
+  (: update-function-form->update-function/boolean (-> UpdateFunctionForm (UpdateFunction Boolean)))
+  (define (update-function-form->update-function/boolean form)
+    (λ (s) (assert-type (eval1-with s form) Boolean)))
+
+  (module+ test
+    (test-case "update-function-form->update-function/boolean"
+      (define s (hash 'x #t 'y #f))
+      (define f (update-function-form->update-function/boolean '(and x y)))
+      (check-equal? (f s) #f)))
+
+  (: update-function-form->update-function/01 (-> UpdateFunctionForm (UpdateFunction (U Zero One))))
+  (define (update-function-form->update-function/01 form)
+    (λ (s) (assert-type (eval1-with s form) (U Zero One))))
+
+  (module+ test
+    (test-case "update-function-form->update-function/01"
+      (define s (hash 'x 0 'y 1))
+      (define f (update-function-form->update-function/01 '(max x y)))
+      (check-equal? (f s) 1)))
   )
 
 (require 'typed)
diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl
index 9de4846..a412542 100644
--- a/scribblings/networks.scrbl
+++ b/scribblings/networks.scrbl
@@ -245,6 +245,33 @@ Builds an update function from an update function form.
 (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.
+
+@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))
+]}
 
 @section{Inferring interaction graphs}