I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

# Go Fish/OCaml

Go Fish/OCaml is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.
`type pip = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten |            Jack | Queen | King | Ace let pips = [Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten;            Jack; Queen; King; Ace] type suit = Diamonds | Spades | Hearts | Clubslet 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_decklet 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);;;`