table->network → table+vars->network

This commit is contained in:
Sergiu Ivanov 2023-03-17 23:03:50 +01:00
parent 9175a98a2a
commit a6321c932a
2 changed files with 25 additions and 27 deletions

View file

@ -48,7 +48,7 @@
tabulate-state+headers tabulate-state+headers/boolean tabulate-state+headers tabulate-state+headers/boolean
tabulate-network tabulate-network+headers tabulate-network tabulate-network+headers
table->network table+vars->network
) )
(define-type (State a) (VariableMapping a)) (define-type (State a) (VariableMapping a))
@ -931,15 +931,10 @@
(#t #f #f #f) (#t #f #f #f)
(#t #t #f #t))))) (#t #t #f #t)))))
(: table->network (All (a) (-> (Listof (Listof a)) (Network a)))) (: table+vars->network (All (a) (-> (Listof Variable) (Listof (Listof a))
(define (table->network table) (Network a))))
(define (table+vars->network var-names table)
(define n : Integer (quotient (length (car table)) 2)) (define n : Integer (quotient (length (car table)) 2))
;; Get the variable names from the table or generate them, if
;; necessary.
(define var-names : (Listof Variable)
(for/list : (Listof Variable)
([i (in-range 1 (add1 n))])
(format-symbol "x~a" i)))
;; Split the table into the inputs and the outputs of the functions. ;; Split the table into the inputs and the outputs of the functions.
(define-values (ins outs) (multi-split-at table n)) (define-values (ins outs) (multi-split-at table n))
;; Transpose outs to have functions define by lines instead of by ;; Transpose outs to have functions define by lines instead of by
@ -969,11 +964,12 @@
domains)) domains))
(module+ test (module+ test
(test-case "table->network" (test-case "table+vars->network"
(define n (table->network '((#f #f #f #f) (define n (table+vars->network '(x1 x2)
(#f #t #f #t) '((#f #f #f #f)
(#t #f #t #f) (#f #t #f #t)
(#t #t #t #t)))) (#t #f #t #f)
(#t #t #t #t))))
(define f1 (hash-ref (network-functions n) 'x1)) (define f1 (hash-ref (network-functions n) 'x1))
(define f2 (hash-ref (network-functions n) 'x2)) (define f2 (hash-ref (network-functions n) 'x2))

View file

@ -832,17 +832,18 @@ function names in the corresponding column headers are of the form
@section{Constructing functions and networks} @section{Constructing functions and networks}
@defproc[(table->network [table (Listof (Listof a))]) @defproc[(table+vars->network [var-names (Listof Variable)]
(Network a)]{ [table (Listof (Listof a))])
(Network a)]{
Given a table like the one produced by @racket[tabulate-network], Given a @racket[table] like the one produced by
constructs a network having this behaviour. @racket[tabulate-network] and the list of variable names
@racket[var-names], constructs a network having this behaviour.
Variable names are generated as @tt{xi}, where 1 ≤ @tt{i} ≤ number of The columns defining the functions are taken to be in the same order
variables. The columns defining the functions are taken to be in the as the columns defining the variables. The domains of the network are
same order as the columns defining the variables. The domains of the a mapping assigning to each variable the set of values which can
network are a mapping assigning to each variable the set of values appear in the corresponding column in the table.
which can appear in the corresponding column in the table.
This function relies on @racket[table->unary-function], so the same This function relies on @racket[table->unary-function], so the same
performance caveats apply. performance caveats apply.
@ -850,10 +851,11 @@ performance caveats apply.
This function does not check whether the table is complete. This function does not check whether the table is complete.
@ex[ @ex[
(let ([n (table->network '((#f #f #f #f) (let ([n (table+vars->network '(a b)
(#f #t #f #t) '((#f #f #f #f)
(#t #f #t #f) (#f #t #f #t)
(#t #t #t #t)))]) (#t #f #t #f)
(#t #t #t #t)))])
(tabulate-network n)) (tabulate-network n))
]} ]}