Changeset 38891 in project


Ignore:
Timestamp:
08/27/20 05:03:19 (4 weeks ago)
Author:
Kon Lovett
Message:

simplify

Location:
release/5/levenshtein/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/levenshtein/trunk/levenshtein-path-iterator.scm

    r38890 r38891  
    1515(import scheme)
    1616(import (chicken base))
    17 (import (srfi 1))
     17(import (chicken type))
     18(import (only (srfi 1) first map-in-order delete!))
    1819(import (srfi 63))
    1920(import miscmacros)
     
    5253  ;
    5354  (define (trim-path path)
    54     (let ((cost -inf.0))
     55    (let ((cost 0))
    5556      (remove-false!
     57        ;must yield new list
    5658        (map-in-order
    5759          (lambda (elm)
    58             (let ((elm-cost (car elm)))
     60(print elm)
     61            (let ((elm-cost (the number (car elm))))
    5962              (and
    6063                (not (zero? elm-cost)) (not (= cost elm-cost))
     
    6366  ;
    6467  (define (cost@ i j)
    65     (if (or (< i 0) (< j 0))
     68    (if (or (negative? i) (negative? j))
    6669      +inf.0
    67       (car (array-ref pm i j)) ) )
     70      (the number (first (array-ref pm i j))) ) )
    6871  ;
    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) ) ) ) ) )
    121123
    122124) ;module levenshtein-path-iterator
  • release/5/levenshtein/trunk/tests/levenshtein-test.scm

    r38890 r38891  
    213213            (do ((c 0 (add1 c)))
    214214                ((= 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)) ) ) ) ) )
    219218
    220219    (define *test-pm* (gen-test-pm))
    221220
    222221    (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
    224225        (do ((r (iter) (iter))
    225226             (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)
    228228          (vector-set! vec i r))))
    229229
Note: See TracChangeset for help on using the changeset viewer.