Go Fish/OCaml

          Jack | Queen | King | Ace

let pips = [Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten;

           Jack; Queen; King; Ace]

type suit = Diamonds | Spades | Hearts | Clubs let suits = [Diamonds; Spades; Hearts; Clubs]

type card = pip * suit

let string_of_pip = function

 | Two   -> "Two"
 | Three -> "Three"
 | Four  -> "Four"
 | Five  -> "Five"
 | Six   -> "Six"
 | Seven -> "Seven"
 | Eight -> "Eight"
 | Nine  -> "Nine"
 | Ten   -> "Ten"
 | Jack  -> "Jack"
 | Queen -> "Queen"
 | King  -> "King"
 | Ace   -> "Ace"

let string_of_suit = function

 | Diamonds -> "Diamonds"
 | Spades   -> "Spades"
 | Hearts   -> "Hearts"
 | Clubs    -> "Clubs"

let string_of_card (pip, suit) =

 (Printf.sprintf "(%s-%s)" (string_of_pip pip) (string_of_suit suit))

let pip_of_card (pip, _) = (pip)

let deck =

 List.concat (List.map (fun pip -> List.map (fun suit -> (pip, suit)) suits) pips)

type rank_state =

 | Unknown   (* Don't know if the opponent has any cards in that rank. *)
 | No_cards  (* Opponent has no cards there; I took them away, or I asked yet. *)
 | Has_cards (* Opponent has cards there; they tried to get them off me and haven't booked them yet. *)
 | Booked    (* Someone has booked the rank. *)

let state_score = function

 | Booked    -> 0
 | No_cards  -> 1
 | Unknown   -> 2
 | Has_cards -> 3

let string_of_state = function

 | Booked    -> "Booked"
 | No_cards  -> "No_cards"
 | Unknown   -> "Unknown"
 | Has_cards -> "Has_cards"

let replace ((rank,_) as state) opp =

 let rec aux acc = function
 | (_rank,_)::tl when _rank = rank -> List.rev_append acc (state::tl)
 | hd::tl -> aux (hd::acc) tl
 | [] -> assert(false)
 in
 aux [] opp ;;

class virtual abstract_player =

 object (s)
   val mutable virtual cards : card list
   val mutable virtual books : pip list
   method virtual ask_rank : unit -> pip
   method virtual give_rank : pip -> card list
   method virtual notify_booked : pip -> unit
   method virtual request_failed : pip -> unit

   method private cards_given rank =
     let matched, rest = List.partition (fun (pip,_) -> pip = rank) cards in
     if List.length matched = 4 then begin
       cards <- rest;
       books <- rank :: books;
       s#notify_booked rank;
       (Some rank)
     end
     else (None)

   method give_card (card : card) =
     let rank = pip_of_card card in
     cards <- card :: cards;
     s#cards_given rank

   method give_cards (_cards : card list) =
     let rank =
       match _cards with
       | [] -> invalid_arg "empty list"
       | hd::tl ->
           List.fold_left
             (fun rank1 (rank2,_) ->
               if rank1 <> rank2
               then invalid_arg "!= ranks"
               else (rank1)
             ) (pip_of_card hd) tl
     in
     cards <- _cards @ cards;
     s#cards_given rank

   method give_rank rank =
     let give, _cards = List.partition (fun (pip, _) -> pip = rank) cards in
     cards <- _cards;
     (give)

   method books_length =
     (List.length books)

   method empty_hand =
     cards = []

   method private dump_cards() =
     print_endline(String.concat ", " (List.map string_of_card cards));

end

class human_player =

 object (s) inherit abstract_player

   val mutable cards = []
   val mutable books = []

   method ask_rank() =
     let ranks =
       List.fold_left (fun acc card ->
         let rank = pip_of_card card in
         if List.mem rank acc
         then (acc)
         else (rank::acc)
       )
       [] cards
     in
     s#dump_cards();
     Printf.printf "Ranks: %s\n%!" (String.concat ", " (List.map string_of_pip ranks));
     let n = List.length ranks in
     Printf.printf "choose from 1 to %d\n%!" n;
     let get_int() =
       try read_int()
       with Failure "int_of_string" -> raise Exit
     in
     let rec aux() =
       let d = get_int() in
       if d <= 0 || d > n then aux() else (pred d)
     in
     let d = aux() in
     (List.nth ranks d)

   method notify_booked rank =
     Printf.printf "Rank [%s] is now booked\n%!" (string_of_pip rank);

   method request_failed rank = ()
 end

class ai_player =

 object (s) inherit abstract_player as parent

   val mutable cards = []
   val mutable books = []
   val mutable opponent = List.map (fun rank -> (rank, Unknown)) pips

   method private dump_state() =
     let f (pip, state) =
       Printf.sprintf "{%s:%s}" (string_of_pip pip) (string_of_state state)
     in
     print_endline(String.concat ", " (List.map f opponent));

   method ask_rank() =
     let ranks =
       List.fold_left (fun acc card ->
         let rank = pip_of_card card in
         try
           let _,n = List.find (fun (_rank,_) -> _rank = rank) acc in
           (replace (rank, n+1) acc)
         with Not_found ->
           ((rank,1)::acc)
       )
       [] cards
     in
     let f (rank,_) =
       (state_score(List.assoc rank opponent))
     in
     let ranks = List.sort (fun a b -> (f b) - (f a)) ranks in
     (* DEBUG
     Printf.printf "Ranks: %s\n%!" (String.concat ", " (List.map string_of_pip ranks));
     s#dump_state();
     s#dump_cards();
     *)
     opponent <- List.sort (fun _ _ -> Random.int 9 - Random.int 9) opponent;
     match ranks with
     | [] -> Jack
     | (x,_)::_ -> x

   method give_cards (_cards : card list) =
     let rank = pip_of_card(List.hd _cards) in
     opponent <- replace (rank, No_cards) opponent;
     (parent#give_cards _cards)

   method give_rank rank =
     opponent <- replace (rank, Has_cards) opponent;
     (parent#give_rank rank)

   method notify_booked rank =
     opponent <- replace (rank, Booked) opponent

   method request_failed rank =
     opponent <- replace (rank, No_cards) opponent
 end

class random_player =

 object (s) inherit ai_player

   method ask_rank() =
     let ranks =
       List.fold_left (fun acc card ->
         let rank = pip_of_card card in
         if List.mem rank acc
         then (acc)
         else (rank::acc)
       )
       [] cards
     in
     let n = List.length ranks in
     let d = Random.int n in
     (List.nth ranks d)

end

exception Empty_deck let card_to_player deck player op =

 match deck with
 | card::deck ->
     begin match player#give_card card with
     | None -> ()
     | Some rank -> op#notify_booked rank
     end;
     (deck)
 | _ -> raise Empty_deck

let n_cards_to_player n deck player op =

 let rec aux i deck =
   if i >= n then (deck) else
     let deck = card_to_player deck player op in
     aux (succ i) deck
 in
 aux 0 deck ;;

let () =

 Random.self_init();
 let deck = List.sort (fun _ _ -> Random.int 9 - Random.int 9) deck in
 let player_a = new human_player
 and player_b = new ai_player in
 let deck = n_cards_to_player 9 deck player_a player_b in
 let deck = n_cards_to_player 9 deck player_b player_a in
 let deck = ref deck in
 let empty_hand player1 player2 =
   if player1#empty_hand
   then deck := card_to_player !deck player1 player2
 in
 let rec make_turn id1 id2 player1 player2 =
   print_newline();
   (try
      empty_hand player1 player2;
      empty_hand player2 player1;
    with Empty_deck -> ());
   if player1#books_length + player2#books_length <> 13
   then begin
     let rank = player1#ask_rank() in
     Printf.printf "player %s asked for %ss\n%!" id1 (string_of_pip rank);
     let cards = player2#give_rank rank in
     match cards with
     | [] ->
         Printf.printf "player %s has no %ss\n%!" id2 (string_of_pip rank);
         player1#request_failed rank;
         (try
            deck := card_to_player !deck player1 player2;
            make_turn id2 id1 player2 player1
          with Empty_deck -> ())

     | cards ->
         let given = String.concat ", " (List.map string_of_card cards) in
         Printf.printf "player %s gives %s\n%!" id2 given;
         begin match player1#give_cards cards with
         | None -> ()
         | Some rank ->
             Printf.printf "player %s booked [%s]\n%!" id1 (string_of_pip rank);
             player2#notify_booked rank;
         end;
         make_turn id1 id2 player1 player2
   end
 in
 (try
    if Random.bool()
    then make_turn "a" "b" player_a player_b
    else make_turn "b" "a" player_b player_a;
  with Exit -> ());

 Printf.printf "player a has %d books\n" (player_a#books_length);
 Printf.printf "player b has %d books\n" (player_b#books_length);

</lang>