; string search: rabin-karp

(define (fold-left op base xs)
  (if (null? xs)
      base
      (fold-left op (op base (car xs)) (cdr xs))))

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (test-search search)
  (assert (search "Programming Praxis" "Programming Praxis") 0)
  (assert (search "Praxis" "Programming Praxis") 12)
  (assert (search "Prax" "Programming Praxis") 12)
  (assert (search "praxis" "Programming Praxis") #f)
  (assert (search "P" "Programming Praxis") 0)
  (assert (search "P" "Programming Praxis" 5) 12)
)

(define (rk-search pat str . s)
  (define (hash s)
    (fold-left (lambda (x y) (+ (* 256 x) y)) 0
      (map char->integer (string->list s))))
  (let* ((q 1073741789)
         (plen (string-length pat))
         (slen (string-length str))
         (h (modulo (expt 256 (- plen 1)) q))
         (phash (modulo (hash pat) q))
         (s (if (null? s) 0 (car s)))
         (shash (modulo (hash (substring str s (+ s plen))) q)))
    (let loop ((s s) (shash shash))
      (cond ((and (= phash shash)
                  (string=? pat (substring str s (+ s plen)))) s)
            ((<= (- slen plen) s) #f)
            (else (loop (+ s 1)
                        (modulo (+ (* 256 (- shash (* h (char->integer (string-ref str s)))))
                                   (char->integer (string-ref str (+ s plen)))) q)))))))

(test-search rk-search)