Add table+headers->network.

This commit is contained in:
Sergiu Ivanov 2023-03-23 16:16:02 +01:00
parent d3907556ba
commit abf8d4cf92
2 changed files with 52 additions and 1 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+vars->network table->network table+vars->network table->network table+headers->network
) )
(define-type (State a) (VariableMapping a)) (define-type (State a) (VariableMapping a))
@ -1014,6 +1014,38 @@
(check-false (f2 (hash 'x1 #t 'x2 #f))) (check-false (f2 (hash 'x1 #t 'x2 #f)))
(check-true (f2 (hash 'x1 #t 'x2 #t))) (check-true (f2 (hash 'x1 #t 'x2 #t)))
(check-equal? (network-domains n)
#hash((x1 . (#f #t)) (x2 . (#f #t))))))
(: table+headers->network (All (a) (-> (Pairof (Listof Symbol) (Listof (Listof a)))
(Network a))))
(define (table+headers->network table)
(define headers : (Listof Symbol) (car table))
(define var-names : (Listof Variable)
(drop-right headers (quotient (length headers) 2)))
(table+vars->network var-names (cdr table)))
(module+ test
(test-case "table+headers->network"
(define n (table+headers->network
'((x1 x2 f1 f2)
(#f #f #f #f)
(#f #t #f #t)
(#t #f #t #f)
(#t #t #t #t))))
(define f1 (hash-ref (network-functions n) 'x1))
(define f2 (hash-ref (network-functions n) 'x2))
(check-false (f1 (hash 'x1 #f 'x2 #f)))
(check-false (f1 (hash 'x1 #f 'x2 #t)))
(check-true (f1 (hash 'x1 #t 'x2 #f)))
(check-true (f1 (hash 'x1 #t 'x2 #t)))
(check-false (f2 (hash 'x1 #f 'x2 #f)))
(check-true (f2 (hash 'x1 #f 'x2 #t)))
(check-false (f2 (hash 'x1 #t 'x2 #f)))
(check-true (f2 (hash 'x1 #t 'x2 #t)))
(check-equal? (network-domains n) (check-equal? (network-domains n)
#hash((x1 . (#f #t)) (x2 . (#f #t)))))) #hash((x1 . (#f #t)) (x2 . (#f #t))))))
) )

View file

@ -872,6 +872,25 @@ Like @racket[table+vars->network], but generates variable names as
(network-domains n)) (network-domains n))
]} ]}
@defproc[(table+headers->network [table (Pairof (Listof Symbol) (Listof (Listof a)))])
(Network a)]{
Like @racket[table+vars->network], but the variable names are taken
from the first line of @racket[table].
The lines of @racket[table] are taken to be of the same length, so it
is assumed that half of the first line contain variable names, and the
other half function names. Function names are discarded.
@ex[
(let ([n (table+headers->network '((a b fa fb)
(#f #f #f #f)
(#f #t #f #t)
(#t #f #t #f)
(#t #t #t #t)))])
(network-domains n))
]}
@section{Random functions and networks} @section{Random functions and networks}
@section{TBF/TBN and SBF/SBN} @section{TBF/TBN and SBF/SBN}