[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/fcVpNq5G    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Apr 8:
; 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


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


Create a new paste based on this one


Comments: