83 lines
2.4 KiB
Standard ML
83 lines
2.4 KiB
Standard ML
|
use "list.sml";
|
||
|
|
|
||
|
|
datatype color = Black | Red
|
||
|
|
datatype rank = Ace | Queen | King | Jack | Num of int
|
||
|
|
datatype suit = Club | Diamond | Heart | Spade
|
||
|
|
type card = suit * rank
|
||
|
|
datatype move = Draw | Discard of card
|
||
|
|
|
||
|
|
exception IllegalMove
|
||
|
|
|
||
|
|
type card_color = card -> color
|
||
|
|
val card_color: card_color = fn card =>
|
||
|
|
case card of
|
||
|
|
(Club, _) => Black
|
||
|
|
| (Spade, _) => Black
|
||
|
|
| (Diamond, _) => Red
|
||
|
|
| (Heart, _) => Red
|
||
|
|
|
||
|
|
type card_value = card -> int
|
||
|
|
val card_value: card_value = fn (_, rank) =>
|
||
|
|
case rank of
|
||
|
|
Num num => num
|
||
|
|
| Ace => 11
|
||
|
|
| _ => 10
|
||
|
|
|
||
|
|
type remove_card = card list * card * exn -> card list
|
||
|
|
val remove_card: remove_card = fn (cards, to_remove, exp) =>
|
||
|
|
let
|
||
|
|
fun filter card (found, acc) =
|
||
|
|
if card <> to_remove orelse found
|
||
|
|
then (found, card :: acc)
|
||
|
|
else (true orelse found, acc)
|
||
|
|
in
|
||
|
|
case fold filter (false, []) cards of
|
||
|
|
(true, filtered) => filtered
|
||
|
|
| (false, _) => raise exp
|
||
|
|
end
|
||
|
|
|
||
|
|
type all_same_color = card list -> bool
|
||
|
|
val rec all_same_color: all_same_color = fn cards =>
|
||
|
|
case cards of
|
||
|
|
[] => true
|
||
|
|
| one :: [] => true
|
||
|
|
| first :: second :: rest =>
|
||
|
|
card_color first = card_color second andalso all_same_color rest
|
||
|
|
|
||
|
|
type sum_cards = card list -> int
|
||
|
|
val sum_cards: sum_cards = fn cards =>
|
||
|
|
cards |> fold (fn card => fn sum => card_value card + sum) 0
|
||
|
|
|
||
|
|
type score = card list * int -> int
|
||
|
|
val score: score = fn (cards, goal) =>
|
||
|
|
let
|
||
|
|
val sum = sum_cards cards
|
||
|
|
val preliminary_score =
|
||
|
|
if sum < goal
|
||
|
|
then goal - sum
|
||
|
|
else 3 * (sum - goal)
|
||
|
|
val same_color = all_same_color cards
|
||
|
|
in
|
||
|
|
if same_color then preliminary_score div 2 else preliminary_score
|
||
|
|
end
|
||
|
|
|
||
|
|
type officiate = card list * move list * int -> int
|
||
|
|
val officiate: officiate = fn (deck, moves, goal) =>
|
||
|
|
let
|
||
|
|
fun draw (deck, hand) =
|
||
|
|
case deck of
|
||
|
|
[] => (deck, hand)
|
||
|
|
| head :: tail =>
|
||
|
|
if sum_cards hand > goal
|
||
|
|
then (deck, hand)
|
||
|
|
else (tail, head :: hand)
|
||
|
|
|
||
|
|
fun play move (deck, hand) =
|
||
|
|
case move of
|
||
|
|
Draw => draw (deck, hand)
|
||
|
|
| Discard card => (deck, remove_card (hand, card, IllegalMove))
|
||
|
|
|
||
|
|
fun round hand = score (hand, goal)
|
||
|
|
in
|
||
|
|
moves |> fold play (deck, []) |> #2 |> round
|
||
|
|
end
|