Changeset 38891 in project

Timestamp:

08/27/20 05:03:19 (5 months ago)

Author:

Kon Lovett

Message:

simplify

Location:

release/5/levenshtein/trunk

Files:

• levenshtein-path-iterator.scm (modified) (3 diffs)
• tests/levenshtein-test.scm (modified) (1 diff)

release/5/levenshtein/trunk/levenshtein-path-iterator.scm

@@ -15 +15 @@
 (import scheme)
 (import (chicken base))
-(import (srfi 1))
+(import (chicken type))
+(import (only (srfi 1) first map-in-order delete!))
 (import (srfi 63))
 (import miscmacros)
@@ -52 +53 @@
   ;
   (define (trim-path path)
-    (let ((cost -inf.0))
+    (let ((cost 0))
       (remove-false!
+        ;must yield new list
         (map-in-order
           (lambda (elm)
-            (let ((elm-cost (car elm)))
+(print elm)
+            (let ((elm-cost (the number (car elm))))
               (and
                 (not (zero? elm-cost)) (not (= cost elm-cost))
@@ -63 +66 @@
   ;
   (define (cost@ i j)
-    (if (or (< i 0) (< j 0))
+    (if (or (negative? i) (negative? j))
       +inf.0
-      (car (array-ref pm i j)) ) )
+      (the number (first (array-ref pm i j))) ) )
   ;
-  (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 (
-        (r (car dims))
-        (c (cadr dims)) )
-        (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 (sub1 r)) (j (sub1 c)) (path '()))
-                  (and
-                    (not (negative? i)) (not (negative? j))
-                    (let* (
-                      (o (array-ref pm i j))
-                      (oc (car o))
-                      (oo (cdr o))
-                      (np (cons (list oc i j oo) path)) )
-                      (if (and (zero? i) (zero? j))
-                        (yield (trim-path np))
-                        (let (
-                          (ai (sub1 i))
-                          (lj (sub1 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) ) ) ) ) ) ) ) ) ) ) )
-          (lambda ()
-            (let/cc yielder
-              (generator yielder) ) ) ) ) ) ) )
+  (unless (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))
+    (rs (the fixnum (car dims)))
+    (cs (the fixnum (cadr dims))) )
+    (letrec (
+      (generator
+        (lambda (yielder)
+          (let (
+            (yield
+              (lambda (value)
+                (let/cc continue
+                  (set! generator
+                    (lambda (k)
+                      (set! yielder k)
+                      (continue value)))
+                  (yielder value) ) ) ) )
+            (let try ((r (sub1 rs)) (c (sub1 cs)) (path '()))
+              (and
+                (not (negative? r)) (not (negative? c))
+                (let* (
+                  (o (array-ref pm r c))
+                  (oc (the number (car o)))
+                  (np (cons (list oc r c (cdr o)) path)) )
+                  (if (and (zero? r) (zero? c))
+                    (yield (trim-path np))
+                    (let (
+                      (r- (sub1 r))
+                      (c- (sub1 c))
+                      (better #f) )
+                      (when (< (cost@ r c-) oc)
+                        (set! better #t)
+                        (try r c- np) )
+                      (when (< (cost@ r- c) oc)
+                        (set! better #t)
+                        (try r- c np) )
+                      (when (< (cost@ r- c-) oc)
+                        (set! better #t)
+                        (try r- c- np) )
+                      (unless better
+                        (when (= (cost@ r c-) oc)
+                          (try r c- np) )
+                        (when (= (cost@ r- c) oc)
+                          (try r- c np) )
+                        (when (= (cost@ r- c-) oc)
+                          (try r- c- np) ) ) ) ) ) ) ) ) ) ) )
+      (lambda ()
+        (let/cc yielder
+          (generator yielder) ) ) ) ) )
 
 ) ;module levenshtein-path-iterator

release/5/levenshtein/trunk/tests/levenshtein-test.scm

@@ -213 +213 @@
             (do ((c 0 (add1 c)))
                 ((= c cs))
-              (let ((cost (car costs)) (oper (car opers)))
-                (set! costs (cdr costs))
-                (set! opers (cdr opers))
-                (array-set! pm (cons cost oper) r c) ) ) ) ) ) )
+              (array-set! pm (cons (car costs) (car opers)) r c)
+              (set! costs (cdr costs))
+              (set! opers (cdr opers)) ) ) ) ) )
 
     (define *test-pm* (gen-test-pm))
 
     (define (gen-real-iter-vec)
-      (let ((iter (levenshtein-path-iterator *test-pm*)) (vec (make-vector 6)))
+      (let ((vec (make-vector 6))
+            (iter (levenshtein-path-iterator *test-pm*)))
+        ;FIXME path-iterator goes +1 too far
         (do ((r (iter) (iter))
              (i 0 (add1 i)))
-            ;FIXME path-iterator goes +1 too far
-            ((or (not r) (= (vector-length vec) i)) vec)
+            ((or (not r) (= i (vector-length vec))) vec)
           (vector-set! vec i r))))