Changeset 38891 in project
- Timestamp:
- 08/27/20 05:03:19 (5 months ago)
- Location:
- release/5/levenshtein/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/levenshtein/trunk/levenshtein-path-iterator.scm
r38890 r38891 15 15 (import scheme) 16 16 (import (chicken base)) 17 (import (srfi 1)) 17 (import (chicken type)) 18 (import (only (srfi 1) first map-in-order delete!)) 18 19 (import (srfi 63)) 19 20 (import miscmacros) … … 52 53 ; 53 54 (define (trim-path path) 54 (let ((cost -inf.0))55 (let ((cost 0)) 55 56 (remove-false! 57 ;must yield new list 56 58 (map-in-order 57 59 (lambda (elm) 58 (let ((elm-cost (car elm))) 60 (print elm) 61 (let ((elm-cost (the number (car elm)))) 59 62 (and 60 63 (not (zero? elm-cost)) (not (= cost elm-cost)) … … 63 66 ; 64 67 (define (cost@ i j) 65 (if (or ( < i 0) (< j 0))68 (if (or (negative? i) (negative? j)) 66 69 +inf.0 67 ( car (array-ref pm i j)) ) )70 (the number (first (array-ref pm i j))) ) ) 68 71 ; 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) ) ) ) ) ) ) ) 72 (unless (and (strict-array? pm) (= 2 (array-rank pm))) 73 (error-argument-type 'levenshtein-path-iterator pm "rank 2 array" "path-matrix") ) 74 ; 75 (let* ( 76 (dims (array-dimensions pm)) 77 (rs (the fixnum (car dims))) 78 (cs (the fixnum (cadr dims))) ) 79 (letrec ( 80 (generator 81 (lambda (yielder) 82 (let ( 83 (yield 84 (lambda (value) 85 (let/cc continue 86 (set! generator 87 (lambda (k) 88 (set! yielder k) 89 (continue value))) 90 (yielder value) ) ) ) ) 91 (let try ((r (sub1 rs)) (c (sub1 cs)) (path '())) 92 (and 93 (not (negative? r)) (not (negative? c)) 94 (let* ( 95 (o (array-ref pm r c)) 96 (oc (the number (car o))) 97 (np (cons (list oc r c (cdr o)) path)) ) 98 (if (and (zero? r) (zero? c)) 99 (yield (trim-path np)) 100 (let ( 101 (r- (sub1 r)) 102 (c- (sub1 c)) 103 (better #f) ) 104 (when (< (cost@ r c-) oc) 105 (set! better #t) 106 (try r c- np) ) 107 (when (< (cost@ r- c) oc) 108 (set! better #t) 109 (try r- c np) ) 110 (when (< (cost@ r- c-) oc) 111 (set! better #t) 112 (try r- c- np) ) 113 (unless better 114 (when (= (cost@ r c-) oc) 115 (try r c- np) ) 116 (when (= (cost@ r- c) oc) 117 (try r- c np) ) 118 (when (= (cost@ r- c-) oc) 119 (try r- c- np) ) ) ) ) ) ) ) ) ) ) ) 120 (lambda () 121 (let/cc yielder 122 (generator yielder) ) ) ) ) ) 121 123 122 124 ) ;module levenshtein-path-iterator -
release/5/levenshtein/trunk/tests/levenshtein-test.scm
r38890 r38891 213 213 (do ((c 0 (add1 c))) 214 214 ((= c cs)) 215 (let ((cost (car costs)) (oper (car opers))) 216 (set! costs (cdr costs)) 217 (set! opers (cdr opers)) 218 (array-set! pm (cons cost oper) r c) ) ) ) ) ) ) 215 (array-set! pm (cons (car costs) (car opers)) r c) 216 (set! costs (cdr costs)) 217 (set! opers (cdr opers)) ) ) ) ) ) 219 218 220 219 (define *test-pm* (gen-test-pm)) 221 220 222 221 (define (gen-real-iter-vec) 223 (let ((iter (levenshtein-path-iterator *test-pm*)) (vec (make-vector 6))) 222 (let ((vec (make-vector 6)) 223 (iter (levenshtein-path-iterator *test-pm*))) 224 ;FIXME path-iterator goes +1 too far 224 225 (do ((r (iter) (iter)) 225 226 (i 0 (add1 i))) 226 ;FIXME path-iterator goes +1 too far 227 ((or (not r) (= (vector-length vec) i)) vec) 227 ((or (not r) (= i (vector-length vec))) vec) 228 228 (vector-set! vec i r)))) 229 229
Note: See TracChangeset
for help on using the changeset viewer.