From c667f75c0eb6c45e039349752182fd859172e3b2 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Wed, 16 Aug 2023 08:23:47 +0200
Subject: [PATCH] Type dynamics%.

---
 rs.rkt               | 48 +++++++++++++++++++++++++++++++++++++++++++-
 scribblings/rs.scrbl | 37 +++++++++++++++++++++++++++++++++-
 2 files changed, 83 insertions(+), 2 deletions(-)

diff --git a/rs.rkt b/rs.rkt
index 2d42879..d6fe123 100644
--- a/rs.rkt
+++ b/rs.rkt
@@ -10,7 +10,7 @@
    str-triple->reaction ht-str-triples->rs read-org-rs read-context-sequence
    reaction->str-triple rs->ht-str-triples
 
-   (struct-out state) State
+   (struct-out state) State dynamics% Dynamics%
    )
 
   (module+ test
@@ -176,6 +176,52 @@
                  [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 _'()) '()]))))
+
+  (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)))))))
+
+  (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) '()))))))
   )
 
 (require graph "utils.rkt" "generic.rkt")
diff --git a/scribblings/rs.scrbl b/scribblings/rs.scrbl
index 419637f..6e45bfe 100644
--- a/scribblings/rs.scrbl
+++ b/scribblings/rs.scrbl
@@ -1,7 +1,8 @@
 #lang scribble/manual
 @(require scribble/example racket/sandbox
 	  (for-label typed/racket/base
-	  	     (submod "../rs.rkt" typed)))
+	  	     (submod "../rs.rkt" typed)
+		     "../dynamics.rkt"))
 
 @(define rs-evaluator
   (parameterize ([sandbox-output 'string]
@@ -214,3 +215,37 @@ be applied.
 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%].
+
+}