codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; cyclic equality (define (cycle . xs) (set-cdr! (last-pair xs) xs) xs) (define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs)))) (define (len xs) (let loop ((ys (cdr xs)) (n 1)) (if (eq? xs ys) n (loop (cdr ys) (+ n 1))))) (define (ceq? eql? xs ys) (let ((n (len xs))) (if (not (= n (len ys))) #f (let loop1 ((n n) (ys ys)) (cond ((zero? n) #f) ((eql? (car xs) (car ys)) (let loop2 ((x (cdr xs)) (y (cdr ys))) (cond ((eq? x xs) #t) ((eql? (car x) (car y)) (loop2 (cdr x) (cdr y))) (else (loop1 (- n 1) (cdr ys)))))) (else (loop1 (- n 1) (cdr 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