From c8230014923d846c61c50842316c26d9418959ee Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 22 Mar 2020 19:22:54 +0100
Subject: [PATCH] networks: Add tabulate-network and tabulate-boolean-network.

---
 networks-tests.rkt |  7 ++++++-
 networks.rkt       | 29 +++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/networks-tests.rkt b/networks-tests.rkt
index 2dacb7a..23b5764 100644
--- a/networks-tests.rkt
+++ b/networks-tests.rkt
@@ -216,7 +216,12 @@
   (check-equal? (tabulate/boolean (lambda (x y) (and x y)))
                 '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))
   (let ([func (λ (st) (not (hash-ref st 'a)))])
-    (check-equal? (tabulate-state/boolean func '(a)) '((a f) (#f #t) (#t #f)))))
+    (check-equal? (tabulate-state/boolean func '(a)) '((a f) (#f #t) (#t #f))))
+  (let ([bn (nn #hash((a . (not a)) (b . b)))])
+    (check-equal? (tabulate-boolean-network bn)
+                  '((a b f-a f-b) (#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t)))
+    (check-equal? (tabulate-boolean-network bn #:headers #f)
+                  '((#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t)))))
 
 (test-case "Constructing functions"
   (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t)))
diff --git a/networks.rkt b/networks.rkt
index f7229a7..1df35b4 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -63,6 +63,10 @@
                                     (listof (listof any/c)))]
                [tabulate-state/boolean (->* (procedure? (listof variable?)) (#:headers boolean?)
                                             (listof (listof any/c)))]
+               [tabulate-network (->* (network? domain-mapping/c) (#:headers boolean?)
+                                      (listof (listof any/c)))]
+               [tabulate-boolean-network (->* (network?) (#:headers boolean?)
+                                              (listof (listof any/c)))]
                [table->function (-> (listof (*list/c any/c any/c)) procedure?)]
                [table->function/list (-> (listof (*list/c any/c any/c)) procedure?)]
                [boolean-power (-> number? (listof (listof boolean?)))]
@@ -446,6 +450,31 @@
 (define (tabulate-state/boolean func args #:headers [headers #t])
   (tabulate-state func (make-boolean-domains args) #:headers headers))
 
+;;; Tabulates a given network.
+;;;
+;;; For a Boolean network with n variables, returns a table with 2n
+;;; columns and 2^n rows.  The first n columns correspond to the
+;;; different values of the variables of the networks.  The last n
+;;; columns represent the values of the n update functions of the
+;;; network.  If headers is #t, prepends a list of variable names and
+;;; update functions (f-x, where x is the name of the corresponding
+;;; variable) to the result.
+(define (tabulate-network network domains #:headers [headers #t])
+  (define funcs (hash-map network (λ (x y) y) #t))
+  (define tab (for/list ([st (build-all-states domains)])
+                (append (hash-map st (λ (x y) y) #t)
+                        (for/list ([f funcs]) (f st)))))
+  (cond
+    [headers
+     (define var-names (hash-map network (λ (x y) x) #t))
+     (define func-names (for/list ([x var-names]) (string->symbol (format "f-~a" x))))
+     (cons (append var-names func-names) tab)]
+    [else tab]))
+
+;;; Like tabulate-network, but assumes all the variables are Boolean.
+(define (tabulate-boolean-network bn #:headers [headers #t])
+  (tabulate-network bn (make-boolean-domains (hash-map bn (λ (x y) x) #t))
+                    #:headers headers))
 
 ;;; ======================
 ;;; Constructing functions