2019-08-12 19:05:45 +02:00
|
|
|
open List;;
|
|
|
|
open Hashtbl;;
|
|
|
|
|
|
|
|
open Cards;;
|
|
|
|
|
|
|
|
type card_tag =
|
|
|
|
| Invalid
|
|
|
|
| Valid
|
|
|
|
|
|
|
|
let card_tag_to_string t =
|
|
|
|
match t with
|
|
|
|
| Invalid -> "Invalid"
|
|
|
|
| Valid -> "Valid"
|
|
|
|
|
|
|
|
type game_strategy =
|
|
|
|
| Tris
|
|
|
|
| Straight
|
|
|
|
| Single
|
|
|
|
|
|
|
|
let game_strategy_to_string t =
|
|
|
|
match t with
|
|
|
|
| Tris -> "Tris"
|
|
|
|
| Straight -> "Straight"
|
|
|
|
| Single -> "Single"
|
|
|
|
|
|
|
|
type tcards = { cards: card list ; tag: card_tag ; strategy: game_strategy }
|
|
|
|
|
|
|
|
let make cards =
|
|
|
|
let strategy = if List.length cards = 1 then Single else
|
|
|
|
if Cards.is_tris cards then Tris else Straight in
|
|
|
|
{ cards=cards ; tag=if Cards.is_valid cards then Valid else Invalid; strategy=strategy }
|
|
|
|
|
|
|
|
let contains needle haystack = List.mem needle haystack.cards
|
|
|
|
|
|
|
|
let (=) a b =
|
2019-08-13 23:55:50 +02:00
|
|
|
if List.length a.cards <> List.length b.cards || a.tag != b.tag || a.strategy != b.strategy then
|
2019-08-12 19:05:45 +02:00
|
|
|
false
|
|
|
|
else
|
|
|
|
a.cards = b.cards
|
|
|
|
|
|
|
|
let length ts = List.length ts.cards
|
|
|
|
let cmp a b =
|
|
|
|
(* TODO: improve *)
|
|
|
|
if a.strategy == Tris && List.length a.cards == 4 then -1
|
|
|
|
else if b.strategy == Tris && List.length b.cards == 4 then 1
|
|
|
|
else if a.strategy != Single && b.strategy == Single then 1
|
|
|
|
else if a.strategy == Single && b.strategy != Single then -1
|
|
|
|
else if a.tag == Invalid && b.tag == Valid then 1
|
|
|
|
else -1 ;;
|
|
|
|
|
|
|
|
(* TODO tests *)
|
|
|
|
assert (make [Cards.make Pikes 2] |>
|
|
|
|
cmp (make [Cards.make Pikes 2 ; Cards.make Clovers 2]) == 1);; (* less than *)
|
|
|
|
assert (make [Cards.make Pikes 2] |>
|
|
|
|
cmp (make [Cards.make Pikes 2 ; Cards.make Clovers 2 ; Cards.make Tiles 2; Cards.make Hearts 2]) == -1)
|
|
|
|
|
|
|
|
let hash ts =
|
|
|
|
ts.cards |>
|
|
|
|
List.sort (fun a b -> if a.seed == b.seed then Cards.value_cmp a b else Cards.seed_cmp a b) |>
|
|
|
|
Hashtbl.hash;;
|
2019-08-13 23:55:50 +02:00
|
|
|
|
|
|
|
let remove card tcards =
|
|
|
|
assert (List.mem card tcards.cards);
|
|
|
|
match (List.filter (fun x -> x <> card) tcards.cards) with
|
|
|
|
| [] -> None
|
|
|
|
| (hd::tl) as lst -> Some (make lst) ;;
|
|
|
|
|
|
|
|
let r = remove (Cards.make Hearts 7) (make [Cards.make Hearts 7; Cards.make Clovers 7; Cards.make Pikes 7;]) in
|
|
|
|
match r with
|
|
|
|
| None -> assert false
|
|
|
|
| Some x -> if x <> (make [Cards.make Clovers 7; Cards.make Pikes 7]) then assert false
|