rs: Add build-reduced-state-graph.

This commit is contained in:
Sergiu Ivanov 2020-11-10 09:42:50 +01:00
parent 4f3eef0ba3
commit ce0d5023bf

19
rs.rkt
View file

@ -28,6 +28,7 @@
[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-graph (-> reaction-system/c (listof (set/c species?)) graph?)] [build-interactive-process-graph (-> reaction-system/c (listof (set/c species?)) graph?)]
[build-reduced-state-graph (-> reaction-system/c (listof (set/c species?)) graph?)]
[build-interactive-process (-> reaction-system/c (listof (set/c species?)) (listof (list/c (set/c species?) (set/c species?))))] [build-interactive-process (-> reaction-system/c (listof (set/c species?)) (listof (list/c (set/c species?) (set/c species?))))]
[pretty-print-state-graph (-> graph? graph?)]) [pretty-print-state-graph (-> graph? graph?)])
;; Predicates ;; Predicates
@ -210,6 +211,24 @@
(dds-build-state-graph-annotated (dynamics rs) (dds-build-state-graph-annotated (dynamics rs)
(set (state (set) contexts)))) (set (state (set) contexts))))
;;; Builds the reduced state graph of a reaction system driven by
;;; a given context sequence. Unlike build-interactive-process-graph,
;;; the nodes of this state graph do not contain the context sequence.
(define (build-reduced-state-graph rs contexts)
(define sgr (build-interactive-process-graph rs contexts))
(weighted-graph/directed
(for/list ([e (in-edges sgr)])
(define u (car e)) (define v (cadr e))
(list (edge-weight sgr u v) (state-result u) (state-result v)))))
(module+ test
(test-case "build-reduced-state-graph"
(define rs (hash 'a (reaction (set 'x) (set 'y) (set 'z))
'b (reaction (set 'x) (set) (set 'y))))
(define ctx (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
(check-equal? (graphviz (build-reduced-state-graph rs ctx))
"digraph G {\n\tnode0 [label=\"(set)\\n\"];\n\tnode1 [label=\"(set 'y 'z)\\n\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"#<set: #<set:>>\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"#<set: #<set: a b>>\"];\n\t\tnode1 -> node0 [label=\"#<set: #<set:>>\"];\n\t}\n}\n")))
;;; Builds the interactive process driven by the given context ;;; Builds the interactive process driven by the given context
;;; sequence. The output is a list of pairs of lists in which the ;;; 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 ;;; first element is the current context and the second element is the