;; Lab 8 Solutions
;; CMPU 145, Spring 2019
#lang racket
(include "prob-helper.scm")
(header "Lab 8" "Solutions")
(problem "0a. Full house probability")
(define *num-ways-full-house*
(* 13 ;; 13 choices for rank of trips
4 ;; 4-choose-3 ways of choosing suits for trips
12 ;; 12 choices for rank of pair
6)) ;; 4-choose-2 ways of choosing suits for the pair
(define *num-5-card-hands* (n-choose-k 52 5))
(define *prob-full-house*
(/ *num-ways-full-house*
*num-5-card-hands*
1.0))
(tester '*num-ways-full-house*)
(tester '*prob-full-house*)
(problem "0b. Full house simulation")
;; Genete a random hand
(define gen-poker-hand
(lambda ()
(choose-k-from 5 *deck*)))
(define has-full-house?
(lambda (cards)
(let ((sorted-ranks (sort (map rank cards) <=)))
;; Pattern is either: (X X X Y Y) or (X X Y Y Y)
(or (and (= (first sorted-ranks)
(third sorted-ranks))
(= (fourth sorted-ranks)
(fifth sorted-ranks)))
(and (= (first sorted-ranks)
(second sorted-ranks))
(= (third sorted-ranks)
(fifth sorted-ranks)))))))
(tester '(gen-and-test 100000 gen-poker-hand has-full-house?))
(tester '(gen-and-test 100000 gen-poker-hand has-full-house?))
(tester '*prob-full-house*)
(problem "1a. Straights probability")
(define *num-straights*
(* 10 ;; 10 kinds of straights (depends only on lowest card)
(expt 4 5))) ;; 4 choices for the suit of each card
(define *prob-straight*
(/ *num-straights*
*num-5-card-hands*
1.0))
(tester '*prob-straight*)
(problem "1b. Straights simulation")
;; HAS-STRAIGHT?
;; -------------
;; INPUT: CARDS, a list of five "cards" (each a number from 0 to 51)
;; OUTPUT: #t if that hand of cards has a "straight"
;; (i.e., 5 cards whose ranks form a sequence of the form
;; A, A+1, A+2, A+3, A+4). Note that suits do not matter here.
(define has-straight?
(lambda (cards)
(let* (;; RANKS -- a list of the ranks of the cards
(ranks (map rank cards))
;; SORTED-RANKS -- the ranks of the cards sorted in increasing order
(sorted-ranks (sort ranks <=))
;; LOWEST-CARD -- the first rank in the list of sorted ranks
(lowest-card (first sorted-ranks))
;; NORMALIZED-SORTED-RANKS -- Same as sorted-ranks except
;; that LOWEST-CARD has been subtracted from each rank
(normalized-sorted-ranks (map (lambda (r) (- r lowest-card))
sorted-ranks)))
(or (equal? normalized-sorted-ranks
'(0 1 2 3 4))
(equal? normalized-sorted-ranks
'(0 9 10 11 12)) ;; <-- Ace-high straight!
))))
(tester '(has-straight? '(3 4 5)))
(tester '(has-straight? '(5 3 4)))
(tester '(has-straight? '(8 9 12 11 10)))
(tester '(has-straight? '(8 9 13 11 10)))
(tester '(gen-and-test 10000 gen-poker-hand has-straight?))
(tester '(gen-and-test 10000 gen-poker-hand has-straight?))
(tester '*prob-straight*)
(problem "2. Monty Hall simulation")
(define *doors* '(1 2 3))
(define random-door
(lambda ()
(+ 1 (random 3))))
(define gen-game-keep
(lambda ()
(gen-game keep-choice)))
(define gen-game-change
(lambda ()
(gen-game change-choice)))
(define gen-game
(lambda (strategy)
(let* ((car-door (random-door))
(first-choice (random-door))
(revealed-goat (reveal-goat car-door first-choice))
(final-choice (strategy first-choice revealed-goat)))
(list car-door first-choice revealed-goat final-choice))))
;; Given the door a car is behind and the player's first choice, reveal a goat
;; behind a different door.
(define reveal-goat
(lambda (car-door first-choice)
(choose-one-from
(remove* (list car-door first-choice)
*doors*))))
(define keep-choice
(lambda (first-choice revealed-goat)
first-choice))
(define change-choice
(lambda (first-choice revealed-goat)
(choose-one-from
(remove* (list first-choice revealed-goat)
*doors*))))
(define won-car?
(lambda (game)
(= (first game) (last game))))
(tester '(gen-and-test 1000 gen-game-keep won-car?))
(tester '(gen-and-test 1000 gen-game-change won-car?))