scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

rs: Add the dynamics.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-03-02 18:32:11 +01:00
parent 868988c966
commit 0bceb820df
2 changed files with 95 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
rs-tests.rkt
View file

@ -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)))))

50
rs.rkt
View file

@ -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 '())])))])