-
Notifications
You must be signed in to change notification settings - Fork 0
/
blackjack.rkt
141 lines (125 loc) · 5.29 KB
/
blackjack.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#lang 2d typed/racket
(require 2d/cond)
(provide Suit suit?
Rank rank?
card card?
cards
Score natural-blackjack? bust?
cards->score
Judgement win? lose? push?
judge)
(module+ test
(require typed/rackunit))
(define-type Suit (U 'Spade 'Club 'Heart 'Diamond))
(define-predicate suit? Suit)
(define-type Rank (U 'Ace 2 3 4 5 6 7 8 9 10 'Jack 'Queen 'King))
(define-predicate rank? Rank)
(define-predicate rank-number? (U 2 3 4 5 6 7 8 9 10))
(define-predicate rank-face? (U 'Jack 'Queen 'King))
(define-predicate rank-ace? 'Ace)
(struct card ([suit : Suit] [rank : Rank])
#:transparent)
(: suits (Listof Suit))
(define suits '(Spade Club Heart Diamond))
(: ranks (Listof Rank))
(define ranks '(Ace 2 3 4 5 6 7 8 9 10 Jack Queen King))
(module+ test
(check-eqv? (count rank-number? ranks) 9)
(check-eqv? (count rank-face? ranks) 3)
(check-eqv? (count rank-ace? ranks) 1))
(: product (All (A B C) (-> (-> A B C) (Listof A) (Listof B) (Listof C))))
(define (product f xs ys)
(for*/list : (Listof C) ([x : A xs]
[y : B ys])
(f x y)))
(module+ test
(check-equal? (product (inst cons Integer Symbol)
'(1 2 3)
'(a b c))
(list '(1 . a) '(1 . b) '(1 . c)
'(2 . a) '(2 . b) '(2 . c)
'(3 . a) '(3 . b) '(3 . c))))
(: cards (Listof card))
(define cards
(product card suits ranks))
(define-type Score (U Integer 'Natural-Blackjack 'Bust))
(define-predicate natural-blackjack? 'Natural-Blackjack)
(define-predicate bust? 'Bust)
(: cards->score (-> (Listof card) Score))
(define (cards->score cs)
(: cards->score* (-> (Listof card) Integer))
(define (cards->score* cs)
(let ([rs (map card-rank cs)])
(let ([score-without-aces
(+ (foldl + 0 (filter rank-number? rs))
(* 10 (count rank-face? rs)))])
(let add-ace-scores ([score* score-without-aces]
[ace-count (count rank-ace? rs)])
(cond
[(zero? ace-count) score*]
[(<= (+ score* (* ace-count 11)) 21)
(+ score* (* ace-count 11))]
[else
(add-ace-scores (+ score* 1)
(- ace-count 1))])))))
(let ([score* (cards->score* cs)])
(cond
[(and (= (length cs) 2)
(= score* 21))
'Natural-Blackjack]
[(< 21 score*)
'Bust]
[else
score*])))
(module+ test
(check-eqv? (cards->score (list (card 'Spade 'Jack)
(card 'Spade 'Ace)))
'Natural-Blackjack)
(check-eqv? (cards->score (list (card 'Spade 'Jack)
(card 'Spade 10)
(card 'Spade 2)))
'Bust)
(check-eqv? (cards->score (list (card 'Spade 'Jack)
(card 'Spade 'Queen)
(card 'Spade 'Ace)))
21))
(define-type Judgement (U 'Win 'Lose 'Push))
(define-predicate win? 'Win)
(define-predicate lose? 'Lose)
(define-predicate push? 'Push)
(: judge (-> Score Score Judgement))
(define (judge p d)
(define natural21? natural-blackjack?)
#2dcond
╔═════════════════╦═════════════════╦═══════════╦═══════════════════╗
║ ║ (natural21? d) ║ (bust? d) ║ else ║
╠═════════════════╬═════════════════╬═══════════╩═══════════════════╣
║ (natural21? p) ║ 'Push ║ 'Win ║
╠═════════════════╬═════════════════╩═══════════════════════════════╣
║ (bust? p) ║ 'Lose ║
╠═════════════════╣ ╔═══════════╦═══════════════════╣
║ ║ ║ ║ (cond ║
║ else ║ ║ 'Win ║ [(> p d) 'Win] ║
║ ║ ║ ║ [(< p d) 'Lose] ║
║ ║ ║ ║ [else 'Push]) ║
╚═════════════════╩═════════════════╩═══════════╩═══════════════════╝)
(module+ test
(check-pred push?
(judge 'Natural-Blackjack
'Natural-Blackjack))
(check-pred win?
(judge 'Natural-Blackjack
21))
(check-pred lose?
(judge 21
'Natural-Blackjack))
(check-pred push?
(judge 10 10))
(check-pred win?
(judge 15 10))
(check-pred lose?
(judge 10 15))
(check-pred lose?
(judge 'Bust 3))
(check-pred win?
(judge 2 'Bust)))