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

networks: Add tabulate-state and tabulate-state/boolean.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-03-22 14:34:40 +01:00
parent f0ac9223e4
commit 5358f9bf57
2 changed files with 28 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
networks-tests.rkt
View file

@ -215,6 +215,8 @@
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))) '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))
(check-equal? (tabulate/boolean (lambda (x y) (and x y))) (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 ([func (λ (st) (not (hash-ref st 'a)))])
(check-equal? (tabulate-state/boolean func '(a)) '((a f) (#f #t) (#t #f))))
(check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t))) (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t)))
(check-equal? (stream->list (boolean-power/stream 2)) '((#f #f) (#f #t) (#t #f) (#t #t))) (check-equal? (stream->list (boolean-power/stream 2)) '((#f #f) (#f #t) (#t #f) (#t #t)))
(let ([negation (table->function '((#t #f) (#f #t)))] (let ([negation (table->function '((#t #f) (#f #t)))]

26
networks.rkt
View file

@ -59,6 +59,10 @@
[tabulate/domain-list (-> procedure? (listof generic-set?) (listof list?))] [tabulate/domain-list (-> procedure? (listof generic-set?) (listof list?))]
[tabulate (->* (procedure?) () #:rest (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?)))]
[tabulate-state (->* (procedure? domain-mapping/c) (#:headers boolean?)
(listof (listof any/c)))]
[tabulate-state/boolean (->* (procedure? (listof variable?)) (#:headers boolean?)
(listof (listof any/c)))]
[table->function (-> (listof (*list/c any/c any/c)) procedure?)] [table->function (-> (listof (*list/c any/c any/c)) procedure?)]
[table->function/list (-> (listof (*list/c any/c any/c)) procedure?)] [table->function/list (-> (listof (*list/c any/c any/c)) procedure?)]
[boolean-power (-> number? (listof (listof boolean?)))] [boolean-power (-> number? (listof (listof boolean?)))]
@ -418,6 +422,28 @@
(define (tabulate/boolean func) (define (tabulate/boolean func)
(tabulate/domain-list func (make-list (procedure-arity func) '(#f #t)))) (tabulate/domain-list func (make-list (procedure-arity func) '(#f #t))))
;;; Like tabulate, but supposes that the function works on states.
;;;
;;; The argument domains defines the domains of each of the component
;;; of the states. If headers it true, the resulting list starts with
;;; a listing the names of the variables of the domain and ending with
;;; the symbol 'f, which indicates the values of the function.
(define (tabulate-state func domains #:headers [headers #t])
(define (st-vals st) (hash-map st (λ (x y) y) #t))
(define tab (for/list ([st (build-all-states domains)])
(append (st-vals st) (list (func st)))))
(cond
[headers
(define vars (append (hash-map domains (λ (x y) x) #t) '(f)))
(cons vars tab)]
[else tab]))
;;; Like tabulate-state, but assumes the function is a Boolean
;;; function. args is a list of names of the arguments which can
;;; appear in the states.
(define (tabulate-state/boolean func args #:headers [headers #t])
(tabulate-state func (make-boolean-domains args) #:headers headers))
;;; Given a table like the one produced by the tabulate functions, ;;; Given a table like the one produced by the tabulate functions,
;;; creates a function which has this behaviour. ;;; creates a function which has this behaviour.
;;; ;;;