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

networks: Add table->function and table->function/list.

This commit is contained in:
Sergiu Ivanov 2020-03-18 21:40:09 +01:00
parent 572bef8a7b
commit 9bcb5681ce
2 changed files with 31 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
networks-tests.rkt
View File

@ -214,4 +214,8 @@
(check-equal? (tabulate (λ (x y) (and x y)) '(#f #t) '(#f #t))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))
(check-equal? (tabulate/boolean (lambda (x y) (and x y)))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))
(let ([negation (table->function '((#t #f) (#f #t)))]
[negation/list (table->function/list '((#t #f) (#f #t)))])
(check-true (negation #f)) (check-false (negation #t))
(check-true (negation/list '(#f))) (check-false (negation/list '(#t)))))

27
networks.rkt
View File

@ -58,7 +58,9 @@
[build-full-boolean-state-graph-annotated (-> dynamics? graph?)]
[tabulate/domain-list (-> procedure? (listof generic-set?) (listof list?))]
[tabulate (->* (procedure?) () #:rest (listof generic-set?) (listof list?))]
[tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))])
[tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))]
[table->function (-> (listof (*list/c any/c any/c)) procedure?)]
[table->function/list (-> (listof (*list/c any/c any/c)) procedure?)])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)]
@ -409,3 +411,26 @@
;;; error to supply a function of variable arity.
(define (tabulate/boolean func)
(tabulate/domain-list func (make-list (procedure-arity func) '(#f #t))))
;;; Given a table like the one produced by the tabulate functions,
;;; creates a function which has this behaviour.
;;;
;;; More exactly, the input is a list of lists of values. All but the
;;; last elements of every list give the values of the parameters of
;;; the function, while the the last element of every list gives the
;;; value of the function. Thus, every list should have at least two
;;; elements.
;;;
;;; The produced function is implemented via lookups in hash tables,
;;; meaning that it may be sometimes more expensive to compute than by
;;; using an direct symbolic implementation.
(define (table->function table)
(λ args ((table->function/list table) args)))
;;; Like table->function, but the produced function accepts a single
;;; list of arguments instead of individual arguments.
(define (table->function/list table)
((curry hash-ref)
(for/hash ([line table])
(let-values ([(x fx) (split-at-right line 1)])
(values x (car fx))))))