fork download
copy 
  1. ; perfect shuffle
  2.  
  3. (define (deck n)
  4.   (let loop ((n n) (ds (list)))
  5.     (if (zero? n) ds
  6.       (loop (- n 1) (cons n ds)))))
  7.  
  8. (define (faro xs)
  9.   (let loop1 ((ts xs) (hs xs) (ys (list)))
  10.     (if (and (pair? hs) (pair? (cdr hs)))
  11.         (loop1 (cdr ts) (cddr hs) (cons (car ts) ys))
  12.         (let loop2 ((xs (reverse ts)) (ys ys) (zs (list)))
  13.           (if (null? xs) zs
  14.             (loop2 ys (cdr xs) (cons (car xs) zs)))))))
  15.  
  16. (define (perf n)
  17.   (let ((ds (deck n)))
  18.     (do ((xs (faro ds) (faro xs)) (k 1 (+ k 1)))
  19.         ((equal? xs ds) k))))
  20.  
  21. (display (deck 8)) (newline)
  22. (display (faro (deck 8))) (newline)
  23. (display (faro (faro (faro (deck 8))))) (newline)
  24. (display (perf 8)) (newline)
  25. (display (perf 52)) (newline)
Success #stdin #stdout 0.01s 7948KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(1 2 3 4 5 6 7 8)
(1 5 2 6 3 7 4 8)
(1 2 3 4 5 6 7 8)
3
8
https://ideone.com/8C1PJb
language:
Scheme (chicken 4.13)
created:
4 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!