Changeset 38913 in project


Ignore:
Timestamp:
08/29/20 05:11:37 (4 weeks ago)
Author:
Kon Lovett
Message:

simplify print

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/levenshtein/trunk/levenshtein-print.scm

    r38874 r38913  
    1515(import scheme)
    1616(import (chicken base))
    17 (import (chicken type))
    1817(import (only (chicken string) ->string))
    1918(import (only (srfi 1) first second))
     
    2423
    2524;;;
    26 
    27 ;; Types
    28 
    29 (define-type array (struct array))
    30 
    31 (define-type levenshtein-operator (struct levenshtein-operator))
    32 
    33 (: print-levenshtein-matrix (array -> void))
    34 (: print-levenshtein-matrix-slice (array fixnum fixnum fixnum fixnum -> void))
    35 ;(: print-levenshtein-matrix-element ((or string (pair string string)) -> void))
    36 (: print-levenshtein-matrix-element ((or string (pair string levenshtein-operator)) -> void))
    3725
    3826;; SRFI-63 (from srfi-63.scm example)
     
    4735;;;
    4836
    49 (define (print-levenshtein-matrix pm)
    50   (if (and (strict-array? pm) (= 2 (array-rank pm)))
    51     (let ((dims (array-dimensions pm)))
    52       (print-levenshtein-matrix-slice pm 0 (first dims) 0 (second dims)) )
    53     (error-argument-type 'print-levenshtein-matrix pm "rank 2 array" "path-matrix") ) )
     37;;
     38
     39(define (print-levenshtein-matrix-element elm pad)
     40  (if (pair? elm)
     41    (let* (
     42      (ovhd (+ 1 1 1))
     43      (rpad (- pad ovhd))
     44      (idxpad (round (* rpad 1/6)))
     45      (nampad (- rpad idxpad)) )
     46      (print*
     47        #\( (padded-string (car elm) idxpad)
     48            #\space
     49            (padded-string (levenshtein-operator-key (cdr elm)) nampad)
     50        #\)) )
     51    (display (padded-string elm pad)) ) )
     52
     53#; ;format
     54(define (print-levenshtein-matrix-element elm pad)
     55  (import format-modular)
     56  (if (pair? elm)
     57    (format #t "(~2A ~10A) " (car elm) (levenshtein-operator-key (cdr elm)))
     58    (format #t "~15A " elm)) )
    5459
    5560;;
    5661
    57 (define (print-levenshtein-matrix-slice pm i0 n j0 m)
    58   (do ((i i0 (add1 i)))
    59       ((>= i n))
    60     (do ((j j0 (add1 j)))
    61         ((>= j m) (newline))
    62       (print-levenshtein-matrix-element (array-ref pm i j))
    63       (display #\space) ) ) )
     62(define (print-levenshtein-matrix pm #!optional (pad 15))
     63  (unless (and (strict-array? pm) (= 2 (array-rank pm)))
     64    (error-argument-type 'print-levenshtein-matrix pm "rank 2 array" "path-matrix") )
     65  (let* (
     66    (dims (array-dimensions pm))
     67    (n (first dims))
     68    (m (second dims)) )
     69    (do ((i 0 (add1 i)))
     70        ((>= i n))
     71      (do ((j 0 (add1 j)))
     72          ((>= j m) (newline))
     73        (print-levenshtein-matrix-element (array-ref pm i j) pad)
     74        (display #\space) ) ) ) )
    6475
    65 (define (print-levenshtein-matrix-element elm)
    66   (if (pair? elm)
    67     (print*
    68       #\( (padded-string (car elm) 2)
    69           #\space
    70           (padded-string (levenshtein-operator-key (cdr elm)) 15) #\))
    71     (display (padded-string elm 15)) ) )
    72 
    73 #| ;KRL's array-lib
    74 (use array-lib-hof format-modular levenshtein-vector)
    75 
    76 (define (print-levenshtein-matrix pm)
    77         (array-for-each-index
    78                 (lambda (i j)
    79                         (when (zero? j)
    80                                 (format #t "~%"))
    81                         (let ((elm (array-ref pm i j)))
    82                                 (if elm
    83                                         (format #t "(~2A ~10A) " (car elm) (levenshtein-operator-key (cdr elm)))
    84                                         (format #t "~15A " elm))))
    85                 pm)
    86         (format #t "~%") )
    87 |#
     76#; ;KRL's array-lib
     77(define (print-levenshtein-matrix pm #!optional (pad 15))
     78  (import array-lib-hof)
     79  (define (print-cell i j)
     80    (when (zero? j) (newline))
     81    (print-levenshtein-matrix-element (array-ref pm i j) pad)
     82    (display #\space) )
     83  (unless (and (strict-array? pm) (= 2 (array-rank pm)))
     84    (error-argument-type 'print-levenshtein-matrix pm "rank 2 array" "path-matrix") )
     85  (array-for-each-index print-cell pm)
     86  (newline) )
    8887
    8988) ;module levenshtein-print
Note: See TracChangeset for help on using the changeset viewer.