;;;;  -*- Hen -*-
;;;; run.scm

(use test)

;;;

(use type-checks)

(define (shift! ls #!optional default)
  (if (null? ls) default
    (begin
      (check-pair 'shift! ls)
      (let ((x (car ls))
            (d (cdr ls)) )
        (check-pair 'shift! d)
        (set-car! ls (car d))
        (set-cdr! ls (cdr d))
        x ) ) ) )

;;;

;;;

(use levenshtein-operators)

(test-begin "Levenshtein Operators")

(test-group "Operations"

  (test "Insert ref" '#,(levenshtein-operator Insert "Insert" 1 0 1)
    (levenshtein-operator-ref 'Insert))

  (test "Transpose ref" '#,(levenshtein-operator Transpose "Transpose" 1 2 2)
    (levenshtein-operator-ref 'Transpose))

  (test-assert "Make foo"
    (levenshtein-operator=?
      '#,(levenshtein-operator foo "foo" 0.5 12 1)
      (make-levenshtein-operator 'foo "foo" 0.5 12 1)))

  ;-- Do not re-order these
  (test-assert "Set! foo"
    (levenshtein-operator-set! (make-levenshtein-operator 'foo "foo" 0.5 12 1)))

  (test-assert "Ref foo"
    (levenshtein-operator=?
      '#,(levenshtein-operator foo "foo" 0.5 12 1)
      (levenshtein-operator-ref 'foo)))

  (test-assert "Delete! foo" (levenshtein-operator-delete! 'foo))
  ;--

  (test-assert "Delete clone ="
    (levenshtein-operator=?
      '#,(levenshtein-operator Delete "Delete" 0.5 1 0)
      (clone-levenshtein-operator 'Delete cost: 0.5)))
)

(test-end "Levenshtein Operators")

;;;

(use srfi-63)

#| ;UNUSED
(use levenshtein-vector)

(test-begin "Levenshtein Vector")

(let ()

    (define (cost-and-oper-matrix-match? l)
      (and (= 2 (length l))
           (= 6 (car l))
           (array? (cadr l))))

  (test-group "levenshtein"
    (let ((YWCQPGK (list->vector (string->list "YWCQPGK")))
          (LAWYQQKPGKA (list->vector (string->list "LAWYQQKPGKA")) ) )

      (test "distance" 6 (levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA))

      (test-assert "cost-and-oper-matrix-match"
        (cost-and-oper-matrix-match?
          (receive
            (levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t))))

      (test-assert "cost-and-oper-matrix-match: explicit opers"
        (cost-and-oper-matrix-match?
          (receive
            (levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t
              (levenshtein-operator-ref 'Insert)
              (levenshtein-operator-ref 'Delete)
              (levenshtein-operator-ref 'Substitute)
              (levenshtein-operator-ref 'Transpose)))))
    )
  )
)

(test-end "Levenshtein Vector")
|#

(include "levenshtein-cost-fixnum")
(import levenshtein-vector-functor)
(module levenshtein-vector-fixnum = (levenshtein-vector-functor levenshtein-cost-fixnum))
(import (prefix levenshtein-vector-fixnum fx:))

;;

(test-begin "Levenshtein Vector Functor")

(let ()

    (define (cost-and-oper-matrix-match? l)
      (and (= 2 (length l))
           (= 6 (car l))
           (array? (cadr l))))

  (test-group "fixnum cost"
    (let ((YWCQPGK (list->vector (string->list "YWCQPGK")))
          (LAWYQQKPGKA (list->vector (string->list "LAWYQQKPGKA")) ) )

      (test "distance" 6 (fx:levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA))

      (test-assert "cost-and-oper-matrix-match"
        (cost-and-oper-matrix-match?
          (receive
            (fx:levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t))))

      (test-assert "cost-and-oper-matrix-match: explicit opers"
        (cost-and-oper-matrix-match?
          (receive
            (fx:levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t
              (levenshtein-operator-ref 'Insert)
              (levenshtein-operator-ref 'Delete)
              (levenshtein-operator-ref 'Substitute)
              (levenshtein-operator-ref 'Transpose)))))
    )
  )
)

(test-end "Levenshtein Vector Functor")

;;;

(use levenshtein-path-iterator)

(test-begin "Levenshtein Path Iterator")

(let ()

    ;FIXME these are a transpose of the actual PM since source length < target length
    ; see YWCQPGK & LAWYQQKPGKA above, shortest used for target
    ; not a problem in practice since path is the same

    (define (costs-list)
      (list
        1 2 3 3 4 5 6 7 8 9 10
        2 2 2 3 4 5 6 7 8 9 10
        3 3 3 3 4 5 6 7 8 9 10
        4 4 4 4 3 4 5 6 7 8 9
        5 5 5 5 4 4 5 5 6 7 8
        6 6 6 6 5 5 5 6 5 6 7
        7 7 7 7 6 6 5 6 6 5 6
        #f))

    (define (opers-list)
      (let ((io (levenshtein-operator-ref 'Insert))
            (so (levenshtein-operator-ref 'Substitute))
            (do (levenshtein-operator-ref 'Delete)))
        (list
          so do do so do do do do do do do
          io so so do do do do do do do do
          io io io so do do do do do do do
          io io io io so do do do do do do
          io io io io io so do so do do do
          io io io io io io so io so do do
          io io io io io io so do io so do
          #f)))

    (define (gen-test-pm)
      (let ((rs 7)
            (cs 11) )
        (let ((pm (make-array '#() rs cs))
              (costs (costs-list))
              (opers (opers-list)))
          (do ((r 0 (add1 r)))
              ((= r rs))
            (do ((c 0 (add1 c)))
                ((= c cs))
              (array-set! pm (cons (shift! costs) (shift! opers)) r c)))
          pm ) ) )

    (define *test-pm* (gen-test-pm))

    (define (gen-real-iter-vec)
      (let ((iter (levenshtein-path-iterator *test-pm*)) (vec (make-vector 6)))
        (do ((r (iter) (iter))
             (i 0 (add1 i)))
            ((not r) vec)
          (vector-set! vec i r))))

    (define (gen-test-iter-vec)
      (let ((vec (make-vector 6))
            (io (levenshtein-operator-ref 'Insert))
            (so (levenshtein-operator-ref 'Substitute))
            (do (levenshtein-operator-ref 'Delete)))
        (vector-set! vec 0
          (list (list 1 0 0 so) (list 2 1 1 so) (list 3 2 3 so) (list 4 4 5 so) (list 5 4 6 do) (list 6 6 10 do)))
        (vector-set! vec 1
          (list (list 1 0 0 so) (list 2 0 1 do) (list 3 2 3 so) (list 4 4 5 so) (list 5 4 6 do) (list 6 6 10 do)))
        (vector-set! vec 2
          (list (list 1 0 0 so) (list 2 1 1 so) (list 3 2 3 so) (list 4 3 5 do) (list 5 4 6 do) (list 6 6 10 do)))
        (vector-set! vec 3
          (list (list 1 0 0 so) (list 2 0 1 do) (list 3 2 3 so) (list 4 3 5 do) (list 5 4 6 do) (list 6 6 10 do)))
        (vector-set! vec 4
          (list (list 1 0 0 so) (list 2 1 1 so) (list 3 2 3 so) (list 4 3 5 do) (list 5 3 6 do) (list 6 6 10 do)))
        (vector-set! vec 5
          (list (list 1 0 0 so) (list 2 0 1 do) (list 3 2 3 so) (list 4 3 5 do) (list 5 3 6 do) (list 6 6 10 do)))
        vec))

  (test-assert "iterator proc" (procedure? (levenshtein-path-iterator *test-pm*)))

  (test-group "iterator path"
     (let ((vec (gen-test-iter-vec))
           (rvec (gen-real-iter-vec)) )
        (test "gen 0" (vector-ref vec 0) (vector-ref rvec 0))
        (test "gen 1" (vector-ref vec 1) (vector-ref rvec 1))
        (test "gen 2" (vector-ref vec 2) (vector-ref rvec 2))
        (test "gen 3" (vector-ref vec 3) (vector-ref rvec 3))
        (test "gen 4" (vector-ref vec 4) (vector-ref rvec 4))
        (test "gen 5" (vector-ref vec 5) (vector-ref rvec 5))
    )
  )
)

(test-end "Levenshtein Path Iterator")

;;;

(test-begin "Levenshtein Sequence Functor")

(include "levenshtein-cost-numbers")
(include "levenshtein-sequence-utf8")
(import levenshtein-sequence-functor)
(module levenshtein-sequence-numbers-utf8 = (levenshtein-sequence-functor levenshtein-cost-numbers levenshtein-sequence-utf8))
(import (prefix levenshtein-sequence-numbers-utf8 fnu8:))

(test-group "numbers cost & utf8 string"
  (test 6
    (fnu8:levenshtein-distance/sequence "YWCQPGK" "LAWYQQKPGKA" #:elm-eql char=?))
  (test 5
    (fnu8:levenshtein-distance/sequence "YWCQPGK" "LAWYQQKPGKA"
      #:elm-eql char=? #:limit-cost 5))
  (test 2.75
    (fnu8:levenshtein-distance/sequence "YWCQPGK" "LAWYQQKPGKA"
      #:insert-cost 0.5 #:delete-cost 0.25 #:substitute-cost 0.75
      #:elm-eql char=?))
)

(test-end "Levenshtein Sequence Functor")

;;;

(test-exit)