Add table->network.

This commit is contained in:
Sergiu Ivanov 2023-03-17 23:36:50 +01:00
parent a6321c932a
commit d3907556ba
2 changed files with 45 additions and 1 deletions

View File

@ -48,7 +48,7 @@
tabulate-state+headers tabulate-state+headers/boolean
tabulate-network tabulate-network+headers
table+vars->network
table+vars->network table->network
)
(define-type (State a) (VariableMapping a))
@ -983,6 +983,37 @@
(check-false (f2 (hash 'x1 #t 'x2 #f)))
(check-true (f2 (hash 'x1 #t 'x2 #t)))
(check-equal? (network-domains n)
#hash((x1 . (#f #t)) (x2 . (#f #t))))))
(: table->network (All (a) (-> (Listof (Listof a)) (Network a))))
(define (table->network table)
(define n : Integer (quotient (length (car table)) 2))
(define var-names : (Listof Variable)
(for/list : (Listof Variable)
([i (in-range 1 (add1 n))])
(format-symbol "x~a" i)))
(table+vars->network var-names table))
(module+ test
(test-case "table->network"
(define n (table->network '((#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)
#hash((x1 . (#f #t)) (x2 . (#f #t))))))
)

View File

@ -859,6 +859,19 @@ This function does not check whether the table is complete.
(tabulate-network n))
]}
@defproc[(table->network [table (Listof (Listof a))]) (Network a)]{
Like @racket[table+vars->network], but generates variable names as
@tt{xi}, where 1 ≤ @tt{i} ≤ number of variables.
@ex[
(let ([n (table->network '((#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{TBF/TBN and SBF/SBN}