type counter = {rock : int; scissors : int; paper : int}

type move = Rock | Scissors | Paper

type result = Win | Lost | Drawn

type counterTree =
    Leaf of counter
  | Branch of counter * counterTree * counterTree * counterTree

let tree0 = Leaf {rock=0;scissors=0;paper=0}

let addmove c m =
  match m with
      Rock -> {rock = c.rock+1; scissors = c.scissors; paper = c.paper}
    | Scissors -> {rock = c.rock; scissors = c.scissors+1; paper = c.paper}
    | Paper -> {rock = c.rock; scissors = c.scissors; paper = c.paper+1}

let rec trunclist l c m =
  match l with 
      [] -> []
    | x::xs -> if c>=m then []
      else x :: trunclist xs (c+1) m

let answer m =
  match m with
      Rock -> Paper
    | Scissors -> Rock
    | Paper -> Scissors

let rec guessnext_prob {rock = r; scissors = s; paper = p} =
  if r+s+p = 0 then guessnext_prob {rock=1;scissors=1;paper=1} else
    let rand = (Random.int (r+s+p)) in
      if rand<r then Rock
      else if rand < (r+s) then Scissors
      else Paper


let guessnext {rock = r; scissors = s; paper = p} =
  let l = [(Rock,r); (Scissors, s); (Paper, p)] in
  let ls = List.sort (fun (m1,n1) (m2,n2) -> n2-n1) l in
    match ls with
	(Rock,n)::xs -> Paper
      | (Scissors,n)::xs -> Rock
      | (Paper,n)::xs -> Scissors
      | [] -> Rock

let rec enterhistory t h m =
  match h with
      [] -> (match t with
		 Leaf c -> Leaf (addmove c m)
	       | Branch (c,r,s,p) -> Branch ((addmove c m), r, s, p))
    | Rock :: xs -> (match t with
			 Leaf c -> Branch ((addmove c m), (enterhistory tree0 xs m), tree0, tree0)
		       | Branch (c,r,s,p) -> Branch ((addmove c m), (enterhistory r xs m), s, p))
    | Scissors :: xs -> (match t with
			     Leaf c -> Branch ((addmove c m), tree0, (enterhistory tree0 xs m) ,tree0)
			   | Branch (c,r,s,p) -> Branch ((addmove c m), r, (enterhistory s xs m), p))
    | Paper :: xs -> (match t with
			  Leaf c -> Branch ((addmove c m), tree0 ,tree0 ,(enterhistory tree0 xs m))
			| Branch (c,r,s,p) -> Branch ((addmove c m), r, s, (enterhistory p xs m)))
		 
	  
let rec findcounter t h =
  match t with
      Leaf c -> c
    | Branch (c,r,s,p) -> (match h with
			       [] -> c
			     | Rock::xs -> findcounter r xs
			     | Scissors::xs -> findcounter s xs
			     | Paper::xs -> findcounter p xs)

let rec historyToString h = 
  match h with
      [] -> ""
    | Rock::xs -> "R"^historyToString xs
    | Scissors::xs -> "S"^historyToString xs
    | Paper::xs -> "P"^historyToString xs

let winner human computer = 
  if human = computer then Drawn
  else if human = answer computer then Win
  else Lost;;

let string_of_move m =
  match m with
      Rock -> "Rock"
    | Scissors -> "Scissors"
    | Paper -> "Paper"

let string_of_result r =
  match r with
      Win -> "  You win.\n\n\n"
    | Drawn -> "  It's a drawn.\n\n\n"
    | Lost -> "  You loose.\n\n\n"      

let main() = 
  let finished = ref false in
  let history = ref [] in
  let tree = ref tree0 in
  let human = ref Rock in
  let computer = ref Rock in
  let wins = ref 0 in
  let losts = ref 0 in
  let drawns = ref 0 in
    begin
      print_string ("\n\n         * * *   Rock Scissors Paper (Ocaml Version)   * * *  \n" ^
		    "                  (c) Bernd Gutmann, 9 October 2004         \n\n\n\n");
      Random.init 0;
      while not !finished do
	print_string" Your Move please (R,S,P): ";	
	(match String.uppercase (read_line()) with
	     "R" -> human := Rock
	   | "S" -> human := Scissors
	   | "P" -> human := Paper
	   | _ -> finished := true);
	if !finished = false then
          begin
            computer := answer (guessnext_prob (findcounter !tree !history));
	    tree := enterhistory !tree !history !human;
	    history := trunclist ([!human] @ !history) 0 10;
	    print_string (" I play "^string_of_move !computer^".\n");
	    print_string (string_of_result (winner !human !computer));
	  end
      done;
    end;;
main();;