;;; -*- Mode: Scheme -*-

;;;; Knuth-Morris-Pratt Fixed-Pattern Search Algorithm
;;;; Tests

;;; This code is written by Taylor R. Campbell and placed in the Public
;;; Domain.  All warranties are disclaimed.

(define-test-suite knuth-morris-pratt-tests
  "Knuth-Morris-Pratt fixed-pattern search algorithm")

(define-test-suite (kmp-tests.prefix-table knuth-morris-pratt-tests)
  "Computing prefix tables")

(define-test-case kmp-tests.prefix-table 0 ()
  (test-equal '#(#f)
    (compute-kmp-prefix-table "a" 0 1)))

(define-test-case kmp-tests.prefix-table 1 ()
  (test-equal '#(#f #f)
    (compute-kmp-prefix-table "aa" 0 2)))

(define-test-case kmp-tests.prefix-table 2 ()
  (test-equal '#(#f 0)
    (compute-kmp-prefix-table "ab" 0 2)))

(define-test-case kmp-tests.prefix-table 3 ()
  (test-equal '#(#f 0 0 0 #f 1 2 3 1)
    (compute-kmp-prefix-table "abcdabcab" 0 9)))

(define-test-case kmp-tests.prefix-table 4 ()
  (test-equal '#(#f 0 0 #f 1 2)
    (compute-kmp-prefix-table "barbaz" 0 6)))

(define-test-case kmp-tests.prefix-table 5 ()
  (test-equal '#(#f 0 0 0 0 0)
    (compute-kmp-prefix-table "zabrab" 0 6)))

(define-test-suite (kmp-tests.suffix-table knuth-morris-pratt-tests)
  "Computing suffix tables")

(define-test-case kmp-tests.suffix-table 0 ()
  (test-equal '#(#f)
    (compute-kmp-suffix-table "a" 0 1)))

(define-test-case kmp-tests.suffix-table 1 ()
  (test-equal '#(#f #f)
    (compute-kmp-suffix-table "aa" 0 2)))

(define-test-case kmp-tests.suffix-table 2 ()
  (test-equal '#(2 #f)
    (compute-kmp-suffix-table "ab" 0 2)))

(define-test-case kmp-tests.suffix-table 3 ()
  (test-equal '#(8 #f 9 7 8 #f 9 9 #f)
    (compute-kmp-suffix-table "abcdabcab" 0 9)))

(define-test-case kmp-tests.suffix-table 4 ()
  (test-equal '#(6 6 6 6 6 #f)
    (compute-kmp-suffix-table "barbaz" 0 6)))

(define-test-case kmp-tests.suffix-table 5 ()
  (test-equal '#(4 5 #f 6 6 #f)
    (compute-kmp-suffix-table "zabrab" 0 6)))

(define-test-suite (kmp-tests.partial-search knuth-morris-pratt-tests)
  "Partial search with KMP")

(define (test-kmp-partial search compute-table pattern pattern-index instance)
  (search instance 0 (vector-8b-length instance)
          pattern 0 pattern-index
          (compute-table pattern 0 (vector-8b-length pattern))))

(define (test-kmp-partial-forward pattern pattern-index instance)
  (test-kmp-partial kmp-partial-search-forward
                    compute-kmp-prefix-table
                    pattern pattern-index instance))

(define (test-kmp-partial-backward pattern pattern-index instance)
  (test-kmp-partial kmp-partial-search-backward
                    compute-kmp-suffix-table
                    pattern pattern-index instance))

(define-test-case kmp-tests.partial-search forward.0 ()
  (test-eqv -3 (test-kmp-partial-forward "foo" 0 "foobarbazquux")))

(define-test-case kmp-tests.partial-search forward.1 ()
  (test-eqv -6 (test-kmp-partial-forward "bar" 0 "foobarbazquux")))

(define-test-case kmp-tests.partial-search forward.2 ()
  (test-eqv -9 (test-kmp-partial-forward "barbaz" 0 "foobarbazquux")))

(define-test-case kmp-tests.partial-search forward.3 ()
  (test-eqv 1 (test-kmp-partial-forward "barbaz" 0 "foob")))

(define-test-case kmp-tests.partial-search forward.4 ()
  (test-eqv -5 (test-kmp-partial-forward "barbaz" 1 "arbazquux")))

(define-test-case kmp-tests.partial-search forward.5 ()
  (test-eqv 5 (test-kmp-partial-forward "barbaz" 1 "arba")))

(define-test-case kmp-tests.partial-search forward.6 ()
  (test-eqv 4 (test-kmp-partial-forward "barbaz" 0 "foobarbabarb")))

(define-test-case kmp-tests.partial-search backward.0 ()
  (test-eqv 0 (test-kmp-partial-backward "foo" 3 "foobarbazquux")))

(define-test-case kmp-tests.partial-search backward.1 ()
  (test-eqv -3 (test-kmp-partial-backward "bar" 3 "foobarbazquux")))

(define-test-case kmp-tests.partial-search backward.2 ()
  (test-eqv -3 (test-kmp-partial-backward "barbaz" 6 "foobarbazquux")))

