Schemeで非決定性を使った、トランプから取り出した2枚が両方とも赤のカードである確率を求めるプログラム

Schemeで非決定性を使い、シャッフルされた、ジョーカーを除いたトランプ(52枚)から2枚同時に取り出してそれが両方とも赤のカードである確率を求めるプログラムを書いてみました。

マクロamb、マクロset-of、関数assertはScheme 入門 18. 非決定性によるものです。

(define fail #f)

(define-syntax amb
  (syntax-rules ()
    ((_) (fail))
    ((_ a) a)
    ((_ a b ...)
     (let ((fail0 fail))
       (call/cc
    (lambda (cc)
      (set! fail
        (lambda ()
          (set! fail fail0)
          (cc (amb b ...))))
      (cc a)))))))

(define-syntax set-of
  (syntax-rules () 
    ((_ s) 
      (let ((acc '())) 
        (amb (let ((v s)) 
               (set! acc (cons v acc)) 
               (fail)) 
             (reverse acc))))))

(define (assert pred)
  (or pred (amb)))

(define (remove-value lst val) (remove (lambda (x) (eq? val x)) lst))

(define (element-in list)
  (let loop ((xs list))
    (if (null? xs)
        (amb)
      (amb (car xs) (loop (cdr xs))))))

(define all_cards (iota 52))
(define (red? card) (= (remainder card 2) 0))
(define (black? card) (= (remainder card 2) 1))

(define (choose-two-cards)
  (let* ((card1 (element-in all_cards)) (card2 (element-in (remove-value all_cards card1))))
    (cons card1 card2)))

(define (redred)
  (let* ((card1 (element-in all_cards)) (card2 (element-in (remove-value all_cards card1))))
    (assert (red? card1))
    (assert (red? card2))
    (cons card1 card2)))

(print (/ (length (set-of (redred))) (length (set-of (choose-two-cards))))) ;; 25 / 102

所望の確率は、ちょっとレシートの裏に計算すれば一般のnに対して求まるんですが、それはご容赦を。

ていうか本当に求めたかったのはシャッフルされた札から2枚ずつカードを引いて、赤と赤の組、赤と黒(順序不同)の組、黒と黒の組にそれぞれ分けて山を作ったとき、それぞれの山の中のカードの数の期待値だったんですが、それを非決定性を使ったプログラムで求めるのは厳しそうだったので断念。