From f88bc0d01bde6db871c4805412a59b1cc8890529 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 23 Feb 2020 19:44:55 +0100
Subject: [PATCH] networks: Add further infrastructure for pretty-printing
 networks.

---
 networks-tests.rkt | 12 ++++++++++--
 networks.rkt       | 35 +++++++++++++++++++++++++++++++++--
 2 files changed, 43 insertions(+), 4 deletions(-)

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