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

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

rm dep

File size: 4.0 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 type-checks)
21(import type-errors)
22
23;;;
24
25(define (remove-false! ls) (delete! #f ls eq?))
26
27(define (strict-array? obj) (and (array? obj) (not (string? obj)) (not (vector? obj))))
28
29;;;
30
31;FIXME path-iterator goes +1 too far!
32;; (levenshtein-path-iterator MATRIX)
33;;
34;; Creates an optimal edit distance operation path iterator over the
35;; edit operation matrix MATRIX. The matrix is usually the result of an
36;; invocation of '(levenshtein ... operations: #t)'.
37;;
38;; Each invocation of the iterator will generate a list of the form:
39;; ((cost source-index target-index levenshtein-operator) ...). The last
40;; invocation will return #f.
41;;
42;; Note: The iterator will return, w/ #f, to the initial caller. Saving the result of the 1st
43;; invocation is not obvious.
44;;
45;; (define r0 (iter))
46;; (define t r0)
47;; ... (iter) until it quits
48;; r0 now has #f, since the iterator finishes by returning to the initial caller, which is the
49;; body of '(define r0 (iter))', thus re-binding r0. However, t has the original returned value.
50
51(define (levenshtein-path-iterator pm)
52  ;
53  (define (trim-path path)
54    (let ((cost -inf.0))
55      (remove-false!
56        (map-in-order
57          (lambda (elm)
58            (let ((elm-cost (car elm)))
59              (and
60                (not (zero? elm-cost)) (not (= cost elm-cost))
61                (begin (set! cost elm-cost) elm)) ) )
62          path)) ) )
63  ;
64  (define (cost@ i j)
65    (if (or (< i 0) (< j 0))
66      +inf.0
67      (car (array-ref pm i j)) ) )
68  ;
69  (if (not (and (strict-array? pm) (= 2 (array-rank pm))))
70    (error-argument-type 'levenshtein-path-iterator pm "rank 2 array" "path-matrix")
71    (let (
72      (dims (array-dimensions pm)) )
73      (let (
74        (r (car dims))
75        (c (cadr dims)) )
76        (letrec (
77          (generator
78            (lambda (yielder)
79              (let (
80                (yield
81                  (lambda (value)
82                    (let/cc continue
83                      (set! generator
84                        (lambda (k)
85                          (set! yielder k)
86                          (continue value)))
87                      (yielder value) ) ) ) )
88                (let try ((i (sub1 r)) (j (sub1 c)) (path '()))
89                  (and
90                    (not (negative? i)) (not (negative? j))
91                    (let* (
92                      (o (array-ref pm i j))
93                      (oc (car o))
94                      (oo (cdr o))
95                      (np (cons (list oc i j oo) path)) )
96                      (if (and (zero? i) (zero? j))
97                        (yield (trim-path np))
98                        (let (
99                          (ai (sub1 i))
100                          (lj (sub1 j))
101                          (better #f) )
102                          (when (< (cost@ i lj) oc)
103                            (set! better #t)
104                            (try i lj np) )
105                          (when (< (cost@ ai j) oc)
106                            (set! better #t)
107                            (try ai j np) )
108                          (when (< (cost@ ai lj) oc)
109                            (set! better #t)
110                            (try ai lj np) )
111                          (unless better
112                            (when (= (cost@ i lj) oc)
113                              (try i lj np) )
114                            (when (= (cost@ ai j) oc)
115                              (try ai j np) )
116                            (when (= (cost@ ai lj) oc)
117                              (try ai lj np) ) ) ) ) ) ) ) ) ) ) )
118          (lambda ()
119            (let/cc yielder
120              (generator yielder) ) ) ) ) ) ) )
121
122) ;module levenshtein-path-iterator
Note: See TracBrowser for help on using the repository browser.