From 53e49818459aeda5904151fdc007a97c44690a16 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Fri, 11 Nov 2022 11:52:27 +0100
Subject: [PATCH] Add tabulate-state*+headers, tabulate-state*+headers/boolean.

---
 networks.rkt               | 43 ++++++++++++++++++++++++++++++++++++++
 scribblings/networks.scrbl | 28 +++++++++++++++++++++++++
 2 files changed, 71 insertions(+)

diff --git a/networks.rkt b/networks.rkt
index 77aed68..b1a7d6b 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -40,6 +40,7 @@
    pretty-print-state-graph ppsg pretty-print-state-graph/01 ppsg01
 
    tabulate-state* tabulate-state*/boolean
+   tabulate-state*+headers tabulate-state*+headers/boolean
    )
 
   (define-type (State a) (VariableMapping a))
@@ -755,6 +756,31 @@
                       (2 2 4  0)
                       (2 3 5 -1)))))
 
+  (: tabulate-state*+headers
+     (All (a) (-> (Listof (-> (State a) a)) (DomainMapping a)
+                  (Pairof (Listof Symbol) (Listof (Listof a))))))
+  (define (tabulate-state*+headers funcs domains)
+    (define var-names : (Listof Symbol)
+      (hash-map domains (λ ([x : Symbol] _) x) #t))
+    (define func-names : (Listof Symbol)
+      (for/list ([_ funcs]
+                 [i (in-naturals 1)])
+        (string->symbol (~a 'f i))))
+    (cons (append var-names func-names)
+          (tabulate-state* funcs domains)))
+
+  (module+ test
+    (test-case "tabulate-state*+headers"
+      (define/: f1 (State Integer) (+ :a :b))
+      (define/: f2 (State Integer) (- :a :b))
+      (check-equal?
+       (tabulate-state*+headers (list f1 f2) (hash 'a '(1 2) 'b '(2 3)))
+       '((a b f1 f2)
+         (1 2 3 -1)
+         (1 3 4 -2)
+         (2 2 4 0)
+         (2 3 5 -1)))))
+
   (: tabulate-state*/boolean
      (-> (Listof (-> (State Boolean) Boolean)) (Listof Variable)
          (Listof (Listof Boolean))))
@@ -770,6 +796,23 @@
                       (#f #t #f #t)
                       (#t #f #f #t)
                       (#t #t #t #t)))))
+
+  (: tabulate-state*+headers/boolean
+     (-> (Listof (-> (State Boolean) Boolean)) (Listof Variable)
+         (Pairof (Listof Symbol) (Listof (Listof Boolean)))))
+  (define (tabulate-state*+headers/boolean funcs args)
+    (tabulate-state*+headers funcs (make-boolean-domains args)))
+
+  (module+ test
+    (test-case "tabulate-state*+headers/boolean"
+      (define/: f1 (State Boolean) (and :a :b))
+      (define/: f2 (State Boolean) (or :a :b))
+      (check-equal? (tabulate-state*+headers/boolean (list f1 f2) '(a b))
+                    '((a b f1 f2)
+                      (#f #f #f #f)
+                      (#f #t #f #t)
+                      (#t #f #f #t)
+                      (#t #t #t #t)))))
   )
 
 (require 'typed)
diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl
index e799c08..4f970eb 100644
--- a/scribblings/networks.scrbl
+++ b/scribblings/networks.scrbl
@@ -733,6 +733,19 @@ the states.
                  (hash 'a '(1 2) 'b '(2 3)))
 ]}
 
+@defproc[(tabulate-state*+headers [funcs (Listof (-> (State a) a))]
+				  [domains (DomainMapping a)])
+				  (Pairof (Listof Symbol) (Listof (Listof a)))]{
+
+Like @racket[tabulate-state*], but the first line of the result lists the names
+of the variables and the functions.
+
+@ex[
+(tabulate-state*+headers (list (λ/: (State Integer) (+ :a :b))
+                               (λ/: (State Integer) (- :a :b)))
+                         (hash 'a '(1 2) 'b '(2 3)))
+]}
+
 @defproc[(tabulate-state*/boolean [funcs (Listof (-> State Boolean) Boolean)]
 				  [args (Listof Variable)])
 				  (Listof (Listof Boolean))]{
@@ -747,6 +760,21 @@ containing the variables appearing on this list.
                          '(a b))
 ]}
 
+@defproc[(tabulate-state*+headers/boolean
+		[funcs (Listof (-> State Boolean) Boolean)]
+		[args (Listof Variable)])
+		(Pairof (Listof Symbol) (Listof (Listof Boolean)))]{
+
+Like @racket[tabulate-state*+headers], but the functions operate on Boolean
+states, like @racket[tabulate-state*].
+
+@ex[
+(tabulate-state*+headers/boolean
+ (list (λ/: (State Boolean) (and :a :b))
+       (λ/: (State Boolean) (or :a :b)))
+ '(a b))
+]}
+
 @section{Constructing functions and networks}
 
 @section{Random functions and networks}