;;;; 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)
(import (chicken base))
(import (srfi 1))
(import (srfi 63))
(import miscmacros)
(import numeric-macros)
(import type-checks)
(import type-errors)

;;;

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

;;;

;; (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)

  (define (trim-path path)
    (let ((cost -inf.0))
      (delete! #f
        (map-in-order
          (lambda (elm)
            (let ((elm-cost (car elm)))
              (if (or (zero? elm-cost) (= cost elm-cost))
                #f
                (begin (set! cost elm-cost) elm) ) ) )
          path)
        eq?) ) )

  (if (not (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)))
        (let ((n (car dims))
              (m (cadr dims))
              (cost@
                (lambda (i j)
                  (if (or (< i 0) (< j 0))
                    +inf.0
                    (car (array-ref pm i j)) ) ) ) )
            (letrec ((generator
                      (lambda (yielder)
                        (let ((yield
                                (lambda (value)
                                  (let/cc continue
                                    (set! generator
                                      (lambda (k)
                                        (set! yielder k)
                                        (continue value)))
                                    (yielder value) ) ) ) )
                          (let try ((i (-- n)) (j (-- m)) (path '()))
                            (and
                              (<= 0 i) (<= 0 j)
                              (let* ((o (array-ref pm i j))
                                     (oc (car o))
                                     (oo (cdr o))
                                     (np (cons (list oc i j oo) path) ) )
                                (if (and (= 0 i) (= 0 j))
                                    (begin
                                      (yield (trim-path np))
                                      #f)
                                    (let ((ai (-- i))
                                          (lj (-- j))
                                          (better #f))
                                      (when (< (cost@ i lj) oc)
                                        (set! better #t)
                                        (try i lj np))
                                      (when (< (cost@ ai j) oc)
                                        (set! better #t)
                                        (try ai j np))
                                      (when (< (cost@ ai lj) oc)
                                        (set! better #t)
                                        (try ai lj np))
                                      (unless better
                                        (when (= (cost@ i lj) oc)
                                          (try i lj np))
                                        (when (= (cost@ ai j) oc)
                                          (try ai j np))
                                        (when (= (cost@ ai lj) oc)
                                          (try ai lj np)))
                                      #f ) ) ) ) ) ) ) ) )
              (lambda ()
                (let/cc yielder
                  (generator yielder) ) ) ) ) ) ) )

) ;module levenshtein-path-iterator