; 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)

OyBwZWFyc29uIGhhc2hpbmcKCihkZWZpbmUgKGZvbGQtbGVmdCBvcCBiYXNlIHhzKQogIChpZiAobnVsbD8geHMpCiAgICAgIGJhc2UKICAgICAgKGZvbGQtbGVmdCBvcCAob3AgYmFzZSAoY2FyIHhzKSkgKGNkciB4cykpKSkKCihkZWZpbmUgKHJhbmdlIC4gYXJncykKICAoY2FzZSAobGVuZ3RoIGFyZ3MpCiAgICAoKDEpIChyYW5nZSAwIChjYXIgYXJncykgKGlmIChuZWdhdGl2ZT8gKGNhciBhcmdzKSkgLTEgMSkpKQogICAgKCgyKSAocmFuZ2UgKGNhciBhcmdzKSAoY2FkciBhcmdzKSAoaWYgKDwgKGNhciBhcmdzKSAoY2FkciBhcmdzKSkgMSAtMSkpKQogICAgKCgzKSAobGV0ICgobGU/IChpZiAobmVnYXRpdmU/IChjYWRkciBhcmdzKSkgPj0gPD0pKSkKICAgICAgICAgICAobGV0IGxvb3AgKCh4KGNhciBhcmdzKSkgKHhzICcoKSkpCiAgICAgICAgICAgICAoaWYgKGxlPyAoY2FkciBhcmdzKSB4KQogICAgICAgICAgICAgICAgIChyZXZlcnNlIHhzKQogICAgICAgICAgICAgICAgIChsb29wICgrIHggKGNhZGRyIGFyZ3MpKSAoY29ucyB4IHhzKSkpKSkpCiAgICAoZWxzZSAoZXJyb3IgJ3JhbmdlICJ1bnJlY29nbml6ZWQgYXJndW1lbnRzIikpKSkKCihkZWZpbmUgc2VlZCAyMDE4MDUyNSkKKGRlZmluZSAocmFuZG9tKSAoc2V0ISBzZWVkIChtb2R1bG8gKCogMTY4MDcgc2VlZCkgMjE0NzQ4MzY0NykpIHNlZWQpCihkZWZpbmUgKHJhbmRpbnQgbikgKGZsb29yICgqIG4gKHJhbmRvbSkgKC8gMjE0NzQ4MzY0NykpKSkKCihkZWZpbmUgKHNodWZmbGUgeCkKICAoZG8gKCh2IChsaXN0LT52ZWN0b3IgeCkpIChuIChsZW5ndGggeCkgKC0gbiAxKSkpCiAgICAgICgoemVybz8gbikgKHZlY3Rvci0+bGlzdCB2KSkKICAgIChsZXQqICgociAocmFuZGludCBuKSkgKHQgKHZlY3Rvci1yZWYgdiByKSkpCiAgICAgICh2ZWN0b3Itc2V0ISB2IHIgKHZlY3Rvci1yZWYgdiAoLSBuIDEpKSkKICAgICAgKHZlY3Rvci1zZXQhIHYgKC0gbiAxKSB0KSkpKQoKKGRlZmluZSB0IChsaXN0LT52ZWN0b3IgKHNodWZmbGUgKHJhbmdlIDI1NikpKSkKCihkZWZpbmUgKHBlYXJzb244IHN0cikKICAoZm9sZC1sZWZ0IChsYW1iZGEgKG4gaCkgKHZlY3Rvci1yZWYgdCAobW9kdWxvICgrIG4gaCkgMjU2KSkpCiAgICAgICAgICAgICAwIChtYXAgY2hhci0+aW50ZWdlciAoc3RyaW5nLT5saXN0IHN0cikpKSkKCihkZWZpbmUgKHBlYXJzb24xNiBzdHIpCiAgKGxldCogKChjczEgKG1hcCBjaGFyLT5pbnRlZ2VyIChzdHJpbmctPmxpc3Qgc3RyKSkpCiAgICAgICAgIChjczIgKGNvbnMgKG1vZHVsbyAoKyAoY2FyIGNzMSkgMSkgMjU2KSAoY2RyIGNzMSkpKSkKICAgIChsZXQgbG9vcCAoKGgxIDApIChoMiAwKSAoY3MxIGNzMSkgKGNzMiBjczIpKQogICAgICAoaWYgKG51bGw/IGNzMSkgKCsgKCogaDEgMjU2KSBoMikKICAgICAgICAobGV0ICgoaDEgKHZlY3Rvci1yZWYgdCAobW9kdWxvICgrIChjYXIgY3MxKSBoMSkgMjU2KSkpCiAgICAgICAgICAgICAgKGgyICh2ZWN0b3ItcmVmIHQgKG1vZHVsbyAoKyAoY2FyIGNzMikgaDIpIDI1NikpKSkKICAgICAgICAgIChsb29wIGgxIGgyIChjZHIgY3MxKSAoY2RyIGNzMikpKSkpKSkKCihkaXNwbGF5IHQpIChuZXdsaW5lKQooZGlzcGxheSAocGVhcnNvbjggIlByb2dyYW1taW5nIFByYXhpcyIpKSAobmV3bGluZSkKKGRpc3BsYXkgKHBlYXJzb24xNiAiUHJvZ3JhbW1pbmcgUHJheGlzIikpIChuZXdsaW5lKQ==