scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Type tabulate-state*.

This commit is contained in:
Sergiu Ivanov 2022-09-27 00:14:25 +02:00
parent b5fef760c5
commit 3d58660e9c
2 changed files with 41 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
networks.rkt
View File

@ -38,6 +38,8 @@
build-full-state-graph/annotated
pretty-print-state pretty-print-state/01 pretty-print-state-graph-with
pretty-print-state-graph ppsg pretty-print-state-graph/01 ppsg01
tabulate-state*
)
(define-type (State a) (VariableMapping a))
@ -735,6 +737,25 @@
"digraph G {\n\tnode0 [label=\"x:#f y:#t z:#f\"];\n\tnode1 [label=\"x:#f y:#t z:#t\"];\n\tnode2 [label=\"x:#t y:#f z:#t\"];\n\tnode3 [label=\"x:#t y:#t z:#t\"];\n\tnode4 [label=\"x:#t y:#t z:#f\"];\n\tnode5 [label=\"x:#t y:#f z:#f\"];\n\tnode6 [label=\"x:#f y:#f z:#f\"];\n\tnode7 [label=\"x:#f y:#f z:#t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node6 [];\n\t\tnode1 -> node7 [];\n\t\tnode2 -> node4 [];\n\t\tnode3 -> node1 [];\n\t\tnode4 -> node0 [];\n\t\tnode5 -> node4 [];\n\t\tnode6 -> node5 [];\n\t\tnode7 -> node5 [];\n\t}\n}\n")
(check-equal? (graphviz (ppsg01 sg))
"digraph G {\n\tnode0 [label=\"x:1 y:0 z:0\"];\n\tnode1 [label=\"x:0 y:1 z:1\"];\n\tnode2 [label=\"x:0 y:0 z:1\"];\n\tnode3 [label=\"x:1 y:1 z:1\"];\n\tnode4 [label=\"x:1 y:0 z:1\"];\n\tnode5 [label=\"x:0 y:1 z:0\"];\n\tnode6 [label=\"x:0 y:0 z:0\"];\n\tnode7 [label=\"x:1 y:1 z:0\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node7 [];\n\t\tnode1 -> node2 [];\n\t\tnode2 -> node0 [];\n\t\tnode3 -> node1 [];\n\t\tnode4 -> node7 [];\n\t\tnode5 -> node6 [];\n\t\tnode6 -> node0 [];\n\t\tnode7 -> node5 [];\n\t}\n}\n"))))
(: tabulate-state* (All (a) (-> (Listof (-> (State a) a)) (DomainMapping a)
(Listof (Listof a)))))
(define (tabulate-state* funcs domains)
(for/list : (Listof (Listof a)) ([s (in-list (build-all-states domains))])
(append (hash-map s (λ ([x : Variable] [y : a]) y) #t)
(for/list : (Listof a) ([f (in-list funcs)]) (f s)))))
(module+ test
(test-case "tabulate-state*"
(define (f1 [st : (State Integer)])
(auto-hash-ref/: st (+ :a :b)))
(define (f2 [st : (State Integer)])
(auto-hash-ref/: st (- :a :b)))
(check-equal? (tabulate-state* (list f1 f2) (hash 'a '(1 2) 'b '(2 3)))
'((1 2 3 -1)
(1 3 4 -2)
(2 2 4 0)
(2 3 5 -1)))))
)
(require 'typed)

20
scribblings/networks.scrbl
View File

@ -714,6 +714,26 @@ converts it to a network.
]}
@section{Tabulating functions and networks}
@defproc[(tabulate-state* [funcs (Listof (-> (State a) a))]
[domains (DomainMapping a)])
(Listof (Listof a))]{
Like @racket[tabulate*], but the functions operate on states.
This function will produce a joint truth table of the given functions—a list of
lists, in which the first columns list all possible combinations of the values
of the input values, and the last columns give the corresponding values of the
functions. @racket[domains] defines the domains of each of the component of
the states.
@ex[
(require (only-in "utils.rkt" auto-hash-ref/:))
(let ([f1 (λ ([st : (State Integer)])
(auto-hash-ref/: st (+ :a :b)))]
[f2 (λ ([st : (State Integer)])
(auto-hash-ref/: st (- :a :b)))])
(tabulate-state* (list f1 f2) (hash 'a '(1 2) 'b '(2 3))))
]}
@section{Constructing functions and networks}