;;;  Monte Carlo Simulation for probability of unplayable Klondike Games
;;;
;;;  Programmer: latif (http://www.techuser.net)
;;;
;;;  Petite Chez scheme (http://www.scheme.com) was used to run the code 
;;;  for the simulation. The code for the simulation is not particularly
;;;  efficient but works reasonably well in an interpreter.
;;;
;;;  Cards are modeled as numbers [0-3] Aces, [4-7] deuces, ...
;;;  Cards with even parity are red and the rest are black
;;;
;;;  For further details check: http://www.techuser.net/klondikeprob.html

(define (same-color? x y)
  (= (modulo x 2)                        ; same parity => same color 
     (modulo y 2)))   

(define (ace? x)
  (< x 4))                               ; cards 0 - 3 are aces

(define (rank-difference x y)
  (- (quotient x 4)
     (quotient y 4)))

(define (stackable? x y)
  (and (not (same-color? x y))
       (= 1 (rank-difference x y))))

(define (playable? x y)
  (or (stackable? x y)
      (stackable? y x)))

(define (bool->num x)
  (if (eq? x #t) 1 0))

(define (moves r1 r2)
  (lambda (pred? get-elt)
    (let loop ((i (car r1)) 
	       (j (car r2)))
      (cond ((> i (cdr r1)) #f)
	    ((> j (cdr r2)) 
	     (loop (+ i 1) (car r2)))
	    (else (if (pred? (get-elt i) (get-elt j))
		      #t
		      (loop i 
			    (+ j 1))))))))

(define (make-deck n)
  (let ((v (make-vector n)))
    (do ((i 0 (+ i 1))) 
      ((= i n) (values v
		       (lambda (i) (vector-ref v i)) 
		       (lambda (i val) (vector-set! v i val))))
      (vector-set! v i i))))

(define (shuffle n k get-elt set-elt)
  (let ((swap (lambda (i j)
		(let ((temp (get-elt i)))
		  (begin (set-elt i (get-elt j))
			 (set-elt j temp))))))
    (do ((i 0 (+ i 1)))
      ((= i k) '())
      (swap i (+ i (random (- n i)))))))

(define (has-aces? n get-elt)
  (let loop ((i 0))
    (cond ((= i n) #f)
	  ((ace? (get-elt i)) #t)
	  (else (loop (+ i 1))))))

(define (repeat f n)
  (do ((i 0 (+ i 1)) 
       (j 0 (+ j (bool->num (f)))))
    ((= i n) (/ j n 1.0))))

;;; used to verify that the simulation is accurate by computing the
;;; probability of no aces in the 15 playable cards
;;; That probability is Binomial[48,15] / Binomial[52,15] = 0.2439
(define count-aces
  (let-values (((deck accessor setter) (make-deck 52)))
    (let ((k 15))
      (lambda ()
	(begin (shuffle 52 k accessor setter)
	       (not (has-aces? k accessor)))))))

(define (klondike n num-playable-cards)
  (let-values (((deck accessor setter) (make-deck n)))
    (let ((stack-stack-moves (moves '(0 . 6) '(0 . 6)))
	  (deck-stack-moves (moves '(0 . 6) (cons 7 (- num-playable-cards 1))))
	  (k num-playable-cards))
      (lambda ()
	(begin (shuffle n k accessor setter)
	       (not (or (has-aces? k accessor)
			(stack-stack-moves playable? accessor)
			(deck-stack-moves stackable? accessor))))))))

(define klondike-draw3 (klondike 52 15))
(define klondike-draw1 (klondike 52 31))

(repeat count-aces 10000)
(repeat klondike-draw3 10000)
(repeat klondike-draw1 10000)