Changeset 38891 in project
 Timestamp:
 08/27/20 05:03:19 (4 weeks ago)
 Location:
 release/5/levenshtein/trunk
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

release/5/levenshtein/trunk/levenshteinpathiterator.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 mapinorder delete!)) 18 19 (import (srfi 63)) 19 20 (import miscmacros) … … 52 53 ; 53 54 (define (trimpath path) 54 (let ((cost inf.0))55 (let ((cost 0)) 55 56 (removefalse! 57 ;must yield new list 56 58 (mapinorder 57 59 (lambda (elm) 58 (let ((elmcost (car elm))) 60 (print elm) 61 (let ((elmcost (the number (car elm)))) 59 62 (and 60 63 (not (zero? elmcost)) (not (= cost elmcost)) … … 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 (arrayref pm i j)) ) )70 (the number (first (arrayref pm i j))) ) ) 68 71 ; 69 (if (not (and (strictarray? pm) (= 2 (arrayrank pm)))) 70 (errorargumenttype 'levenshteinpathiterator pm "rank 2 array" "pathmatrix") 71 (let ( 72 (dims (arraydimensions 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 (arrayref 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 (trimpath 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 (strictarray? pm) (= 2 (arrayrank pm))) 73 (errorargumenttype 'levenshteinpathiterator pm "rank 2 array" "pathmatrix") ) 74 ; 75 (let* ( 76 (dims (arraydimensions 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 (arrayref 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 (trimpath 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 levenshteinpathiterator 
release/5/levenshtein/trunk/tests/levenshteintest.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 (arrayset! pm (cons cost oper) r c) ) ) ) ) ) ) 215 (arrayset! pm (cons (car costs) (car opers)) r c) 216 (set! costs (cdr costs)) 217 (set! opers (cdr opers)) ) ) ) ) ) 219 218 220 219 (define *testpm* (gentestpm)) 221 220 222 221 (define (genrealitervec) 223 (let ((iter (levenshteinpathiterator *testpm*)) (vec (makevector 6))) 222 (let ((vec (makevector 6)) 223 (iter (levenshteinpathiterator *testpm*))) 224 ;FIXME pathiterator goes +1 too far 224 225 (do ((r (iter) (iter)) 225 226 (i 0 (add1 i))) 226 ;FIXME pathiterator goes +1 too far 227 ((or (not r) (= (vectorlength vec) i)) vec) 227 ((or (not r) (= i (vectorlength vec))) vec) 228 228 (vectorset! vec i r)))) 229 229
Note: See TracChangeset
for help on using the changeset viewer.