Type build-interactive-process-graph.
This commit is contained in:
parent
c667f75c0e
commit
6a3bd9e7a6
2 changed files with 36 additions and 2 deletions
16
rs.rkt
16
rs.rkt
|
@ -10,7 +10,7 @@
|
||||||
str-triple->reaction ht-str-triples->rs read-org-rs read-context-sequence
|
str-triple->reaction ht-str-triples->rs read-org-rs read-context-sequence
|
||||||
reaction->str-triple rs->ht-str-triples
|
reaction->str-triple rs->ht-str-triples
|
||||||
|
|
||||||
(struct-out state) State dynamics% Dynamics%
|
(struct-out state) State dynamics% Dynamics% build-interactive-process-graph
|
||||||
)
|
)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
|
@ -222,6 +222,20 @@
|
||||||
(cons '(b) (state (set 'x) (list (set) (set 'x))))
|
(cons '(b) (state (set 'x) (list (set) (set 'x))))
|
||||||
(cons '(a) (state (set 'z) (list (set 'x))))
|
(cons '(a) (state (set 'z) (list (set 'x))))
|
||||||
(cons '(a) (state (set 'z) '()))))))
|
(cons '(a) (state (set 'z) '()))))))
|
||||||
|
|
||||||
|
(: build-interactive-process-graph (-> ReactionSystem (Listof (Setof Species)) Graph))
|
||||||
|
(define (build-interactive-process-graph rs contexts)
|
||||||
|
(send (new dynamics% [rs rs])
|
||||||
|
build-state-graph/annotated
|
||||||
|
(list (state (set) contexts))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "build-interactive-process-graph"
|
||||||
|
(define rs (hash 'a (make-reaction '(x) '(y) '(z))
|
||||||
|
'b (make-reaction '(x y) '() '(x))))
|
||||||
|
(define ctx : (Listof (Setof Species)) (list (set) (set) (set 'x)))
|
||||||
|
(check-equal? (graphviz (build-interactive-process-graph rs ctx))
|
||||||
|
"digraph G {\n\tnode0 [label=\"(state (set) '(#<set: x>))\"];\n\tnode1 [label=\"(state (set 'z) '())\"];\n\tnode2 [label=\"(state (set) '(#<set:> #<set: x>))\"];\n\tnode3 [label=\"(state (set) '(#<set:> #<set:> #<set: x>))\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"'(a)\"];\n\t\tnode2 -> node0 [label=\"'()\"];\n\t\tnode3 -> node2 [label=\"'()\"];\n\t}\n}\n")))
|
||||||
)
|
)
|
||||||
|
|
||||||
(require graph "utils.rkt" "generic.rkt")
|
(require graph "utils.rkt" "generic.rkt")
|
||||||
|
|
|
@ -2,13 +2,15 @@
|
||||||
@(require scribble/example racket/sandbox
|
@(require scribble/example racket/sandbox
|
||||||
(for-label typed/racket/base
|
(for-label typed/racket/base
|
||||||
(submod "../rs.rkt" typed)
|
(submod "../rs.rkt" typed)
|
||||||
|
"../utils.rkt"
|
||||||
"../dynamics.rkt"))
|
"../dynamics.rkt"))
|
||||||
|
|
||||||
@(define rs-evaluator
|
@(define rs-evaluator
|
||||||
(parameterize ([sandbox-output 'string]
|
(parameterize ([sandbox-output 'string]
|
||||||
[sandbox-error-output 'string]
|
[sandbox-error-output 'string]
|
||||||
[sandbox-memory-limit 500])
|
[sandbox-memory-limit 500])
|
||||||
(make-evaluator 'typed/racket #:requires '((submod "rs.rkt" typed)))))
|
(make-evaluator 'typed/racket
|
||||||
|
#:requires '((submod "rs.rkt" typed) "utils.rkt"))))
|
||||||
|
|
||||||
@(define-syntax-rule (ex . args)
|
@(define-syntax-rule (ex . args)
|
||||||
(examples #:eval rs-evaluator . args))
|
(examples #:eval rs-evaluator . args))
|
||||||
|
@ -249,3 +251,21 @@ these reactions.
|
||||||
The type of an instance of @racket[dynamics%].
|
The type of an instance of @racket[dynamics%].
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@defproc[(build-interactive-process-graph [rs ReactionSystem]
|
||||||
|
[contexts (Listof (Setof Species))])
|
||||||
|
Graph]{
|
||||||
|
|
||||||
|
Builds the state graph of the reaction system @racket[rs] driven by
|
||||||
|
the context sequence @racket[contexts].
|
||||||
|
|
||||||
|
This function directly calls @method[dds% build-state-graph/annotated]
|
||||||
|
under the hood, and is actually a light interface on top of
|
||||||
|
that function.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(let ([rs (hash 'a (make-reaction '(x) '(y) '(z))
|
||||||
|
'b (make-reaction '(x y) '() '(x)))]
|
||||||
|
[ctx : (Listof (Setof Species)) (list (set) (set) (set 'x))])
|
||||||
|
(dotit (build-interactive-process-graph rs ctx)))
|
||||||
|
]}
|
||||||
|
|
Loading…
Reference in a new issue