Boyer-Moore-Horspool implementation for rope.plt

index-of.rkt

#lang racket
(require (planet "rope.ss" ("dyoo" "rope.plt" 3)))

;; Boyer-Moore-Horspool algorithm for rope.plt
;; http://en.wikipedia.org/wiki/Boyer-Moore-Horspool_algorithm
;; http://planet.racket-lang.org/display.ss?package=rope.plt&owner=dyoo

(define (build-skip-table subrope)
  (let ([sublen (rope-length subrope)]
        [bcs (make-weak-hash)]
        [scan 0])
    (rope-for-each
     (lambda (ch)
       (when (< scan (sub1 sublen))
         (hash-set! bcs ch (sub1 (- sublen scan)))
         (set! scan (add1 scan))))
     subrope)
    bcs))

(define (rope-index-of rope subrope i)
  (let ([len (rope-length rope)]
        [sublen (rope-length subrope)]
        [bcs (build-skip-table subrope)]
        [idx -1])
    (do ([j (sub1 (+ i sublen)) (+ j (hash-ref bcs (rope-ref rope j) sublen))])
        ((or (>= idx 0) (>= j len)) idx)
      (do ([x j (sub1 x)]
           [y (sub1 sublen) (sub1 y)])
          ((or (eq? y -1) (not (eq? (rope-ref rope x) (rope-ref subrope y)))) idx)
        (when (zero? y)
          (set! idx x))))))

(module+ test
  (require rackunit)
  (define a-rope (string->rope "The Boyer-Moore-Horspool algorithm is an algorithm för finding substrings in strings"))

  (check-equal? 51 (rope-index-of a-rope (string->rope "för") 0))
  (check-equal? 25 (rope-index-of a-rope (string->rope "algorithm") 0))
  (check-equal? 41 (rope-index-of a-rope (string->rope "algorithm") 26))
  (check-equal? -1 (rope-index-of a-rope (string->rope "algorithm") 42))
  (check-equal? -1 (rope-index-of a-rope (string->rope "Algorithm") 0)))

(provide rope-index-of)