;; What sort of language *doesn't* have `while'?
(defmacro while (condition &rest body)
  (let ((tag (gensym)))
	`(tagbody
		,tag
		(when ,condition
		  ,@body
		  (go ,tag)))))

(defmacro until (condition &rest body)
  `(while (not ,condition)
		  ,@body))


(defun new-deck (size)
  ;; I'm not sure I like `loop'.
  (loop :for n :below size :collect n))

(defun pseudo-sort (deck unders-count)
  (let (new-deck)
	(while (car deck)
		   ;; Under
		   (dotimes (i unders-count)
			 (setf deck (nreverse (cons (car deck) (nreverse (cdr deck))))))
		   ;; Out
		   (push (car deck) new-deck)
		   (setf deck (cdr deck)))
	new-deck))

(defun find-cycles (deck unders-count)
  (let* ((shuffled-deck (pseudo-sort (copy-list deck) unders-count))
		 (cycles (list))
		 (cycle-number 0)
		 found)
	(do ((i 0))
		((>= i (length deck))
		 (list shuffled-deck cycles cycle-number))
	  ;; Find the next element that has not been touched. This is the start of the next loop.
	  (until (or (>= i (length deck))
				 (not (member (elt shuffled-deck i) found)))
			 (setf i (1+ i)))
	  (unless (>= i (length deck))
		(push nil cycles)
		(let ((cycle (first cycles))
			  (endcard (elt shuffled-deck i)))
		  (push endcard cycle)
		  (push endcard found)
		  ;; Trace the cycle.
		  (until (= endcard
					(elt shuffled-deck (first cycle)))
				 (push (elt shuffled-deck (first cycle)) found)
				 (push (elt shuffled-deck (first cycle)) cycle))
		  ;; Move to the next cycle.
		  (setf (first cycles) cycle)
		  (incf cycle-number)
		  (incf i))))))

(defun calculate-identity-shuffle (cycles)
  (let ((lengths))
	(dolist (cycle cycles)
	  (push (length cycle) lengths))
	(apply 'lcm lengths)))

;; Run this to find how many shuffles it takes to shuffle and then unshuffle a 52 card deck if you only put one card under
(calculate-identity-shuffle (cadr (find-cycles (new-deck 52) 1)))