diff --git a/ansi/kmp.rkt b/ansi/kmp.rkt new file mode 100644 index 0000000..1bde107 --- /dev/null +++ b/ansi/kmp.rkt @@ -0,0 +1,109 @@ +#lang racket/base +;; Knuth-Morris-Pratt string & rope search. + +(provide search-generator + search-string + search-rope) + +(require "rope.rkt") +(require racket/generator) + +(define (table pattern) + (define t (make-vector (- (string-length pattern) 1))) + (vector-set! t 0 0) + (let loop ((pos 1) (candidate 0)) + (cond + [(= pos (- (string-length pattern) 1)) + t] + [(equal? (string-ref pattern pos) + (string-ref pattern candidate)) + (vector-set! t pos (+ candidate 1)) + (loop (+ pos 1) + (+ candidate 1))] + [(> candidate 0) + (loop pos + (vector-ref t candidate))] + [else + (vector-set! t pos 0) + (loop (+ pos 1) + 0)]))) + +;; String (Generator Char) -> (Option Index) +(define (search-generator needle haystack) + (define t (table needle)) + (define cache #f) + (define (advance!) + (define next (haystack)) + (set! cache (and (char? next) next))) + (advance!) + (let loop ((m 0) (i 0)) + (cond + [(not cache) + #f] + [(equal? (string-ref needle i) cache) + (if (= i (- (string-length needle) 1)) + m + (begin (advance!) + (loop m (+ i 1))))] + [(> i 0) + (define ti (vector-ref t (- i 1))) + (loop (- (+ m i) ti) ti)] + [else + (advance!) + (loop (+ m 1) i)]))) + +;; String String -> (Option Index) +(define (search-string needle haystack) + (define t (table needle)) + (let loop ((m 0) (i 0)) + (cond + [(= (+ m i) (string-length haystack)) + #f] + [(equal? (string-ref needle i) (string-ref haystack (+ m i))) + (if (= i (- (string-length needle) 1)) + m + (loop m (+ i 1)))] + [(> i 0) + (define ti (vector-ref t (- i 1))) + (loop (- (+ m i) ti) ti)] + [else + (loop (+ m 1) i)]))) + +;; String Rope -> (Option Index) +(define (search-rope needle haystack #:forward? [forward? #t]) + (if forward? + (search-generator needle (rope-generator haystack)) + (let ((reversed-result (search-generator (list->string (reverse (string->list needle))) + (rope-generator haystack #:forward? #f)))) + (and reversed-result (- (rope-size haystack) reversed-result (string-length needle)))))) + +(module+ test + (require rackunit) + (check-equal? (table "ABCDABD") + (vector 0 0 0 0 1 2)) + (check-equal? (table "PARTICIPATE IN PARACHUTE") + (vector 0 0 0 0 0 0 0 1 2 0 0 0 0 0 0 1 2 3 0 0 0 0 0)) + (check-equal? (search-string "ABCDABD" "ABC ABCDAB ABCDABCDABDE") 15) + (check-equal? (search-string "AAAA" "AAABAAABAAABAAABAAAB") #f) + + (check-equal? (search-generator "ABCDABD" (sequence->generator "ABC ABCDAB ABCDABCDABDE")) 15) + (check-equal? (search-generator "AAAA" (sequence->generator "AAABAAABAAABAAABAAAB")) #f) + + (define prejudice-rope + (rope-concat + (map string->rope + (list "It is a truth universally acknowledged, that a single man in possession of a good fortune must be in want of a wife.\n" + "\n" + "However little known the feelings or views of such a man may be on his first entering a neighbourhood, this truth is so well fixed in the minds of the surrounding families, that he is considered as the rightful property of some one or other of their daughters.\n" + "\n" + "``My dear Mr. Bennet,'' said his lady to him one day, ``have you heard that Netherfield Park is let at last?''\n" + "\n" + "Mr. Bennet replied that he had not.\n")))) + + (check-equal? (search-rope "man" prejudice-rope) 54) + (check-equal? (search-rope "man" prejudice-rope #:forward? #f) 171) + (check-equal? (search-rope "man in" prejudice-rope) 54) + (check-equal? (search-rope "man may" prejudice-rope) 171) + (check-equal? (search-rope "man may" prejudice-rope #:forward? #f) 171) + (check-equal? (search-rope "xylophone" prejudice-rope) #f) + (check-equal? (search-rope "xylophone" prejudice-rope #:forward? #f) #f)) diff --git a/ansi/rope.rkt b/ansi/rope.rkt index 7fc6104..901c470 100644 --- a/ansi/rope.rkt +++ b/ansi/rope.rkt @@ -20,6 +20,7 @@ rope-concat subrope* subrope + rope-generator has-mark? find-next-mark @@ -30,6 +31,7 @@ (require racket/set) (require racket/match) +(require racket/generator) (module+ test (require rackunit racket/pretty)) @@ -365,6 +367,27 @@ (define-values (_l m _r) (subrope* r0 lo0 hi0)) m) +(define (rope-generator r #:forward? [forward? #t]) + (if forward? + (generator () + (let outer ((r r)) + (and r + (begin (outer (rope-left r)) + (match-let (((strand text offset count) (rope-strand r))) + (do ((i 0 (+ i 1))) + ((= i count)) + (yield (string-ref text (+ offset i))))) + (outer (rope-right r)))))) + (generator () + (let outer ((r r)) + (and r + (begin (outer (rope-right r)) + (match-let (((strand text offset count) (rope-strand r))) + (do ((i (- count 1) (- i 1))) + ((negative? i)) + (yield (string-ref text (+ offset i))))) + (outer (rope-left r)))))))) + ;; (require racket/trace) ;; (trace splay-to find-position rope-concat rope-append rope-split rope->string)