Changeset 38890 in project


Ignore:
Timestamp:
08/26/20 23:01:51 (3 months ago)
Author:
Kon Lovett
Message:

rm dep

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

Legend:

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

    r38874 r38890  
    1818(import (srfi 63))
    1919(import miscmacros)
    20 (import numeric-macros)
    2120(import type-checks)
    2221(import type-errors)
     
    2423;;;
    2524
    26 (define (remove-false! ls)
    27   (let ((ls (delete! #f ls eq?)))
    28     (and (not (null? ls)) ls) ) )
     25(define (remove-false! ls) (delete! #f ls eq?))
    2926
    3027(define (strict-array? obj) (and (array? obj) (not (string? obj)) (not (vector? obj))))
     
    5552  ;
    5653  (define (trim-path path)
    57     (let* (
    58       (cost -inf.0) )
     54    (let ((cost -inf.0))
    5955      (remove-false!
    6056        (map-in-order
    6157          (lambda (elm)
    62             (let (
    63               (elm-cost (car elm)) )
     58            (let ((elm-cost (car elm)))
    6459              (and
    65                 (not (or (zero? elm-cost) (= cost elm-cost)))
    66                 (begin
    67                   (set! cost elm-cost)
    68                   elm) ) ) )
     60                (not (zero? elm-cost)) (not (= cost elm-cost))
     61                (begin (set! cost elm-cost) elm)) ) )
    6962          path)) ) )
    7063  ;
     
    7972      (dims (array-dimensions pm)) )
    8073      (let (
    81         (n (car dims))
    82         (m (cadr dims)) )
     74        (r (car dims))
     75        (c (cadr dims)) )
    8376        (letrec (
    8477          (generator
     
    9386                          (continue value)))
    9487                      (yielder value) ) ) ) )
    95                 (let try ((i (-- n)) (j (-- m)) (path '()))
     88                (let try ((i (sub1 r)) (j (sub1 c)) (path '()))
    9689                  (and
    97                     (<= 0 i) (<= 0 j)
     90                    (not (negative? i)) (not (negative? j))
    9891                    (let* (
    9992                      (o (array-ref pm i j))
     
    10194                      (oo (cdr o))
    10295                      (np (cons (list oc i j oo) path)) )
    103                       (if (and (= 0 i) (= 0 j))
    104                           (yield (trim-path np))
    105                           (let ((ai (-- i))
    106                                 (lj (-- j))
    107                                 (better #f))
    108                             (when (< (cost@ i lj) oc)
    109                               (set! better #t)
    110                               (try i lj np))
    111                             (when (< (cost@ ai j) oc)
    112                               (set! better #t)
    113                               (try ai j np))
    114                             (when (< (cost@ ai lj) oc)
    115                               (set! better #t)
    116                               (try ai lj np))
    117                             (unless better
    118                               (when (= (cost@ i lj) oc)
    119                                 (try i lj np))
    120                               (when (= (cost@ ai j) oc)
    121                                 (try ai j np))
    122                               (when (= (cost@ ai lj) oc)
    123                                 (try ai lj np))) ) ) ) ) ) ) ) ) )
     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) ) ) ) ) ) ) ) ) ) ) )
    124118          (lambda ()
    125119            (let/cc yielder
  • release/5/levenshtein/trunk/levenshtein-sequence-functor.scm

    r38477 r38890  
    2727(import vector-lib)
    2828(import miscmacros)
    29 (import moremacros)
    30 (import numeric-macros)
    3129(import type-checks)
    3230(import type-errors)
     
    3432(import CO)
    3533(import SO)
     34
    3635;;;
     36
     37;moremacros
     38(define-syntax swap!
     39  (syntax-rules ()
     40    ((swap! ?a ?b)
     41      (let (
     42        (_tmp ?a) )
     43        (set! ?a ?b)
     44        (set! ?b _tmp)) ) ) )
    3745
    3846(define (levenshtein-distance/sequence source target
     
    117125
    118126                    ; Allocate matrix row/column work vector
    119                     (let ((work (get-work-vector (++ target-length))))
     127                    (let ((work (get-work-vector (add1 target-length))))
    120128
    121129                      ; Initialize work vector
    122                       (do ((k 0 (++ k))
     130                      (do ((k 0 (add1 k))
    123131                           (cost 0 (cost-add cost insert-cost)))
    124132                          ((> k target-length))
     
    146154                                    (set! total-cost
    147155                                      (cost-minimum
    148                                         (cost-add insert-cost (vector-ref work (++ target-index)))
     156                                        (cost-add insert-cost (vector-ref work (add1 target-index)))
    149157                                        (cost-add delete-cost current-cost)
    150158                                        (let ((cost-at-target (vector-ref work target-index)))
  • release/5/levenshtein/trunk/levenshtein-sequence-vector.scm

    r38874 r38890  
    1212(import (chicken type))
    1313(import vector-lib)
    14 (import numeric-macros)
    1514(import type-checks)
    1615(import type-errors)
     
    5857        (if (> i1 e1) 0 (- i1 s1)))
    5958      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
    60         (loop (++ i1) (++ i2)))
     59        (loop (add1 i1) (add1 i2)))
    6160      (else
    6261        (- i1 s1)))) )
     
    6463(define (vector-suffix-length elm-eql v1 v2
    6564          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
    66   (let loop ((i1 (-- e1)) (i2 (-- e2)))
     65  (let loop ((i1 (sub1 e1)) (i2 (sub1 e2)))
    6766    (cond
    6867      ((or (<= i1 s1) (<= i2 s2))
    69         (if (< i1 s1) 0 (- e1 (++ i1))))
     68        (if (< i1 s1) 0 (- e1 (add1 i1))))
    7069      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
    71         (loop (-- i1) (-- i2)))
     70        (loop (sub1 i1) (sub1 i2)))
    7271      (else
    73         (- e1 (++ i1))))) )
     72        (- e1 (add1 i1))))) )
    7473
    7574;;;
  • release/5/levenshtein/trunk/levenshtein-vector-functor.scm

    r38337 r38890  
    1717(import (srfi 63))
    1818(import vector-lib)
    19 (import moremacros)
    20 (import numeric-macros)
    2119(import type-checks)
    2220(import type-errors)
     
    2523
    2624;;;
     25
     26;moremacros
     27(define-syntax swap!
     28  (syntax-rules ()
     29    ((swap! ?a ?b)
     30      (let (
     31        (_tmp ?a) )
     32        (set! ?a ?b)
     33        (set! ?b _tmp)) ) ) )
    2734
    2835;; Types
     
    4047      (let ((idx 0)
    4148            (val (vector-ref vec 0)) )
    42         (do ((i 1 (++ i)))
     49        (do ((i 1 (add1 i)))
    4350            ((= i len) (values val idx))
    4451          (let ((nval (vector-ref vec i)))
     
    5158(define (levenshtein/vector sv tv n m cv av lv elm-eql perf finf)
    5259
    53   (let ((wrkvec (make-vector (++ m)))
     60  (let ((wrkvec (make-vector (add1 m)))
    5461        (inscst (vector-ref cv 0))
    5562        (delcst (vector-ref cv 1)) )
    5663
    57     (do ((k 0 (++ k))
     64    (do ((k 0 (add1 k))
    5865         (cst 0 (cost-add cst inscst)))
    5966        ((> k m))
     
    6269    (let ((next #f))
    6370
    64       (do ((i 0 (++ i)))
     71      (do ((i 0 (add1 i)))
    6572          ((= i n) (finf next))
    6673
    6774        (let ((s@i (vector-ref sv i)))
    6875
    69           (do ((j 0 (++ j))
    70                (cur (cost-multiply delcst (++ i)) next))
     76          (do ((j 0 (add1 j))
     77               (cur (cost-multiply delcst (add1 i)) next))
    7178              ((= j m) (vector-set! wrkvec m next))
    7279
     
    7885                          (if (= l 0)                                   ; - -
    7986                            (cost-add cost (vector-ref wrkvec j))         ; 0 0
    80                             (cost-add cost (vector-ref wrkvec (++ j)))) ; 0 1
     87                            (cost-add cost (vector-ref wrkvec (add1 j)))) ; 0 1
    8188                          (if (zero? l)                                   ;
    8289                            (cost-add cost cur)                           ; 1 0
     
    95102(define (levenshtein/matrix sv tv n m cv av lv elm-eql perf finf)
    96103
    97   (let ((mat (make-array '#() (++ n) (++ m)))
     104  (let ((mat (make-array '#() (add1 n) (add1 m)))
    98105        (inscst (vector-ref cv 0))
    99106        (delcst (vector-ref cv 1)))
    100107
    101     (do ((j 0 (++ j))
     108    (do ((j 0 (add1 j))
    102109         (cst 0 (cost-add cst inscst)))
    103110        ((> j m))
    104111      (array-set! mat cst 0 j) )
    105112
    106     (do ((i 1 (++ i)))
     113    (do ((i 1 (add1 i)))
    107114        ((> i n) (finf (array-ref mat n m)))
    108115
    109116      (array-set! mat (cost-multiply i delcst) i 0)
    110117
    111       (let* ((i-1 (-- i))
     118      (let* ((i-1 (sub1 i))
    112119             (s@i (vector-ref sv i-1)) )
    113120
    114         (do ((j 1 (++ j)))
     121        (do ((j 1 (add1 j)))
    115122            ((> j m))
    116123
    117           (let* ((j-1 (-- j))
     124          (let* ((j-1 (sub1 j))
    118125                 (t-j (vector-ref tv j-1)) )
    119126
     
    279286              (lambda (len)
    280287                (let ((io-c (levenshtein-operator-cost insoper)))
    281                   (do ((i 0 (++ i))
     288                  (do ((i 0 (add1 i))
    282289                        (i-cost io-c (cost-add i-cost io-c)))
    283290                      ((= i pm-rows))
    284                     (do ((j 0 (++ j))
     291                    (do ((j 0 (add1 j))
    285292                          (j-cost i-cost (cost-add j-cost io-c)))
    286293                        ((= j pm-cols))
  • release/5/levenshtein/trunk/levenshtein-vector.scm

    r38337 r38890  
    1616(import (srfi 63))
    1717(import vector-lib)
    18 (import moremacros)
    19 (import numeric-macros)
    2018(import type-checks)
    2119(import type-errors)
     
    2321
    2422;;;
     23
     24;moremacros
     25(define-syntax swap!
     26  (syntax-rules ()
     27    ((swap! ?a ?b)
     28      (let (
     29        (_tmp ?a) )
     30        (set! ?a ?b)
     31        (set! ?b _tmp)) ) ) )
    2532
    2633;; Types
     
    3845      (let ((idx 0)
    3946            (val (vector-ref vec 0)) )
    40         (do ((i 1 (++ i)))
     47        (do ((i 1 (add1 i)))
    4148            ((= i len) (values val idx))
    4249          (let ((nval (vector-ref vec i)))
     
    4956(define (levenshtein/vector sv tv n m cv av lv eqlp perf finf plus mult ltp)
    5057
    51   (let ((wrkvec (make-vector (++ m)))
     58  (let ((wrkvec (make-vector (add1 m)))
    5259        (inscst (vector-ref cv 0))
    5360        (delcst (vector-ref cv 1)) )
    5461
    55     (do ((k 0 (++ k))
     62    (do ((k 0 (add1 k))
    5663         (cst 0 (plus cst inscst)))
    5764        ((> k m))
     
    6067    (let ((next #f))
    6168
    62       (do ((i 0 (++ i)))
     69      (do ((i 0 (add1 i)))
    6370          ((= i n) (finf next))
    6471
    6572        (let ((s-i (vector-ref sv i)))
    6673
    67           (do ((j 0 (++ j))
    68                (cur (mult delcst (++ i)) next))
     74          (do ((j 0 (add1 j))
     75               (cur (mult delcst (add1 i)) next))
    6976              ((= j m) (vector-set! wrkvec m next))
    7077
     
    7683                            (if (zero? l)                                   ; - -
    7784                                (plus cost (vector-ref wrkvec j))           ; 0 0
    78                                 (plus cost (vector-ref wrkvec (++ j))))   ; 0 1
     85                                (plus cost (vector-ref wrkvec (add1 j))))   ; 0 1
    7986                            (if (zero? l)                                   ;
    8087                                (plus cost cur)                             ; 1 0
     
    94101(define (levenshtein/matrix sv tv n m cv av lv eqlp perf finf plus mult ltp)
    95102
    96   (let ((mat (make-array '#() (++ n) (++ m)))
     103  (let ((mat (make-array '#() (add1 n) (add1 m)))
    97104        (inscst (vector-ref cv 0))
    98105        (delcst (vector-ref cv 1)))
    99106
    100     (do ((j 0 (++ j))
     107    (do ((j 0 (add1 j))
    101108         (cst 0 (plus cst inscst)))
    102109        ((> j m))
    103110      (array-set! mat cst 0 j) )
    104111
    105     (do ((i 1 (++ i)))
     112    (do ((i 1 (add1 i)))
    106113        ((> i n) (finf (array-ref mat n m)))
    107114
    108115      (array-set! mat (mult i delcst) i 0)
    109116
    110       (let* ((i-1 (-- i))
     117      (let* ((i-1 (sub1 i))
    111118             (s-i (vector-ref sv i-1)) )
    112119
    113         (do ((j 1 (++ j)))
     120        (do ((j 1 (add1 j)))
    114121            ((> j m))
    115122
    116           (let* ((j-1 (-- j))
     123          (let* ((j-1 (sub1 j))
    117124                 (t-j (vector-ref tv j-1)) )
    118125
     
    285292                (lambda (len)
    286293                  (let ((io-c (levenshtein-operator-cost insoper)))
    287                     (do ((i 0 (++ i))
     294                    (do ((i 0 (add1 i))
    288295                          (i-cost io-c (plus i-cost io-c)))
    289296                        ((= i pm-rows))
    290                       (do ((j 0 (++ j))
     297                      (do ((j 0 (add1 j))
    291298                            (j-cost i-cost (plus j-cost io-c)))
    292299                          ((= j pm-cols))
  • release/5/levenshtein/trunk/levenshtein.egg

    r38874 r38890  
    77        (author "[[kon lovett]]")
    88        (license "BSD")
    9         (dependencies
    10                 srfi-1 srfi-13 srfi-63 srfi-69 vector-lib utf8 check-errors
    11                 (miscmacros "1.0")
    12                 (moremacros "2.2.1") )
     9        (dependencies srfi-1 srfi-13 srfi-63 srfi-69 vector-lib utf8 check-errors miscmacros)
    1310        ; other test deps met by egg deps
    1411  (test-dependencies test)
  • release/5/levenshtein/trunk/tests/levenshtein-test.scm

    r38874 r38890  
    88
    99;;;
    10 
    11 (import type-checks)
    12 
    13 (define (shift! ls #!optional default)
    14   (if (null? ls) default
    15     (begin
    16       (check-pair 'shift! ls)
    17       (let ((x (car ls))
    18             (d (cdr ls)) )
    19         (check-pair 'shift! d)
    20         (set-car! ls (car d))
    21         (set-cdr! ls (cdr d))
    22         x ) ) ) )
    2310
    2411;until R⁷RS
     
    202189        5 5 5 5 4 4 5 5 6 7 8
    203190        6 6 6 6 5 5 5 6 5 6 7
    204         7 7 7 7 6 6 5 6 6 5 6
    205         #f))
     191        7 7 7 7 6 6 5 6 6 5 6))
    206192
    207193    (define (opers-list)
     
    216202          io io io io io so do so do do do
    217203          io io io io io io so io so do do
    218           io io io io io io so do io so do
    219           #f)))
     204          io io io io io io so do io so do)))
    220205
    221206    (define (gen-test-pm)
    222       (let ((rs 7)
    223             (cs 11) )
     207      (let ((rs 7) (cs 11))
    224208        (let ((pm (make-array '#() rs cs))
    225209              (costs (costs-list))
    226210              (opers (opers-list)))
    227211          (do ((r 0 (add1 r)))
    228               ((= r rs))
     212              ((= r rs) pm)
    229213            (do ((c 0 (add1 c)))
    230214                ((= c cs))
    231               (array-set! pm (cons (shift! costs) (shift! opers)) r c)))
    232           pm ) ) )
     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) ) ) ) ) ) )
    233219
    234220    (define *test-pm* (gen-test-pm))
Note: See TracChangeset for help on using the changeset viewer.