; pearson hashing

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

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define seed 20180525)
(define (random) (set! seed (modulo (* 16807 seed) 2147483647)) seed)
(define (randint n) (floor (* n (random) (/ 2147483647))))

(define (shuffle x)
  (do ((v (list->vector x)) (n (length x) (- n 1)))
      ((zero? n) (vector->list v))
    (let* ((r (randint n)) (t (vector-ref v r)))
      (vector-set! v r (vector-ref v (- n 1)))
      (vector-set! v (- n 1) t))))

(define t (list->vector (shuffle (range 256))))

(define (pearson8 str)
  (fold-left (lambda (n h) (vector-ref t (modulo (+ n h) 256)))
             0 (map char->integer (string->list str))))

(define (pearson16 str)
  (let* ((cs1 (map char->integer (string->list str)))
         (cs2 (cons (modulo (+ (car cs1) 1) 256) (cdr cs1))))
    (let loop ((h1 0) (h2 0) (cs1 cs1) (cs2 cs2))
      (if (null? cs1) (+ (* h1 256) h2)
        (let ((h1 (vector-ref t (modulo (+ (car cs1) h1) 256)))
              (h2 (vector-ref t (modulo (+ (car cs2) h2) 256))))
          (loop h1 h2 (cdr cs1) (cdr cs2)))))))

(display t) (newline)
(display (pearson8 "Programming Praxis")) (newline)
(display (pearson16 "Programming Praxis")) (newline)