From 11c736b04b7c19432f0ed41add6fb42e84a3cdc2 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sat, 19 Aug 2023 16:33:57 +0200
Subject: [PATCH] Type build-interactive-process.

---
 rs.rkt               | 33 ++++++++++++++++++++++++++++++++-
 scribblings/rs.scrbl | 19 +++++++++++++++++++
 2 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/rs.rkt b/rs.rkt
index 5a66d42..9a41215 100644
--- a/rs.rkt
+++ b/rs.rkt
@@ -12,7 +12,7 @@
 
    (struct-out state) State dynamics% Dynamics% build-interactive-process-graph
    build-interactive-process-graph/simple-states
-   pretty-print-state-graph/simple-states
+   pretty-print-state-graph/simple-states build-interactive-process
    )
 
   (module+ test
@@ -275,6 +275,37 @@
                   (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")
       ))
+
+  (: build-interactive-process (-> ReactionSystem (Listof (Setof Species))
+                                   (Listof (Pairof (Setof Species) (Setof Species)))))
+  (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)))))
+
+  (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))))))
   )
 
 (require graph "utils.rkt" "generic.rkt")
diff --git a/scribblings/rs.scrbl b/scribblings/rs.scrbl
index 3526f3e..4ca8e63 100644
--- a/scribblings/rs.scrbl
+++ b/scribblings/rs.scrbl
@@ -309,3 +309,22 @@ explanations and examples.
   (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))
+]}