(define-test-case kmp-tests.partial-search backward.3 ()
  (test-eqv 5 (test-kmp-partial-backward "barbaz" 6 "zquux")))

(define-test-case kmp-tests.partial-search backward.4 ()
  (test-eqv -3 (test-kmp-partial-backward "barbaz" 5 "foobarba")))

(define-test-case kmp-tests.partial-search backward.5 ()
  (test-eqv 1 (test-kmp-partial-backward "barbaz" 5 "arba")))

(define-test-case kmp-tests.partial-search backward.6 ()
  (test-eqv 2 (test-kmp-partial-backward "barbaz" 6 "rbazquux")))

(define-test-suite (kmp-tests.search knuth-morris-pratt-tests)
  "Applying the search algorithm")

(define (test-kmp-search search cache pattern instance)
  (search instance 0 (vector-8b-length instance)
          (cache pattern 0 (vector-8b-length pattern))))

(define (test-kmp-forward-search pattern instance)
  (test-kmp-search vector-8b-search-forward/kmp
                   vector-8b-forward-search-cache/kmp
                   pattern instance))

(define (test-kmp-backward-search pattern instance)
  (test-kmp-search vector-8b-search-backward/kmp
                   vector-8b-backward-search-cache/kmp
                   pattern instance))

(define (test-kmp-forward-search* pattern instance)
  (test-kmp-search vector-8b-search-forward*/kmp
                   vector-8b-forward-search-cache/kmp
                   pattern instance))

(define (test-kmp-backward-search* pattern instance)
  (test-kmp-search vector-8b-search-backward*/kmp
                   vector-8b-backward-search-cache/kmp
                   pattern instance))

(define-test-suite (kmp-tests.search-forward kmp-tests.search)
  "Single-occurrence forward search")

(define-test-case kmp-tests.search-forward 0 ()
  (test-eqv 2 (test-kmp-forward-search "a" "cbabcbabc")))

(define-test-case kmp-tests.search-forward 1 ()
  (test-eqv 1 (test-kmp-forward-search "bab" "cbabcbabc")))

(define-test-case kmp-tests.search-forward 2 ()
  (test-eqv 4 (test-kmp-forward-search "barbaz" "fooobarbazquuxbazot")))

(define-test-case kmp-tests.search-forward 3 ()
  (test-eqv 18
    (test-kmp-forward-search "abcdabcab" "xbcdabcababcdabxababcdabcabx")))

(define-test-suite (kmp-tests.search-backward kmp-tests.search)
  "Single-occurrence backward search")

(define-test-case kmp-tests.search-backward 0 ()
  (test-eqv 6 (test-kmp-backward-search "a" "cbabcbabc")))

(define-test-case kmp-tests.search-backward 1 ()
  (test-eqv 5 (test-kmp-backward-search "bab" "cbabcbabc")))

(define-test-case kmp-tests.search-backward 2 ()
  (test-eqv 4 (test-kmp-backward-search "barbaz" "fooobarbazquuxbazot")))

(define-test-case kmp-tests.search-backward 3 ()
  (test-eqv 18
    (test-kmp-backward-search "abcdabcab" "xbcdabcababcdabxababcdabcabx")))

(define-test-suite (kmp-tests.search-forward* kmp-tests.search)
  "Multiple-occurrence forward search")

(define-test-case kmp-tests.search-forward* 0 ()
  (test-equal '(0 1 2 3 4 5)
    (test-kmp-forward-search* "a" "aaaaaa")))

(define-test-case kmp-tests.search-forward* 1 ()
  (test-equal '(0 1 2 3 4)
    (test-kmp-forward-search* "aa" "aaaaaa")))

(define-test-case kmp-tests.search-forward* 2 ()
  (test-equal '(0 2 4)
    (test-kmp-forward-search* "ab" "ababab")))

(define-test-case kmp-tests.search-forward* 3 ()
  (test-equal '(4 10)
    (test-kmp-forward-search* "abab" "abacababaxababx")))

(define-test-case kmp-tests.search-forward* 4 ()
  (test-equal '(6 24)
    (test-kmp-forward-search* "barbaz" "foooazbarbazquuxzotarbazbarbaz")))

(define-test-suite (kmp-tests.search-backward* kmp-tests.search)
  "Multiple-occurrence backward search")

(define-test-case kmp-tests.search-backward* 0 ()
  (test-equal '(5 4 3 2 1 0)
    (test-kmp-backward-search* "a" "aaaaaa")))

(define-test-case kmp-tests.search-backward* 1 ()
  (test-equal '(4 3 2 1 0)
    (test-kmp-backward-search* "aa" "aaaaaa")))

(define-test-case kmp-tests.search-backward* 2 ()
  (test-equal '(4 2 0)
    (test-kmp-backward-search* "ab" "ababab")))

(define-test-case kmp-tests.search-backward* 3 ()
  (test-equal '(10 4)
    (test-kmp-backward-search* "abab" "abacababaxababx")))

(define-test-case kmp-tests.search-backward* 4 ()
  (test-equal '(24 6)
    (test-kmp-backward-search* "barbaz" "foooazbarbazquuxzotarbazbarbaz")))