guile-vocabulary-explorer/lib/training.scm

(library (training)
  (export train
          display-for-training
          ?vector->string
          display-key-and-val
          default-attr-pred
          word->string)
  (import (except (rnrs base)
                  vector-map
                  vector-for-each)
          (only (guile)
                lambda* λ
                ;; control structures
                when
                ;; output
                display
                simple-format
                current-output-port
                ;; strings
                string-join
                string-count
                call-with-output-string)
          (ice-9 match)
          (srfi srfi-1)
          (contract)
          (alist-utils)
          (prefix (io) io:)
          (model)
          (paginated-output))


  (define count-lines
    (λ (str)
      (+ (string-count str
                       (λ (char)
                         (char=? char #\newline)))
         1)))


  (define show-for-training
    (λ (word-as-string)
      (let ([num-lines (- (count-lines word-as-string) 1)])
        (output-paginated word-as-string num-lines))))


  (define ?vector->string
    (λ (?vec)
      (if (vector? ?vec)
          (string-join (vector->list ?vec) ", ")
          ?vec)))


  (define display-key-and-val
    (lambda* (key val #:optional (port (current-output-port)))
      (display (simple-format #f "~a: ~a\n" key val) port)))


  (define-with-contract word->string
    (require (procedure? attr-pred))
    (ensure (string? <?>))
    (λ (word attr-pred)
      (let ([metadata (alist-refs word '("metadata"))]
            [translation-data (alist-refs word '("translation-data"))])
        (call-with-output-string
          (λ (port)
            ;; check metadata
            (for-each (λ (datum)
                        (match datum
                          [(key . val)
                           (when (attr-pred datum)
                             (display-key-and-val key
                                                  (?vector->string val)
                                                  port))]))
                      metadata)
            ;; check translation data
            (for-each (λ (datum)
                        (match datum
                          [(key . val)
                           (when (attr-pred datum)
                             (display-key-and-val key
                                                  (?vector->string val)
                                                  port))]))
                      translation-data))))))


  (define default-attr-pred
    (λ (attr)
      (match attr
        [(key . val)
         (member key '("description" "native"))])))


  (define-with-contract train
    (require (vocabulary? voc))
    (ensure)
    (lambda* (voc #:key (attribute-predicate default-attr-pred))
      (let* ([words (vocabulary-words voc)]
             [num-words (vector-length words)])
        (let iter ([index° 0])
          (when (< index° num-words)
            (let ([word (vector-ref words index°)])
              (show-for-training
               (word->string word attribute-predicate))
              (iter (+ index° 1)))))))))