Type build-interactive-process.
This commit is contained in:
parent
a18620e694
commit
11c736b04b
2 changed files with 51 additions and 1 deletions
33
rs.rkt
33
rs.rkt
|
@ -12,7 +12,7 @@
|
||||||
|
|
||||||
(struct-out state) State dynamics% Dynamics% build-interactive-process-graph
|
(struct-out state) State dynamics% Dynamics% build-interactive-process-graph
|
||||||
build-interactive-process-graph/simple-states
|
build-interactive-process-graph/simple-states
|
||||||
pretty-print-state-graph/simple-states
|
pretty-print-state-graph/simple-states build-interactive-process
|
||||||
)
|
)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
|
@ -275,6 +275,37 @@
|
||||||
(build-interactive-process-graph/simple-states rs ctx)))
|
(build-interactive-process-graph/simple-states rs ctx)))
|
||||||
"digraph G {\n\tnode0 [label=\"{}\"];\n\tnode1 [label=\"{z}\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"a\"];\n\t}\n}\n")
|
"digraph G {\n\tnode0 [label=\"{}\"];\n\tnode1 [label=\"{z}\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"a\"];\n\t}\n}\n")
|
||||||
))
|
))
|
||||||
|
|
||||||
|
(: build-interactive-process (-> ReactionSystem (Listof (Setof Species))
|
||||||
|
(Listof (Pairof (Setof Species) (Setof Species)))))
|
||||||
|
(define (build-interactive-process rs contexts)
|
||||||
|
(define dyn (new dynamics% [rs rs]))
|
||||||
|
(define padded-contexts
|
||||||
|
(append contexts (list (assert-type (set) (Setof Species)))))
|
||||||
|
(for/fold ([proc : (Listof (Pairof (Setof Species) (Setof Species))) '()]
|
||||||
|
[st : State (state (set) padded-contexts)]
|
||||||
|
#:result (reverse proc))
|
||||||
|
([c padded-contexts])
|
||||||
|
(define res (state-result st))
|
||||||
|
(define ctx (state-rest-contexts st))
|
||||||
|
(values
|
||||||
|
((inst cons (Pairof (Setof Species) (Setof Species)))
|
||||||
|
(cons (if (empty? ctx) (assert-type (set) (Setof Species)) (car ctx)) res)
|
||||||
|
proc)
|
||||||
|
(set-first (send dyn step st)))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "build-interactive-process"
|
||||||
|
(define rs (hash 'a (make-reaction '(x) '(y) '(z))
|
||||||
|
'b (make-reaction '(x y) '() '(x))))
|
||||||
|
(define ctx : (Listof (Setof Species)) (list (set 'x 'y) (set) (set 'x) (set)))
|
||||||
|
(check-equal? (build-interactive-process rs ctx)
|
||||||
|
(list
|
||||||
|
(cons (set 'y 'x) (set))
|
||||||
|
(cons (set) (set 'x))
|
||||||
|
(cons (set 'x) (set 'z))
|
||||||
|
(cons (set) (set 'z))
|
||||||
|
(cons (set) (set))))))
|
||||||
)
|
)
|
||||||
|
|
||||||
(require graph "utils.rkt" "generic.rkt")
|
(require graph "utils.rkt" "generic.rkt")
|
||||||
|
|
|
@ -309,3 +309,22 @@ explanations and examples.
|
||||||
(dotit (pretty-print-state-graph/simple-states
|
(dotit (pretty-print-state-graph/simple-states
|
||||||
(build-interactive-process-graph/simple-states rs ctx))))
|
(build-interactive-process-graph/simple-states rs ctx))))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(build-interactive-process [rs ReactionSystem]
|
||||||
|
[ctx (Listof (Setof Species))])
|
||||||
|
(Listof (Pairof (Setof Species) (Setof Species)))]{
|
||||||
|
|
||||||
|
Builds the interactive process driven by the given context sequence.
|
||||||
|
|
||||||
|
The output is a list of pairs of lists in which the first element is
|
||||||
|
the current context and the second element is the result of the
|
||||||
|
application of reactions to the previous state. The interactive
|
||||||
|
process stops one step after the end of the context sequence, to show
|
||||||
|
the effect of the last context.
|
||||||
|
|
||||||
|
@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))])
|
||||||
|
(build-interactive-process rs ctx))
|
||||||
|
]}
|
||||||
|
|
Loading…
Reference in a new issue