type card = char * int
let debug = false
let montecarlo = 5000
let greedy_mc_play = false
(* CARD TO PRIMITIVE TYPE CASTING *)
let value_of v =
match v with
| '2'..'9' -> Char.code v - (Char.code '2')
| 'T' -> 8
| 'J' -> 9
| 'Q' -> 10
| 'K' -> 11
| 'A' -> 12
| _ -> -1
let card_of v =
if v >= 0 && v <= 7 then Char.chr (v + (Char.code '2'))
else match v with
| 8 -> 'T'
| 9 -> 'J'
| 10 -> 'Q'
| 11 -> 'K'
| 12 -> 'A'
| _ -> '?'
let card_of_string str =
(String.get str 1, value_of (String.get str 0))
let string_of_card (c,v) =
(String.make 1 (card_of v)) ^ (String.make 1 c)
let int_of_card (c,v) =
13 * (match c with
| 'C' -> 0
| 'D' -> 1
| 'H' -> 2
| 'S' -> 3
| _ -> -1) + v
let card_of_int n =
((match n / 13 with
| 0 -> 'C'
| 1 -> 'D'
| 2 -> 'H'
| 3 -> 'S'
| _ -> 'U'), n mod 13)
(* STANDARD GTP INPUT PARSING *)
let explode str =
(* string |-> lista znakow *)
let ls = ref [] in
String.iter (fun ch -> ls := ch :: !ls) str;
!ls
let merge ls =
(* zlaczenie listy znakow w string *)
String.concat "" (List.map (fun ch -> String.make 1 ch) ls)
let cut chl =
(* pociecie listy znakow na spacjach *)
let res = ref []
and word = ref []
in
List.iter (fun ch ->
if ch = ' ' then
begin
res := !word :: !res;
word := []
end
else
word := ch :: !word )
chl;
res := !word :: !res;
!res
let split str =
List.map merge (cut (explode str))
let scan () = split (input_line stdin)
(* SIMPLE LIST AND ARRAY OPERATIONS *)
let swap ar i j =
let temp = ar.(i) in
ar.(i) <- ar.(j);
ar.(j) <- temp;
()
let shuffle d =
let dcp = Array.copy d
in
for i = 1 to Array.length dcp - 1 do
let j = Random.int i
in
swap dcp i j
done;
dcp
let rec delete l item =
match l with
| h :: t ->
if h = item then t
else h :: (delete t item)
| [] -> []
(* SIMPLE CARD PREDICATES AND DEBUG *)
(* beats c d <=> c > d *)
let beats (fc, fv) (sc, sv) =
sc = 'U' || (fc = sc && fv > sv) || (fc = 'C' && sc != 'C') || (fc = 'C' && sc = 'C' && fv > sv)
let list_shuffle l n =
assert (List.length l >= n);
Array.to_list (Array.sub (shuffle (Array.of_list l)) 0 n)
let pr t = print_endline ("=" ^ t ^ "\n")
let pe t = if debug then prerr_endline ("D:" ^ t)
let sorting a b = if beats a b then 1 else -1
let print_hand h =
pe ("HAND: " ^ List.fold_left (fun acc c -> acc ^ (string_of_card c) ^ " ") " " h)
let print_points p =
pe ("POINTS: " ^ (List.fold_left (fun acc i -> acc ^ (string_of_int i) ^ "->" ^ (string_of_int p.(i)) ^ " ") "" [0;1;2;3]))
(* GLOBAL VARIABLES *)
let me = ref 0
let (my_cards : card list ref) = ref []
let declarations = Array.make 4 0
let leader = ref 0
let lead = ref ('U', -1)
let cards_in_trick = ref 0
let winning_card = ref ('U', -1)
let trick_winner = ref (-1)
let trick = Array.make 4 ('U', -1)
let deck_state = Array.make 52 0
let unknown_cards : card list ref = ref []
let points = Array.make 4 0
let current_points = Array.make 4 0
let n = ref 0
let other_cards () =
let other_cards = ref []
in
Array.iteri (fun i v -> if v = 0 then other_cards := (card_of_int i) :: !other_cards) deck_state;
!other_cards
let mark_my_cards cards =
my_cards := cards;
for i = 0 to 51 do deck_state.(i) <- 0 done;
List.iter (fun card -> deck_state.(int_of_card card) <- 1) cards;
unknown_cards := other_cards ();
for i = 0 to 3 do current_points.(i) <- 0 done
(* MONTE CARLO ENGINE *)
let rand_deal leader cards =
let to_deal = (List.length (!my_cards)) * 3 - (((!me - leader) + 4) mod 4)
in let shuffled = list_shuffle cards to_deal
in let rec r_deal cards hands playr =
if playr = !me then r_deal cards hands ((playr + 1) mod 4)
else
match cards with
| [] -> hands
| h :: t ->
hands.(playr) <- h :: hands.(playr);
r_deal t hands ((playr + 1) mod 4)
in
r_deal shuffled (Array.make 4 []) ((!me + 1) mod 4)
let sim_play hand lead =
let following =
let cand = List.filter (fun (c,v) -> c = fst lead) hand
in match cand with
| [] -> hand
| _ -> cand
in
if greedy_mc_play then
List.hd (List.sort (fun a b -> compare (snd a) (snd b)) following)
else
List.nth following (Random.int (List.length following))
let rec sim_move (hands, leader, lead, now_moves, trick_winning_card, trick_winner, points) =
if hands.(now_moves) = [] then points
else
let card = sim_play hands.(now_moves) lead
in
hands.(now_moves) <- delete hands.(now_moves) card;
let (new_winner, new_trick_winning_card) = if beats card trick_winning_card then
(now_moves, card)
else
(trick_winner, trick_winning_card)
in
if ((now_moves + 1) mod 4) = leader then begin (* end of trick *)
points.(new_winner) <- points.(new_winner) + 1;
sim_move (hands, new_winner, ('U', -1), new_winner, ('U', -1), -1, points)
end else
sim_move (hands, leader, (if now_moves = leader then card else lead), (now_moves + 1) mod 4,
new_trick_winning_card, new_winner, points)
let sim_whole n =
let deal = rand_deal !me !unknown_cards in
let hands = Array.init 4 (fun i ->
if i = !me then !my_cards
else deal.(i))
in
(*for i = 0 to 3 do
pe (string_of_int i);
print_hand hands.(i);
done;*)
let points = Array.make 4 0
in let first_state = (hands, n mod 4, ('U', -1), n mod 4, ('U', -1), -1, points)
in
let final = sim_move first_state
in
final
let sim n declarations state =
let points_after = sim_move state
in
for i = 0 to 3 do
if declarations.(i) = points_after.(i) then points_after.(i) <- points_after.(i) + n
done;
points_after
let single_move_val card =
let deal =
let rhands = rand_deal !leader !unknown_cards
in
Array.init 4 (fun i -> if i = !me then !my_cards else rhands.(i))
in
let points_cp = Array.init 4 (fun i -> points.(i) + current_points.(i))
and (new_winner, new_card) = if beats card !winning_card then (!me, card) else (!trick_winner, !winning_card)
in
let (new_leader, new_lead, now_moves) =
if (!me + 1) mod 4 = !leader
then begin
points_cp.(new_winner) <- points_cp.(new_winner) + 1;
(new_winner, ('U', -1), new_winner)
end
else (!leader, !lead, (!me + 1) mod 4)
in
let l_points = sim !n declarations (deal, new_leader, new_lead, now_moves, new_card, new_winner, points_cp)
in
let points_after = Array.init 4 (fun i -> (i, l_points.(i)))
in
let pacp = Array.copy points_after
in
Array.sort (fun a b -> - (compare (snd a) (snd b))) pacp;
let classification = Array.make 4 (-1, -1)
in for i = 0 to 3 do match pacp.(i) with
| (pl, sc) -> classification.(pl) <- (i, sc)
done;
let (mplace, mpoints) = classification.(!me)
in
((3 - mplace) * 100) - (if mplace = 0 then 0 else snd classification.(mplace-1) - mpoints)
+ (if mplace = 3 then 0 else mpoints - (snd classification.(mplace+1)))
let assess card =
let sum = ref 0
in
for i = 1 to montecarlo do
sum := !sum + (single_move_val card)
done;
let res = (float_of_int !sum) /. (float_of_int montecarlo)
in
res
let choose_card cards =
let assessments = List.map (fun card -> (card, assess card)) cards
in let rec r_choose list winner score =
match list with
| [] -> winner
| (c, a) :: t -> if a > score then r_choose t c a else r_choose t winner score
in
r_choose assessments ('U', -1) neg_infinity
(* GTP COMMAND HANDLERS *)
let analyse_move player card =
assert (player = !me || deck_state.(int_of_card card) = 0);
deck_state.(int_of_card card) <- 1;
unknown_cards := other_cards ();
trick.(player) <- card;
if player = !leader then lead := card;
if beats card !winning_card then begin
winning_card := card;
trick_winner := player;
end;
incr cards_in_trick;
if !cards_in_trick = 4 then begin
cards_in_trick := 0;
for i = 0 to 3 do trick.(i) <- ('U', -1) done;
leader := !trick_winner;
current_points.(!trick_winner) <- current_points.(!trick_winner) + 1;
if !my_cards = [] then begin
for i = 0 to 3 do
points.(i) <- points.(i) + current_points.(i);
if current_points.(i) = declarations.(i) then
points.(i) <- points.(i) + !n
done;
end;
winning_card := ('U', -1);
end;
assert (deck_state.(int_of_card card) = 1)
let declare () =
let histogram = Array.make (!n+1) 0
in
for i = 1 to montecarlo do
let taken = (sim_whole (!n)).(!me)
in
histogram.(taken) <- histogram.(taken) + 1;
done;
pe "HISTOGRAM";
pe (List.fold_left (fun acc (i,v) -> acc ^ " " ^ (string_of_int i) ^ "->" ^ (string_of_int v))
"" (Array.to_list (Array.mapi (fun i v -> (i, v)) histogram)));
let rec compute_mode i mode score =
if i > !n then mode
else
if histogram.(i) > score then
compute_mode (i+1) i histogram.(i)
else
compute_mode (i+1) mode score
in
compute_mode 0 (-1) (-1)
let move () =
let follow =
if !me = !leader then !my_cards
else
let color = List.filter (fun (c,v) -> c = fst trick.(!leader)) !my_cards
in
if List.length color > 0
then color
else !my_cards
in let card =
if List.length follow = 1 then List.hd follow
else choose_card follow
in
my_cards := delete !my_cards card;
card
(* GTP PARSER *)
let main () =
Random.self_init ();
while true do
let command = scan () in
try
match command with
| "set_deck" :: _ ->
pr ""
| "set_players" :: n :: i :: _ ->
me := int_of_string i;
pr ""
| "set_game" :: _ ->
pr ""
| "set_cards" :: ncards :: cards ->
n := int_of_string ncards;
leader := ((int_of_string ncards) - 1) mod 4;
mark_my_cards (List.map card_of_string cards);
pr ""
| "time_left" :: _ ->
pr ""
| "gen_declare" :: _ ->
pr (" " ^ (string_of_int (declare ())))
| "declare" :: i :: d :: _ ->
declarations.(int_of_string i) <- int_of_string d;
pr ""
| "gen_move" :: _ ->
pr (" " ^ (string_of_card (move ())))
| "play" :: i :: c :: _ ->
analyse_move (int_of_string i) (card_of_string c);
pr ""
| _ -> raise (Failure "Unknown command")
with Failure msg ->
print_endline ("? " ^ msg ^ "\n");
flush stdout;
done
let _ = main ()