source: project/release/5/levenshtein/trunk/levenshtein-path-iterator.scm @ 38874

Last change on this file since 38874 was 38874, checked in by Kon Lovett, 2 months ago

add functor types include, note path-iterator bug

File size: 4.1 KB
Line 
1;;;; levenshtein-path-iterator.scm -*- Scheme -*-
2;;;; Kon Lovett, Mar '20
3;;;; Kon Lovett, Apr '12
4
5;; Issues
6;;
7;; - violates the 'number-means' idea since uses full-tower operations &
8;; not those from the 'means' actually used to compute the cost.
9
10(module levenshtein-path-iterator
11
12(;export
13  levenshtein-path-iterator)
14
15(import scheme)
16(import (chicken base))
17(import (srfi 1))
18(import (srfi 63))
19(import miscmacros)
20(import numeric-macros)
21(import type-checks)
22(import type-errors)
23
24;;;
25
26(define (remove-false! ls)
27  (let ((ls (delete! #f ls eq?)))
28    (and (not (null? ls)) ls) ) )
29
30(define (strict-array? obj) (and (array? obj) (not (string? obj)) (not (vector? obj))))
31
32;;;
33
34;FIXME path-iterator goes +1 too far!
35;; (levenshtein-path-iterator MATRIX)
36;;
37;; Creates an optimal edit distance operation path iterator over the
38;; edit operation matrix MATRIX. The matrix is usually the result of an
39;; invocation of '(levenshtein ... operations: #t)'.
40;;
41;; Each invocation of the iterator will generate a list of the form:
42;; ((cost source-index target-index levenshtein-operator) ...). The last
43;; invocation will return #f.
44;;
45;; Note: The iterator will return, w/ #f, to the initial caller. Saving the result of the 1st
46;; invocation is not obvious.
47;;
48;; (define r0 (iter))
49;; (define t r0)
50;; ... (iter) until it quits
51;; r0 now has #f, since the iterator finishes by returning to the initial caller, which is the
52;; body of '(define r0 (iter))', thus re-binding r0. However, t has the original returned value.
53
54(define (levenshtein-path-iterator pm)
55  ;
56  (define (trim-path path)
57    (let* (
58      (cost -inf.0) )
59      (remove-false!
60        (map-in-order
61          (lambda (elm)
62            (let (
63              (elm-cost (car elm)) )
64              (and
65                (not (or (zero? elm-cost) (= cost elm-cost)))
66                (begin
67                  (set! cost elm-cost)
68                  elm) ) ) )
69          path)) ) )
70  ;
71  (define (cost@ i j)
72    (if (or (< i 0) (< j 0))
73      +inf.0
74      (car (array-ref pm i j)) ) )
75  ;
76  (if (not (and (strict-array? pm) (= 2 (array-rank pm))))
77    (error-argument-type 'levenshtein-path-iterator pm "rank 2 array" "path-matrix")
78    (let (
79      (dims (array-dimensions pm)) )
80      (let (
81        (n (car dims))
82        (m (cadr dims)) )
83        (letrec (
84          (generator
85            (lambda (yielder)
86              (let (
87                (yield
88                  (lambda (value)
89                    (let/cc continue
90                      (set! generator
91                        (lambda (k)
92                          (set! yielder k)
93                          (continue value)))
94                      (yielder value) ) ) ) )
95                (let try ((i (-- n)) (j (-- m)) (path '()))
96                  (and
97                    (<= 0 i) (<= 0 j)
98                    (let* (
99                      (o (array-ref pm i j))
100                      (oc (car o))
101                      (oo (cdr o))
102                      (np (cons (list oc i j oo) path)) )
103                      (if (and (= 0 i) (= 0 j))
104                          (yield (trim-path np))
105                          (let ((ai (-- i))
106                                (lj (-- j))
107                                (better #f))
108                            (when (< (cost@ i lj) oc)
109                              (set! better #t)
110                              (try i lj np))
111                            (when (< (cost@ ai j) oc)
112                              (set! better #t)
113                              (try ai j np))
114                            (when (< (cost@ ai lj) oc)
115                              (set! better #t)
116                              (try ai lj np))
117                            (unless better
118                              (when (= (cost@ i lj) oc)
119                                (try i lj np))
120                              (when (= (cost@ ai j) oc)
121                                (try ai j np))
122                              (when (= (cost@ ai lj) oc)
123                                (try ai lj np))) ) ) ) ) ) ) ) ) )
124          (lambda ()
125            (let/cc yielder
126              (generator yielder) ) ) ) ) ) ) )
127
128) ;module levenshtein-path-iterator
Note: See TracBrowser for help on using the repository browser.