;;;; levenshtein-path-iterator.scm -*- Scheme -*-
;;;; Kon Lovett, Mar '20
;;;; Kon Lovett, Apr '12

;; Issues
;;
;; - violates the 'number-means' idea since uses full-tower operations &
;; not those from the 'means' actually used to compute the cost.

(module levenshtein-path-iterator

(;export
  levenshtein-path-iterator)

(import scheme
  (chicken base)
  (chicken type)
  (only (srfi 1) map-in-order delete!)
  (srfi 63)
  miscmacros
  (only (check-errors basic) define-check+error-type error-argument-type))

(define-type array (struct array))

(: levenshtein-path-iterator (array -> (-> (or false list))))

(: trim-path (list -> list))
(: cost@ (array fixnum fixnum -> number))

;;

(define (remove-false! ls) (delete! #f ls eq?))

;enough for our purposes
(define (strict-array? obj) (and (array? obj) (not (string? obj)) (not (vector? obj))))

;;

(define (trim-path path)
  (let ((cost 0))
    (remove-false!
      ;NOTE must yield new list, so purity assertion maintained
      (map-in-order
        (lambda (elm)
          (let ((elm-cost (the number (car elm))))
            (and (not (zero? elm-cost)) (not (= cost elm-cost))
                 (begin (set! cost elm-cost) elm)) ) )
        path)) ) )

(define (cost@ pm i j)
  (if (or (negative? i) (negative? j)) +inf.0
      (the number (car (array-ref pm i j))) ) )

;FIXME path-iterator goes +1 too far!

;; (levenshtein-path-iterator MATRIX)
;;
;; Creates an optimal edit distance operation path iterator over the
;; edit operation matrix MATRIX. The matrix is usually the result of an
;; invocation of '(levenshtein ... operations: #t)'.
;;
;; Each invocation of the iterator will generate a list of the form:
;; ((cost source-index target-index levenshtein-operator) ...). The last
;; invocation will return #f.
;;
;; Note: The iterator will return, w/ #f, to the initial caller. Saving the result of the 1st
;; invocation is not obvious.
;;
;; (define r0 (iter))
;; (define t r0)
;; ... (iter) until it quits
;; r0 now has #f, since the iterator finishes by returning to the initial caller, which is the
;; body of '(define r0 (iter))', thus re-binding r0. However, t has the original returned value.

(define (levenshtein-path-iterator pm)
  (unless (and (strict-array? pm) (= 2 (array-rank pm)))
    (error-argument-type 'levenshtein-path-iterator pm "rank 2 array" 'path-matrix) )
  (let* ((dims (array-dimensions pm))
         (rs (the fixnum (car dims)))
         (cs (the fixnum (cadr dims))) )
    (letrec ((generator
              (lambda (yielder)
                (define (yield value)
                  (let/cc continue
                    (set! generator (lambda (k) (set! yielder k) (continue value)))
                    (yielder value) ) )
                (let try ((r (sub1 rs)) (c (sub1 cs)) (path '()))
                  (and (not (negative? r))
                       (not (negative? c))
                       (let* ((o (array-ref pm r c))
                              (oc (the number (car o)))
                              (np (cons (list oc r c (cdr o)) path)) )
                         (if (and (zero? r) (zero? c))
                             (yield (trim-path np))
                             (let ((r- (sub1 r))
                                   (c- (sub1 c))
                                   (better #f) )
                               (when (< (cost@ pm r c-) oc)
                                 (set! better #t)
                                 (try r c- np) )
                               (when (< (cost@ pm r- c) oc)
                                 (set! better #t)
                                 (try r- c np) )
                               (when (< (cost@ pm r- c-) oc)
                                 (set! better #t)
                                 (try r- c- np) )
                               (unless better
                                 (when (= (cost@ pm r c-) oc)
                                   (try r c- np) )
                                 (when (= (cost@ pm r- c) oc)
                                   (try r- c np) )
                                 (when (= (cost@ pm r- c-) oc)
                                   (try r- c- np) ) )
                                ;no direction so done
                                #f ) ) ) ) ) ) ) )
      (lambda ()
        (let/cc yielder
          (generator yielder) ) ) ) ) )

) ;module levenshtein-path-iterator