Project:

Scheme, pasted on Apr 11:
 ```1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 ``` ```; 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 ```

Output:
 ```1 2 3 4 5 6 7 8 ``` ```#t #t #t #t #f #t #f #f ```