From 9bcb5681ce1af86a44e1da4d9b8f896d79a0b1eb Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Wed, 18 Mar 2020 21:40:09 +0100 Subject: [PATCH] networks: Add table->function and table->function/list. --- networks-tests.rkt | 6 +++++- networks.rkt | 27 ++++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/networks-tests.rkt b/networks-tests.rkt index c8d827b..ffc6176 100644 --- a/networks-tests.rkt +++ b/networks-tests.rkt @@ -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))))) diff --git a/networks.rkt b/networks.rkt index 3551b91..43fd531 100644 --- a/networks.rkt +++ b/networks.rkt @@ -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))))))