diff --git a/networks.rkt b/networks.rkt index ba422d7..7ec0bd9 100644 --- a/networks.rkt +++ b/networks.rkt @@ -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)))))) ) diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 4c3e057..e1e88f8 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -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}