;;;; levenshtein-print.scm  -*- Scheme -*-
;;;; Kon Lovett, Mar '20
;;;; Kon Lovett, Apr '12
;;;; Kon Lovett, Sep '05

;;Issues
;;
;; - Assues operator name never > 15 chars & cost never > 2.

(module levenshtein-print

(;export
  print-levenshtein-matrix)

(import scheme
  (chicken base)
  (only (chicken string) ->string)
  (only (srfi 1) first second)
  (only (srfi 13) string-pad)
  (only (srfi 63) array? array-rank array-dimensions array-ref)
  (only levenshtein-operators levenshtein-operator-key)
  (only type-errors-basic error-argument-type))

;;;

;; SRFI-63 (from srfi-63.scm example)

(define (nonstrict-array? obj) (or (string? obj) (vector? obj)))
(define (strict-array? obj) (and (array? obj) (not (nonstrict-array? obj))))

;; String

(define (padded-string x n) (string-pad (->string x) n))

;;;

;;

(define (print-levenshtein-matrix-element elm pad)
  (if (pair? elm)
    (let* ((ovhd (+ 1 1 1))
           (rpad (- pad ovhd))
           (idxpad (round (* rpad 1/6)))
           (nampad (- rpad idxpad)) )
      (print*
        #\( (padded-string (car elm) idxpad)
            #\space
            (padded-string (levenshtein-operator-key (cdr elm)) nampad)
        #\)) )
    (display (padded-string elm pad)) ) )

#; ;format
(define (print-levenshtein-matrix-element elm pad)
  (import format-modular)
  (if (pair? elm)
    (format #t "(~2A ~10A) " (car elm) (levenshtein-operator-key (cdr elm)))
    (format #t "~15A " elm)) )

;;

(define (print-levenshtein-matrix pm #!optional (pad 15))
  (unless (and (strict-array? pm) (= 2 (array-rank pm)))
    (error-argument-type 'print-levenshtein-matrix pm "rank 2 array" "path-matrix") )
  (let* ((dims (array-dimensions pm))
         (n (first dims))
         (m (second dims)) )
    (do ((i 0 (add1 i)))
        ((>= i n))
      (do ((j 0 (add1 j)))
          ((>= j m) (newline))
        (print-levenshtein-matrix-element (array-ref pm i j) pad)
        (display #\space) ) ) ) )

#; ;KRL's array-lib
(define (print-levenshtein-matrix pm #!optional (pad 15))
  (import array-lib-hof)
  (define (print-cell i j)
    (when (zero? j) (newline))
    (print-levenshtein-matrix-element (array-ref pm i j) pad)
    (display #\space) )
  (unless (and (strict-array? pm) (= 2 (array-rank pm)))
    (error-argument-type 'print-levenshtein-matrix pm "rank 2 array" "path-matrix") )
  (array-for-each-index print-cell pm)
  (newline) )

) ;module levenshtein-print