diff --git a/networks-tests.rkt b/networks-tests.rkt index 0406aee..48fe184 100644 --- a/networks-tests.rkt +++ b/networks-tests.rkt @@ -99,6 +99,7 @@ (test-case "Dynamics of networks" (check-equal? (pretty-print-state (st '((a . #f) (b . 3)))) "a:#f b:3") + (check-equal? (pretty-print-boolean-state (st '((a . #f) (b . #t)))) "a:0 b:1") (let ([vars '(a b c)]) (check-equal? (make-asyn vars) (set (set 'a) (set 'b) (set 'c))) (check-equal? (make-syn vars) (set (set 'a 'b 'c)))) @@ -116,7 +117,9 @@ [ss (set (st '((a . #t) (b . #t))) (st '((a . #f) (b . #t))))] [gr1 (dds-build-n-step-state-graph asyn (set s) 1)] - [gr-full (dds-build-state-graph asyn (set s))]) + [gr-full (dds-build-state-graph asyn (set s))] + [gr-full-pp (ppsg gr-full)] + [gr-full-ppb (ppsgb gr-full)]) (check-equal? (dds-step-one asyn s) (set (st '((a . #f) (b . #f))) (st '((a . #t) (b . #f))))) (check-equal? (dds-step-one-annotated asyn s) @@ -139,4 +142,9 @@ (check-true (has-edge? gr-full #hash((a . #t) (b . #f)) #hash((a . #f) (b . #f)))) (check-true (has-edge? gr-full #hash((a . #t) (b . #f)) #hash((a . #t) (b . #f)))) (check-true (has-edge? gr-full #hash((a . #f) (b . #f)) #hash((a . #t) (b . #f)))) - (check-true (has-edge? gr-full #hash((a . #f) (b . #f)) #hash((a . #f) (b . #f)))))) + (check-true (has-edge? gr-full #hash((a . #f) (b . #f)) #hash((a . #f) (b . #f)))) + + (check-true (has-vertex? gr-full-pp "a:#f b:#f")) + (check-true (has-vertex? gr-full-pp "a:#t b:#f")) + (check-true (has-vertex? gr-full-ppb "a:0 b:0")) + (check-true (has-vertex? gr-full-ppb "a:1 b:0")))) diff --git a/networks.rkt b/networks.rkt index bbd9d8d..eadc0c0 100644 --- a/networks.rkt +++ b/networks.rkt @@ -41,7 +41,12 @@ [dds-step (-> dynamics? (set/c state? #:kind 'dont-care) (set/c state?))] [dds-build-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) graph?)] [dds-build-n-step-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) number? graph?)] - [pretty-print-state (-> state? string?)]) + [pretty-print-state (-> state? string?)] + [any->boolean (-> any/c boolean?)] + [pretty-print-boolean-state (-> state? string?)] + [pretty-print-state-graph-with (-> graph? (-> state? string?) graph?)] + [pretty-print-state-graph (-> graph? graph?)] + [pretty-print-boolean-state-graph (-> graph? graph?)]) ;; Predicates (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] @@ -55,7 +60,7 @@ [update-function/c contract?] [domain-mapping/c contract?]) ;; Syntax - st nn) + st nn ppsg ppsgb) ;;; ================= @@ -304,3 +309,29 @@ ;;; Pretty-prints a state of the network. (define (pretty-print-state s) (string-join (for/list ([(key val) s]) (format "~a:~a" key val)))) + +;;; Converts any non-#f value to 1 and #f to 0. +(define (any->boolean x) (if x 1 0)) + +;;; Pretty-prints a state of the network to Boolean values 0 or 1. +(define (pretty-print-boolean-state s) + (string-join (for/list ([(key val) s]) (format "~a:~a" key (any->boolean val))))) + +;;; Given a state graph and a pretty-printer for states build a new +;;; state graph with pretty-printed vertices. +(define (pretty-print-state-graph-with gr pprinter) + (update-vertices/unweighted gr pprinter)) + +;;; Pretty prints a state graph with pretty-print-state. +(define (pretty-print-state-graph gr) + (pretty-print-state-graph-with gr pretty-print-state)) + +;;; A shortcut for pretty-print-state-graph. +(define-syntax-rule (ppsg gr) (pretty-print-state-graph gr)) + +;;; Pretty prints a state graph with pretty-print-boolean-state. +(define (pretty-print-boolean-state-graph gr) + (pretty-print-state-graph-with gr pretty-print-boolean-state)) + +;;; A shortcut for pretty-print-boolean-state-graph. +(define-syntax-rule (ppsgb gr) (pretty-print-boolean-state-graph gr))