From 0bceb820dfb79936435a98f82af511a8dce948dd Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 2 Mar 2020 18:32:11 +0100 Subject: [PATCH] rs: Add the dynamics. --- rs-tests.rkt | 48 +++++++++++++++++++++++++++++++++++++++++++++++- rs.rkt | 50 ++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 95 insertions(+), 3 deletions(-) diff --git a/rs-tests.rkt b/rs-tests.rkt index a900178..9d3b6ea 100644 --- a/rs-tests.rkt +++ b/rs-tests.rkt @@ -2,7 +2,7 @@ ;;; Tests for dds/rs. -(require rackunit "rs.rkt") +(require rackunit graph "rs.rkt" "utils.rkt") (test-case "Basic definitions" (let* ([r1 (reaction (set 'x) (set 'y) (set 'z))] @@ -23,3 +23,49 @@ (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z)))))) (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"))))) + +(test-case "Dynamics of reaction systems" + (let* ([r1 (reaction (set 'x) (set 'y) (set 'z))] + [r2 (reaction (set 'x) (set) (set 'y))] + [rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))] + [dyn (dynamics rs)] + [state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))] + [sgr (dds-build-state-graph-annotated dyn (set state1))]) + (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-equal? (edge-weight sgr + (state (set) '()) + (state (set) '())) + (set (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))))) diff --git a/rs.rkt b/rs.rkt index d2db293..a782805 100644 --- a/rs.rkt +++ b/rs.rkt @@ -4,18 +4,27 @@ ;;; Definitions for working with reaction systems. -(require "utils.rkt") +(require graph "utils.rkt" "generic.rkt") (provide ;; 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)] - [rs->ht-str-triples (-> reaction-system/c (hash/c symbol? (list/c string? string? string?)))]) + [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?)]) ;; Predicates (contract-out [species? (-> any/c boolean?)]) ;; Contracts @@ -115,3 +124,40 @@ ;;; A shortcut for rs->ht-str-triples. (define-syntax-rule (org-rs rs) (rs->ht-str-triples rs)) + + +;;; ============================ +;;; Dynamics of reaction systems +;;; ============================ + +;;; 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. + +;;; 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. +(struct state (result rest-contexts) #:transparent) + +;;; 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 + ;; always produced. It is annotated by the list of rules which + ;; were enabled in the current step. + (define (dds-step-one-annotated dyn st) + (let* ([rs (dynamics-rs dyn)] + [apply-rs-annotate + (λ (s rest-ctx) + (let ([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 '()) + (apply-rs-annotate res '())])))])