codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; cuckoo hashing (define (prime? n) ; baillie-wagstaff (define (expm b e m) (define (times x y) (modulo (* x y) m)) (cond ((zero? e) 1) ((even? e) (expm (times b b) (/ e 2) m)) (else (times b (expm (times b b) (/ (- e 1) 2) m))))) (define (digits n) (let loop ((n n) (ds '())) (if (zero? n) ds (loop (quotient n 2) (cons (modulo n 2) ds))))) (define (isqrt n) (let loop ((x n) (y (quotient (+ n 1) 2))) (if (<= 0 (- y x) 1) x (loop y (quotient (+ y (quotient n y)) 2))))) (define (square? n) (let ((n2 (isqrt n))) (= n (* n2 n2)))) (define (jacobi a n) (let loop ((a a) (n n)) (cond ((= a 0) 0) ((= a 1) 1) ((= a 2) (case (modulo n 8) ((1 7) 1) ((3 5) -1))) ((even? a) (* (loop 2 n) (loop (/ a 2) n))) ((< n a) (loop (modulo a n) n)) ((and (= (modulo a 4) 3) (= (modulo n 4) 3)) (- (loop n a))) (else (loop n a))))) (define (inverse x m) (let loop ((a 1) (b 0) (g x) (u 0) (v 1) (w m)) (if (zero? w) (modulo a m) (let ((q (quotient g w))) (loop u v w (- a (* q u)) (- b (* q v)) (- g (* q w))))))) (define (strong-pseudo-prime? n a) (let loop ((r 0) (s (- n 1))) (if (even? s) (loop (+ r 1) (/ s 2)) (if (= (expm a s n) 1) #t (let loop ((r r) (s s)) (cond ((zero? r) #f) ((= (expm a s n) (- n 1)) #t) (else (loop (- r 1) (* s 2))))))))) (define (chain m f g u v) (let loop ((ms (digits m)) (u u) (v v)) (cond ((null? ms) (values u v)) ((zero? (car ms)) (loop (cdr ms) (f u) (g u v))) (else (loop (cdr ms) (g u v) (f v)))))) (define (lucas-pseudo-prime? n) (let loop ((a 11) (b 7)) (let ((d (- (* a a) (* 4 b)))) (cond ((square? d) (loop (+ a 2) (+ b 1))) ((not (= (gcd n (* 2 a b d)) 1)) (loop (+ a 2) (+ b 2))) (else (let* ((x1 (modulo (- (* a a (inverse b n)) 2) n)) (m (quotient (- n (jacobi d n)) 2)) (f (lambda (u) (modulo (- (* u u) 2) n))) (g (lambda (u v) (modulo (- (* u v) x1) n)))) (let-values (((xm xm1) (chain m f g 2 x1))) (zero? (modulo (- (* x1 xm) (* 2 xm1)) n))))))))) (if (not (integer? n)) (error 'prime? "must be integer") (if (< n 2) #f (if (even? n) (= n 2) (if (zero? (modulo n 3)) (= n 3) (and (strong-pseudo-prime? n 2) (strong-pseudo-prime? n 3) (lucas-pseudo-prime? n))))))) (define (next-prime n) (cond ((< n 2) 2) ((< n 3) 3) (else (let loop ((n (+ (if (even? n) 1 2) n))) (if (prime? n) n (loop (+ n 2))))))) (define (ilog b n) (let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b)) (if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi)) (let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi)) (if (<= (- hi lo) 1) (if (= b^hi n) hi lo) (let* ((mid (quotient (+ lo hi) 2)) (b^mid (* b^lo (expt b (- mid lo))))) (cond ((< n b^mid) (loop2 lo b^lo mid b^mid)) ((< b^mid n) (loop2 mid b^mid hi b^hi)) (else mid)))))))) (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 (string-hash str x) (let loop ((cs (string->list str)) (h 0)) (if (null? cs) h (loop (cdr cs) (+ (* h x) (char->integer (car cs))))))) (define (reset-multipliers) (set! x1 (next-prime x2)) (set! x2 (next-prime x1))) (define (lookup table key) (let ((h (modulo (string-hash key x1) table-size))) (if (and (pair? (vector-ref table h)) (string=? (car (vector-ref table h)) key)) (vector-ref table h) (let ((h (modulo (string-hash key x2) table-size))) (if (and (pair? (vector-ref table h)) (string=? (car (vector-ref table h)) key)) (vector-ref table h) '()))))) (define (insert table key value) (define (hash key x) (modulo (string-hash key x) table-size)) (if (pair? (lookup table key)) (let ((h1 (hash key x1)) (h2 (hash key x2))) (if (= (car (vector-ref table h1)) key) (begin (vector-set! table h1 (cons key value)) table) (begin (vector-set! table h2 (cons key value)) table))) (let loop ((key key) (value value) (count max-probes)) (let ((h1 (hash key x1)) (h2 (hash key x2))) (cond ((null? (vector-ref table h1)) (vector-set! table h1 (cons key value)) table) ((null? (vector-ref table h2)) (vector-set! table h2 (cons key value)) table) ((zero? count) (set! table (rehash table)) (insert table key value)) (else (let ((t (vector-ref table h1))) (vector-set! table h1 (cons key value)) (loop (car t) (cdr t) (- count 1))))))))) (define (rehash table) (reset-multipliers) (let loop ((new-table (make-vector table-size '())) (i 0)) (if (= i table-size) new-table (let ((t (vector-ref table i))) (if (pair? t) (loop (insert new-table (car t) (cdr t)) (+ i 1)) (loop new-table (+ i 1))))))) (define (delete table key) (let ((h (modulo (string-hash key x1) table-size))) (if (and (pair? (vector-ref table h)) (string=? (car (vector-ref table h)) key)) (vector-set! table h '()) (let ((h (modulo (string-hash key x2) table-size))) (if (and (pair? (vector-ref table h)) (string=? (car (vector-ref table h)) key)) (vector-set! table h '()))))) table) (define x1 #f) (define x2 #f) (define table-size #f) (define max-probes #f) (define (make-hash max-size) (set! x1 31) (set! x2 37) (set! table-size (next-prime (* 2 max-size))) (set! max-probes (max (* (ilog 2 max-size) 2) 20)) (make-vector table-size '())) (define (enlist table) (let loop ((i 0) (xs '())) (if (= i table-size) xs (let ((t (vector-ref table i))) (loop (+ i 1) (if (pair? t) (cons t xs) xs)))))) (define words '("alpha" "bravo" "charlie" "delta" "echo" "foxtrot" "golf" "hotel" "india" "juliet" "kilo" "lima" "mike" "november" "oscar" "papa" "quebec" "romeo" "sierra" "tango" "uniform" "victor" "whiskey" "xray" "yankee" "zulu")) (define (cuckoo-test) (let ((t (make-hash 25))) (assert (lookup t "praxis") '()) (let loop ((words words) (val 1)) (when (pair? words) (set! t (insert t (car words) val)) (loop (cdr words) (+ val 1)))) (assert (lookup t "praxis") '()) (assert (cdr (lookup t "papa")) 16) (set! t (delete t "papa")) (assert (lookup t "papa") '()))) (cuckoo-test)
Private
[
?
]
Run code
Submit