codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; booth's algorithm (define-syntax while (syntax-rules () ((while pred? body ...) (do () ((not pred?)) body ...)))) (define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs)))) (define (cycle . xs) (set-cdr! (last-pair xs) xs) xs) (define (len xs) (let loop ((ys (cdr xs)) (n 1)) (if (eq? xs ys) n (loop (cdr ys) (+ n 1))))) (define (booth lt? xs) (define (eq? a b) (and (not (lt? a b)) (not (lt? b a)))) (let* ((n (len xs)) ; length of cycle (xv (make-vector (+ n n))) ; elements of cycle, repeated (fv (make-vector (+ n n) -1)) ; failure function (k 0)) ; current minimum rotation (do ((i 0 (+ i 1)) (xs xs (cdr xs))) ((= n i)) (vector-set! xv i (car xs)) (vector-set! xv (+ i n) (car xs))) (do ((j 1 (+ j 1))) ((= (+ n n) j)) (let ((i (vector-ref fv (- j k 1)))) (while (and (not (= i -1)) (not (eq? (vector-ref xv j) (vector-ref xv (+ k i 1))))) (if (lt? (vector-ref xv j) (vector-ref xv (+ k i 1))) (set! k (- j i 1))) (set! i (vector-ref fv i))) (if (and (= i -1) (not (eq? (vector-ref xv j) (vector-ref xv (+ k i 1))))) (begin (if (lt? (vector-ref xv j) (vector-ref xv (+ k i 1))) (set! k j)) (vector-set! fv (- j k) -1)) (vector-set! fv (- j k) (+ i 1))))) (let loop ((i 0) (zs (list))) (if (= i n) (reverse zs) (loop (+ i 1) (cons (vector-ref xv (+ i k)) zs)))))) (define (ceq? lt? xs ys) (and (= (len xs) (len ys)) (equal? (booth lt? xs) (booth lt? ys)))) (display (ceq? < (cycle 1 2 3 4) (cycle 1 2 3 4))) (newline) ; #t (display (ceq? < (cycle 1 2 3 4) (cycle 2 3 4 1))) (newline) ; #t (display (ceq? < (cycle 1 2 3 4) (cycle 3 4 1 2))) (newline) ; #t (display (ceq? < (cycle 1 2 3 4) (cycle 4 1 2 3))) (newline) ; #t (display (ceq? < (cycle 1 2 3 4) (cycle 1 2 3 5))) (newline) ; #f (display (ceq? < (cycle 1 1 1 1) (cycle 1 1 1 1))) (newline) ; #t (display (ceq? < (cycle 1 1 1 1) (cycle 1 1 1 2))) (newline) ; #f (display (ceq? < (cycle 1 1 1 1) (cycle 1 1 1))) (newline) ; #f
Private
[
?
]
Run code
Submit