From b9b224fc6a46862919df6fc87337563ead4d8b5c Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Fri, 17 Feb 2023 14:06:33 +0100
Subject: [PATCH] Add tabulate-network and tabulate-network+headers.

---
 networks.rkt               | 51 +++++++++++++++++++++++++++++++++++++-
 scribblings/networks.scrbl | 20 +++++++++++++++
 2 files changed, 70 insertions(+), 1 deletion(-)

diff --git a/networks.rkt b/networks.rkt
index 26cd3c5..9c4f6f8 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -4,6 +4,8 @@
   (require "utils.rkt" "functions.rkt" "dynamics.rkt"
            typed/graph racket/random
            syntax/parse/define)
+  (require/typed racket/syntax
+    [format-symbol (-> String Any * Symbol)])
 
   (module+ test
     (require typed/rackunit)
@@ -44,6 +46,7 @@
    tabulate-state*+headers tabulate-state*+headers/boolean
    tabulate-state tabulate-state/boolean
    tabulate-state+headers tabulate-state+headers/boolean
+   tabulate-network tabulate-network+headers
    )
 
   (define-type (State a) (VariableMapping a))
@@ -879,7 +882,53 @@
                       (#f #t #f)
                       (#t #f #f)
                       (#t #t #t)))))
-  )
+
+  (: tabulate-network (All (a) (-> (Network a) (Listof (Listof a)))))
+  (define (tabulate-network network)
+    (define funcs (hash-map (network-functions network)
+                            (λ (_ [fx : (UpdateFunction a)]) fx)
+                            #t))
+    (tabulate-state* funcs (network-domains network)))
+
+  (module+ test
+    (test-case "tabulate-network"
+      (define bn (forms->boolean-network (hash 'a '(not a) 'b 'b)))
+      (check-equal? (tabulate-network bn)
+                    '((#f #f #t #f)
+                      (#f #t #t #t)
+                      (#t #f #f #f)
+                      (#t #t #f #t)))))
+
+  (: tabulate-network+headers (All (a) (-> (Network a)
+                                           (Pairof (Listof Symbol)
+                                                   (Listof (Listof a))))))
+  (define (tabulate-network+headers network)
+    (define-values (vars funcs)
+      (for/lists ([l1 : (Listof Variable)]
+                  [l2 : (Listof (UpdateFunction a))])
+                 ([p (hash-map (network-functions network)
+                               (inst cons Variable (UpdateFunction a))
+                               #t)])
+        (values (car p) (cdr p))))
+
+    (define fnames : (Listof Variable)
+      (for/list ([v vars]) (format-symbol "f-~a" v)))
+
+    (match (tabulate-state*+headers funcs (network-domains network))
+      [(list headers tab ...)
+       (cons (append (take headers (length fnames)) fnames)
+             tab)]))
+
+  (module+ test
+    (test-case "tabulate-network+headers"
+      (define bn (forms->boolean-network (hash 'a '(not a) 'b 'b)))
+      (check-equal? (tabulate-network+headers bn)
+                    '((a b f-a f-b)
+                      (#f #f #t #f)
+                      (#f #t #t #t)
+                      (#t #f #f #f)
+                      (#t #t #f #t)))))
+    )
 
 (require 'typed)
 
diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl
index ca6b753..ca94b0b 100644
--- a/scribblings/networks.scrbl
+++ b/scribblings/networks.scrbl
@@ -810,6 +810,26 @@ function instead of a list.
  '(a b))
 ]}
 
+@defproc[(tabulate-network [network (Network a)]) (Listof (Listof a))]{
+
+Tabulates all the functions of @racket[network], producing an output
+similar to that of @racket[tabulate-state*].
+
+@ex[
+(tabulate-network (forms->boolean-network (hash 'a '(not a) 'b 'b)))
+]}
+
+@defproc[(tabulate-network+headers [network (Network a)]) (Listof (Listof a))]{
+
+Tabulates all the functions of @racket[network], producing an output
+similar to that of @racket[tabulate-state*+headers] , except that the
+function names in the corresponding column headers are of the form
+@tt{f-x}, where @tt{x} is the name of the corresponding variable.
+
+@ex[
+(tabulate-network+headers (forms->boolean-network (hash 'a '(not a) 'b 'b)))
+]}
+
 @section{Constructing functions and networks}
 
 @section{Random functions and networks}