From f05024e61ef07da75d4505c3855736664a121484 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Wed, 12 Jul 2023 20:18:29 +0200 Subject: [PATCH] Move the functions for reading to TBN and SBN to the section on TBN. --- scribblings/tbn.scrbl | 160 +++++++++++++++---------------- tbn.rkt | 216 +++++++++++++++++++++--------------------- 2 files changed, 188 insertions(+), 188 deletions(-) diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl index f58cecc..ed93a42 100644 --- a/scribblings/tbn.scrbl +++ b/scribblings/tbn.scrbl @@ -217,86 +217,6 @@ is taken to contain the names of the variables, similarly to (read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))") ]} -@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))] - [#:headers headers Boolean #t] - [#:func-names func-names Boolean #t]) - TBN]{ - -Reads a TBN from a list of lists of numbers or symbols, which may -represent an Org-mode table. As in @racket[lists->tbfs/state], the -last element of each list is taken to be the threshold of the TBF, and -the rest of the elements are taken to be the weights. - -If @racket[headers] is @racket[#t], the names of the variables to -appear as the inputs of the TBF are taken from the first list. -The last element of this list (corresponding to the column giving the -threshold) is discarded. If @racket[headers] is @racket[#f], the -names of the variables are generated as @tt{xi}, where @tt{i} is -the index of the variable. - -If @racket[func-names] is @racket[#t], the first element in every row -except the first one are taken to be the name of the variable to which -the TBF should be associated. If @racket[func-names] is @racket[#f], -the functions are assigned to variables in lexicographic order. - -@racket[func-names] cannot be @racket[#t] if @racket[headers] is -@racket[#f]. The function does not check this condition. - -This is a helper function for @racket[read-org-tbn] and -@racket[read-org-sbn]. - -@ex[ -(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f) -(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f) -(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t) -]} - -@defproc[(read-org-tbn [str String] - [#:headers headers Boolean #t] - [#:func-names func-names Boolean #t]) - TBN]{ - -Reads a TBN from an string containing a sexp, containing a list of -lists of numbers and possibly symbols. This string may be produced by -Org-mode. - -As in @racket[lists->tbfs/state], the last element of each list is -taken to be the threshold of the TBFs, and the rest of the elements -are taken to be the weights. - -As in @racket[parse-org-tbn], if @racket[headers] is @racket[#t], the -names of the variables to appear as the inputs of the TBF are taken -from the first list. The last element of this list is discarded. -If @racket[headers] is @racket[#f], the names of the variables are -generated as @tt{xi}, where @tt{i} is the index of the variable. - -If @racket[func-names] is @racket[#t], the first element in every row -except the first one, are taken to be the name of the variable to -which the TBF should be associated. If @racket[func-names] is -@racket[#f], the functions are assigned to variables in -alphabetical order. - -As in @racket[parse-org-tbn], @racket[func-names] cannot be -@racket[#t] if @racket[headers] is @racket[#f]. The function does not -check this condition. - -@ex[ -(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))") -]} - -@defproc[(read-org-sbn [str String] - [#:headers headers Boolean #t] - [#:func-names func-names Boolean #t]) - TBN]{ - -Like @racket[read-org-tbn], but reads an SBN from the input string, -i.e. all the numbers are taken to be the weights, and the threshold is -set to 0. - -@ex[ -(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))") -]} - @defproc[(tbfs/state->lists [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{ Given a list of @racket[TBF/State], produces a sexp that Org-mode can @@ -438,6 +358,86 @@ Constructs a @racket[Network] out of the given @racket[tbn]. (update tbn s '(a b))) ]} +@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))] + [#:headers headers Boolean #t] + [#:func-names func-names Boolean #t]) + TBN]{ + +Reads a TBN from a list of lists of numbers or symbols, which may +represent an Org-mode table. As in @racket[lists->tbfs/state], the +last element of each list is taken to be the threshold of the TBF, and +the rest of the elements are taken to be the weights. + +If @racket[headers] is @racket[#t], the names of the variables to +appear as the inputs of the TBF are taken from the first list. +The last element of this list (corresponding to the column giving the +threshold) is discarded. If @racket[headers] is @racket[#f], the +names of the variables are generated as @tt{xi}, where @tt{i} is +the index of the variable. + +If @racket[func-names] is @racket[#t], the first element in every row +except the first one are taken to be the name of the variable to which +the TBF should be associated. If @racket[func-names] is @racket[#f], +the functions are assigned to variables in lexicographic order. + +@racket[func-names] cannot be @racket[#t] if @racket[headers] is +@racket[#f]. The function does not check this condition. + +This is a helper function for @racket[read-org-tbn] and +@racket[read-org-sbn]. + +@ex[ +(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f) +(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f) +(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t) +]} + +@defproc[(read-org-tbn [str String] + [#:headers headers Boolean #t] + [#:func-names func-names Boolean #t]) + TBN]{ + +Reads a TBN from an string containing a sexp, containing a list of +lists of numbers and possibly symbols. This string may be produced by +Org-mode. + +As in @racket[lists->tbfs/state], the last element of each list is +taken to be the threshold of the TBFs, and the rest of the elements +are taken to be the weights. + +As in @racket[parse-org-tbn], if @racket[headers] is @racket[#t], the +names of the variables to appear as the inputs of the TBF are taken +from the first list. The last element of this list is discarded. +If @racket[headers] is @racket[#f], the names of the variables are +generated as @tt{xi}, where @tt{i} is the index of the variable. + +If @racket[func-names] is @racket[#t], the first element in every row +except the first one, are taken to be the name of the variable to +which the TBF should be associated. If @racket[func-names] is +@racket[#f], the functions are assigned to variables in +alphabetical order. + +As in @racket[parse-org-tbn], @racket[func-names] cannot be +@racket[#t] if @racket[headers] is @racket[#f]. The function does not +check this condition. + +@ex[ +(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))") +]} + +@defproc[(read-org-sbn [str String] + [#:headers headers Boolean #t] + [#:func-names func-names Boolean #t]) + TBN]{ + +Like @racket[read-org-tbn], but reads an SBN from the input string, +i.e. all the numbers are taken to be the weights, and the threshold is +set to 0. + +@ex[ +(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))") +]} + @defproc[(build-tbn-state-graph [tbn TBN]) Graph]{ Builds the state graph of a @racket[TBN]. diff --git a/tbn.rkt b/tbn.rkt index c82c550..4348251 100644 --- a/tbn.rkt +++ b/tbn.rkt @@ -214,114 +214,6 @@ (list (tbf/state '#hash((a . 1) (b . 2)) 3) (tbf/state '#hash((a . 1) (b . 1)) 2))))) - (: parse-org-tbn (->* ((Listof (Listof (U Symbol Real)))) - (#:headers Boolean - #:func-names Boolean) - TBN)) - (define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t]) - (cond [func-names - (define-values (vars rows) (multi-split-at tab 1)) - (define tbfs (lists->tbfs/state/opt-headers rows #:headers headers)) - (for/hash : TBN - ([tbf (in-list tbfs)] - [var (in-list (cdr vars))]) - (values (assert-type (car var) Variable) tbf))] - [else - (define tbfs (lists->tbfs/state/opt-headers tab #:headers headers)) - (define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t)) - (for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)]) - (values (assert-type var Variable) tbf))])) - - (module+ test - (test-case "parse-org-tbn" - (check-equal? - (parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f) - (hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3) - 'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1))) - (check-equal? - (parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f) - (hash - 'a - (tbf/state '#hash((a . 1) (b . 2)) 3) - 'b - (tbf/state '#hash((a . 3) (b . 2)) 1))) - (check-equal? - (parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) - #:headers #t - #:func-names #t) - (hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3) - 'b (tbf/state '#hash((a . 3) (b . 2)) 1))))) - - (: read-org-tbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN)) - (define (read-org-tbn str - #:headers [headers #t] - #:func-names [func-names #t]) - (parse-org-tbn (assert-type (read-org-sexp str) - (Listof (Listof (U Symbol Real)))) - #:headers headers - #:func-names func-names)) - - (module+ test - (test-case "read-org-tbn" - (check-equal? - (read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))") - (hash - 'x - (tbf/state '#hash((x . 0) (y . -1)) -1) - 'y - (tbf/state '#hash((x . -1) (y . 0)) -1))) - (check-equal? - (read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f) - (hash - 'x - (tbf/state '#hash((x . -1) (y . 0)) -1) - 'y - (tbf/state '#hash((x . 0) (y . -1)) -1))) - (check-equal? - (read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f) - (hash - 'x0 - (tbf/state '#hash((x0 . -1) (x1 . 0)) -1) - 'x1 - (tbf/state '#hash((x0 . 0) (x1 . -1)) -1))))) - - (: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN)) - (define (read-org-sbn str - #:headers [headers #t] - #:func-names [func-names #t]) - (define sexp (assert-type (read-org-sexp str) - (Listof (Listof (U Symbol Real))))) - ;; Inject the 0 thresholds into the rows of the sexp we have just read. - (: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real))))) - (define (inject-0 rows) - (for/list : (Listof (Listof (U Symbol Real))) - ([row (in-list rows)]) (append row '(0)))) - (define sexp-ready (if headers - (cons (append (car sexp) '(θ)) (inject-0 (cdr sexp))) - (inject-0 sexp))) - (parse-org-tbn sexp-ready #:headers headers #:func-names func-names)) - - (module+ test - (test-case "read-org-sbn" - (check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))") - (hash - 'x - (tbf/state '#hash((x . 0) (y . -1)) 0) - 'y - (tbf/state '#hash((x . -1) (y . 0)) 0))) - (check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f) - (hash - 'x - (tbf/state '#hash((x . -1) (y . 0)) 0) - 'y - (tbf/state '#hash((x . 0) (y . -1)) 0))) - (check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f) - (hash - 'x0 - (tbf/state '#hash((x0 . -1) (x1 . 0)) 0) - 'x1 - (tbf/state '#hash((x0 . 0) (x1 . -1)) 0))))) - (: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real)))) (define (tbfs/state->lists tbfs) (for/list ([tbf (in-list tbfs)]) @@ -500,6 +392,114 @@ (check-equal? (network-domains tbn) #hash((a . (0 1)) (b . (0 1)))))) + (: parse-org-tbn (->* ((Listof (Listof (U Symbol Real)))) + (#:headers Boolean + #:func-names Boolean) + TBN)) + (define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t]) + (cond [func-names + (define-values (vars rows) (multi-split-at tab 1)) + (define tbfs (lists->tbfs/state/opt-headers rows #:headers headers)) + (for/hash : TBN + ([tbf (in-list tbfs)] + [var (in-list (cdr vars))]) + (values (assert-type (car var) Variable) tbf))] + [else + (define tbfs (lists->tbfs/state/opt-headers tab #:headers headers)) + (define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t)) + (for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)]) + (values (assert-type var Variable) tbf))])) + + (module+ test + (test-case "parse-org-tbn" + (check-equal? + (parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f) + (hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3) + 'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1))) + (check-equal? + (parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f) + (hash + 'a + (tbf/state '#hash((a . 1) (b . 2)) 3) + 'b + (tbf/state '#hash((a . 3) (b . 2)) 1))) + (check-equal? + (parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) + #:headers #t + #:func-names #t) + (hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3) + 'b (tbf/state '#hash((a . 3) (b . 2)) 1))))) + + (: read-org-tbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN)) + (define (read-org-tbn str + #:headers [headers #t] + #:func-names [func-names #t]) + (parse-org-tbn (assert-type (read-org-sexp str) + (Listof (Listof (U Symbol Real)))) + #:headers headers + #:func-names func-names)) + + (module+ test + (test-case "read-org-tbn" + (check-equal? + (read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))") + (hash + 'x + (tbf/state '#hash((x . 0) (y . -1)) -1) + 'y + (tbf/state '#hash((x . -1) (y . 0)) -1))) + (check-equal? + (read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f) + (hash + 'x + (tbf/state '#hash((x . -1) (y . 0)) -1) + 'y + (tbf/state '#hash((x . 0) (y . -1)) -1))) + (check-equal? + (read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f) + (hash + 'x0 + (tbf/state '#hash((x0 . -1) (x1 . 0)) -1) + 'x1 + (tbf/state '#hash((x0 . 0) (x1 . -1)) -1))))) + + (: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN)) + (define (read-org-sbn str + #:headers [headers #t] + #:func-names [func-names #t]) + (define sexp (assert-type (read-org-sexp str) + (Listof (Listof (U Symbol Real))))) + ;; Inject the 0 thresholds into the rows of the sexp we have just read. + (: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real))))) + (define (inject-0 rows) + (for/list : (Listof (Listof (U Symbol Real))) + ([row (in-list rows)]) (append row '(0)))) + (define sexp-ready (if headers + (cons (append (car sexp) '(θ)) (inject-0 (cdr sexp))) + (inject-0 sexp))) + (parse-org-tbn sexp-ready #:headers headers #:func-names func-names)) + + (module+ test + (test-case "read-org-sbn" + (check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))") + (hash + 'x + (tbf/state '#hash((x . 0) (y . -1)) 0) + 'y + (tbf/state '#hash((x . -1) (y . 0)) 0))) + (check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f) + (hash + 'x + (tbf/state '#hash((x . -1) (y . 0)) 0) + 'y + (tbf/state '#hash((x . 0) (y . -1)) 0))) + (check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f) + (hash + 'x0 + (tbf/state '#hash((x0 . -1) (x1 . 0)) 0) + 'x1 + (tbf/state '#hash((x0 . 0) (x1 . -1)) 0))))) + (: build-tbn-state-graph (-> TBN Graph)) (define (build-tbn-state-graph tbn) (pretty-print-state-graph