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

Type build-interactive-process-graph.

This commit is contained in:
Sergiu Ivanov 2023-08-16 14:01:17 +02:00
parent c667f75c0e
commit 6a3bd9e7a6
2 changed files with 36 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
rs.rkt
View File

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

22
scribblings/rs.scrbl
View File

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