; perfect shuffle

(define (deck n)
  (let loop ((n n) (ds (list)))
    (if (zero? n) ds
      (loop (- n 1) (cons n ds)))))

(define (faro xs)
  (let loop1 ((ts xs) (hs xs) (ys (list)))
    (if (and (pair? hs) (pair? (cdr hs)))
        (loop1 (cdr ts) (cddr hs) (cons (car ts) ys))
        (let loop2 ((xs (reverse ts)) (ys ys) (zs (list)))
          (if (null? xs) zs
            (loop2 ys (cdr xs) (cons (car xs) zs)))))))

(define (perf n)
  (let ((ds (deck n)))
    (do ((xs (faro ds) (faro xs)) (k 1 (+ k 1)))
        ((equal? xs ds) k))))

(display (deck 8)) (newline)
(display (faro (deck 8))) (newline)
(display (faro (faro (faro (deck 8))))) (newline)
(display (perf 8)) (newline)
(display (perf 52)) (newline)