Type dynamics%.

This commit is contained in:
Sergiu Ivanov 2023-08-16 08:23:47 +02:00
parent b2bc06646e
commit c667f75c0e
2 changed files with 83 additions and 2 deletions

48
rs.rkt
View file

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

View file

@ -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%].
}