networks: Add lists->sbfs/state.

This commit is contained in:
Sergiu Ivanov 2020-10-12 23:20:48 +02:00
parent 943fd322c4
commit 1ff413ddcc

View File

@ -88,6 +88,9 @@
[lists->tbfs/state (->* ((listof (listof (or/c number? symbol?))))
(#:headers boolean?)
(listof tbf/state?))]
[lists->sbfs/state (->* ((listof (listof (or/c number? symbol?))))
(#:headers boolean?)
(listof sbf/state?))]
[read-org-tbfs/state (->* (string?) (#:headers boolean?) (listof tbf/state?))]
[print-org-tbfs/state (->* ((non-empty-listof tbf/state?)) (#:headers boolean?)
(listof (listof (or/c number? symbol?))))]
@ -1054,6 +1057,33 @@
(tbf/state '#hash((a . 1) (b . 2)) 3)
(tbf/state '#hash((a . 1) (b . 1)) 2)))))
;;; Like lists->tbfs/state, but does not expect thresholds in the
;;; input.
;;;
;;; Every lists in the list contains the weights of the SBF. If
;;; headers is #t, the names of the variables to appear as the inputs
;;; of the TBF are taken from the first list.
;;;
;;; If headers is #f, the names of the variables are generated as xi,
;;; where i is the index of the variable.
(define (lists->sbfs/state lsts #:headers [headers #t])
(define rows (if headers (cdr lsts) lsts))
(define rows-θ (for/list ([lst (in-list rows)]) (append lst '(0))))
(lists->tbfs/state (if headers (cons (car lsts) rows-θ) rows-θ)
#:headers headers))
(module+ test
(test-case "lists->sbfs/state"
(define tbfs '((1 2) (1 -1)))
(check-equal? (lists->sbfs/state tbfs #:headers #f)
(list
(tbf/state '#hash((x0 . 1) (x1 . 2)) 0)
(tbf/state '#hash((x0 . 1) (x1 . -1)) 0)))
(check-equal? (lists->sbfs/state (cons '(a b) tbfs) #:headers #t)
(list
(tbf/state '#hash((a . 1) (b . 2)) 0)
(tbf/state '#hash((a . 1) (b . -1)) 0)))))
;;; Reads a list of tbf/state from an Org-mode string containing a
;;; sexp, containing a list of lists of numbers. As in
;;; lists->tbfs/state, the last element of each list is taken to be