Type read-org-tbfs.

This commit is contained in:
Sergiu Ivanov 2022-04-21 16:56:58 +02:00
parent 1f01917f8a
commit 79a688a3e5
2 changed files with 27 additions and 19 deletions

View file

@ -28,7 +28,7 @@
random-boolean-table random-boolean-function random-boolean-function/list random-boolean-table random-boolean-function random-boolean-function/list
(struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean (struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean
list->tbf lists->tbfs) list->tbf lists->tbfs read-org-tbfs)
(module+ test (module+ test
(require typed/rackunit)) (require typed/rackunit))
@ -413,6 +413,17 @@
(check-equal? (lists->tbfs '((1 2 3) (2 3 4))) (check-equal? (lists->tbfs '((1 2 3) (2 3 4)))
(list (tbf '#(1 2) 3) (tbf '#(2 3) 4))))) (list (tbf '#(1 2) 3) (tbf '#(2 3) 4)))))
(: read-org-tbfs (->* (String) (#:headers Boolean) (Listof tbf)))
(define (read-org-tbfs str #:headers [headers #f])
(define sexp (cast (read-org-sexp str) (Listof Any)))
(define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
(lists->tbfs (cast sexp-clean (Listof (Listof Real)))))
(module+ test
(test-case "read-org-tbfs"
(check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
(module untyped racket (module untyped racket
(module+ test (module+ test
(require rackunit)) (require rackunit))
@ -500,7 +511,7 @@
random-boolean-table random-boolean-function random-boolean-function/list random-boolean-table random-boolean-function random-boolean-function/list
(struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean (struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean
list->tbf lists->tbfs) list->tbf lists->tbfs read-org-tbfs)
(require (rename-in (submod 'typed untyped) (require (rename-in (submod 'typed untyped)
[tabulate tabulate/untyped] [tabulate tabulate/untyped]
@ -509,7 +520,6 @@
(provide (provide
;; Functions ;; Functions
(contract-out (contract-out
[read-org-tbfs (->* (string?) (#:headers boolean?) (listof tbf?))]
[tbf-tabulate* (-> (listof tbf?) (listof (listof (or/c 0 1))))] [tbf-tabulate* (-> (listof tbf?) (listof (listof (or/c 0 1))))]
[tbf-tabulate (-> tbf? (listof (listof (or/c 0 1))))] [tbf-tabulate (-> tbf? (listof (listof (or/c 0 1))))]
[tbf-tabulate*/boolean (-> (listof tbf?) (listof (listof boolean?)))] [tbf-tabulate*/boolean (-> (listof tbf?) (listof (listof boolean?)))]
@ -528,22 +538,6 @@
;;; Threshold Boolean functions ;;; Threshold Boolean functions
;;; =========================== ;;; ===========================
;;; Reads a list of TBF from an Org-mode string containing a sexp,
;;; containing a list of lists of numbers. If headers is #t, drops
;;; the first list, supposing that it contains the headers of the
;;; table.
;;;
;;; The input is typically what read-org-sexp reads.
(define (read-org-tbfs str #:headers [headers #f])
(define sexp (read-org-sexp str))
(define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
(lists->tbfs sexp-clean))
(module+ test
(test-case "read-org-tbfs"
(check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
;;; Tabulates a list of TBFs. ;;; Tabulates a list of TBFs.
;;; ;;;
;;; The result is a list of lists describing the truth table of the ;;; The result is a list of lists describing the truth table of the

View file

@ -435,6 +435,20 @@ The main use is for reading TBFs from Org-mode tables read by
(lists->tbfs '((1 2 3) (2 3 4))) (lists->tbfs '((1 2 3) (2 3 4)))
]} ]}
@defproc[(read-org-tbfs [str String] [#:headers headers Boolean #f])
(Listof tbf)]{
Reads a list of TBF from an Org-mode string containing a sexp, containing
a list of lists of numbers. If headers is @racket[#t], drops the first list,
supposing that it contains the headers of the table.
The input is typically what @racket[read-org-sexp] reads.
@examples[#:eval functions-evaluator
(read-org-tbfs "((1 2 1) (1 0 1))")
]}
@section[#:tag "fuctions/untyped"]{Untyped definitions} @section[#:tag "fuctions/untyped"]{Untyped definitions}
@defmodule[(submod dds/functions typed untyped)] @defmodule[(submod dds/functions typed untyped)]