rs: Add build-interactive-process.

This commit is contained in:
Sergiu Ivanov 2020-03-02 23:50:32 +01:00
parent d753409a2f
commit de9b703b44
2 changed files with 15 additions and 3 deletions

View file

@ -32,7 +32,8 @@
[rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))] [rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))]
[dyn (dynamics rs)] [dyn (dynamics rs)]
[state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))] [state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))]
[sgr (dds-build-state-graph-annotated dyn (set state1))]) [sgr (dds-build-state-graph-annotated dyn (set state1))]
[ip (build-interactive-process rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))])
(check-equal? (dds-step-one-annotated dyn state1) (check-equal? (dds-step-one-annotated dyn state1)
(set (cons (set (cons
(set 'a 'b) (set 'a 'b)
@ -70,4 +71,6 @@
(check-equal? (edge-weight sgr (check-equal? (edge-weight sgr
(state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))) (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
(state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))) (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))
(set (set 'a 'b))))) (set (set 'a 'b)))
(check-equal? sgr ip)))

11
rs.rkt
View file

@ -25,7 +25,8 @@
[dds-build-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) graph?)] [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-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-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?)]) [dds-build-n-step-state-graph-annotated (-> dynamics? (set/c state? #:kind 'dont-care) number? graph?)]
[build-interactive-process (-> reaction-system/c (listof (set/c species?)) graph?)])
;; Predicates ;; Predicates
(contract-out [species? (-> any/c boolean?)]) (contract-out [species? (-> any/c boolean?)])
;; Contracts ;; Contracts
@ -162,3 +163,11 @@
(apply-rs-annotate (set-union res ctx) rest-ctx)] (apply-rs-annotate (set-union res ctx) rest-ctx)]
[(state res '()) [(state res '())
(apply-rs-annotate res '())])))]) (apply-rs-annotate res '())])))])
;;; Builds the state graph of a reaction system driven by a given
;;; context sequence. When the context sequence is exhausted, keeps
;;; running the system without contexts. In other words, the context
;;; sequence is padded with empty contexts at the end.
(define (build-interactive-process rs contexts)
(dds-build-state-graph-annotated (dynamics rs)
(set (state (set) contexts))))