(******************************************
 * CS281r code for the constellation game *
 ******************************************)

(***** GRAPHS AND POSITIONS *****)

(* A graph is represented as an array of nodes, where for each node
   we provide the list of indices of its neighbors, and a flag indicating
   whether or not it is hidden. *)

type graph = (int list * bool) array;;

(* An example graph, representing a pentagon. *)

let graph1 = [| ([1 ; 4], true) ;
                ([2 ; 0], false) ;
                ([3 ; 1], false) ;
                ([4 ; 2], false) ;
                ([0 ; 3], false) |];;

(* A more complex graph (from hw1) *)

let graph2 = [| ([1], false) ;
	        ([0; 2; 5], false) ;
	        ([1; 3], false) ;
	        ([2; 4; 5; 6], false) ;
	        ([3; 6], false) ;
	        ([1; 3; 6; 7], true) ;
	        ([3; 4; 5; 7], true) ;
	        ([5; 6; 8; 9], false) ;
	        ([7; 12; 16], true) ;
	        ([7; 10; 12], false) ;
	        ([9; 11], false) ;
	        ([10], false) ;
	        ([8; 9; 13; 14; 15], true) ;
	        ([12; 14; 16], false) ;
	        ([12; 13; 15; 17], true) ;
	        ([12; 14; 19], false) ;
	        ([8; 13; 17], false) ;
	        ([14; 16; 20], true) ;
	        ([19; 20], false) ;
	        ([15; 18], false) ;
	        ([17; 18; 21], true) ;
	        ([20], false) |];;

(* Three new graphs for hw3 *)

let graph3 = [| ([1], false) ;
	        ([0; 2; 3], true) ;
	        ([1; 3; 4], true) ;
	        ([1; 2; 5], false) ;
	        ([2; 5], false) ;
	        ([3; 4], true) |];;

let graph4 = [| ([1; 4], false) ;
	        ([0; 2], false) ;
	        ([1; 3; 4; 5], false) ;
	        ([2; 5], false) ;
	        ([0; 2; 5; 6], true) ;
	        ([2; 3; 4; 6], true) ;
	        ([4; 5; 7; 8], false) ;
	        ([6; 9], true) ;
	        ([6; 9], false) ;
	        ([7; 8], true) ; |];;

let graph5 = [| ([1; 2], false) ;
	        ([0; 5; 9], true) ;
	        ([0; 3; 5], false) ;
	        ([2; 4], false) ;
	        ([3], false) ;
	        ([1; 2; 6; 7; 8], true) ;
	        ([5; 7; 9], false) ;
	        ([5; 6; 8; 10], true) ;
	        ([5; 7; 12], false) ;
	        ([1; 6; 10], false) ;
	        ([7; 9; 13], true) ;
	        ([12; 13], false) ;
	        ([8; 11], false) ;
	        ([10; 11], true) |] ;;


(* Asymmetries takes a graph g and returns a list of asymmetries
   in g.  I.e., the list will contain a pair (i,j) if j is a neighbor
   of i but not vice versa.  A graph is symmetric if there are no 
   assymetries.  Constellation graphs should be symmetric.  This is a
   useful function if you want to create your own graphs.  Also 
   consider writing a random graph generator.  *)

let asymmetries g =
  let asymmetries_at i =
    List.map 
      (fun j -> (i,j))
      (List.filter 
	 (fun j -> not (List.mem i (fst g.(j))))
	 (fst g.(i)))
  in let indices a = Array.to_list ((Array.mapi (fun i _ -> i)) a) 
  in List.concat (List.map asymmetries_at (indices g));;

let symmetric g = asymmetries g = [];;



(* An algebraic data type representing tiles that can be placed on 
   a graph.  *)

type tile = Number of int | Quasar | BlackHole | Unknown ;;

(* A tile set for the smaller graphs *)

let tileset1 = [ BlackHole; Number 1; Number 2 ];;

(* A tileset for the tournament: more black holes and quasars, and all the
   numbers are 1 *)
let tileset2 = 
  [ BlackHole; BlackHole; Quasar; Quasar; Quasar; Number 1; 
    Number 1; Number 1; Number 1; Number 1; Number 1 ];;

(* Now we can represent constellation positions, which have five components.
   The first is just the graph on which the game is being played, and the
   second is the number of players (which is worth remembering).
   The third is an array representing the contents of the graph.  We use the
   option type: an 'a option can either have the value None, or Some x where
   x has type 'a.
   The fourth component is an array indexed by player of the tiles that each
   player currently has.
   The final component indicates who the next player is. *)

type position = { neighbors : graph;
		  num_players : int;
                  contents : (tile * int) option array;
                  tiles : tile list array;
                  turn : int };;  

(* A function that creates the initial position of a game, 
   given the graph on which it is played, the number of players,
   and the tile set. (This function assumes that each player 
   starts with the same tiles). *)

let initial g n tiles =
  { neighbors = g;
    num_players = n;
    contents = Array.map (fun x -> None) g;
    tiles = Array.create n tiles;
    turn = 0 };;

(* An example initial position. *)

let pos1 = 
  initial graph1 2 [ BlackHole; Quasar; Number 1; Number 2; Number 3 ];;

(* The info function takes a position and a player, and returns the information
   available to that player.  The result is also a position, using Unknown for
   the tiles of other players in covered locations. *)

let info pos p = 
  let content_info i = function
    | None -> None
    | Some (t,p') as old -> 
	if (snd pos.neighbors.(i) && p <> p') (* covered node and different player *)
	then Some (Unknown, p')
	else old
  in let tile_info i ts = 
    if i = p then ts else List.map (fun x -> Unknown) ts
  in { neighbors = pos.neighbors;
       num_players = pos.num_players;
       contents = Array.mapi content_info pos.contents;
       tiles = Array.mapi tile_info pos.tiles;
       turn = pos.turn }

(***** POSITION ANALYSIS *****)

(* array_for_all is a utility function that tests if all the elements 
   of an array satisfy a predicate.  It uses short-circuiting: 
   if any element does not satisfy the predicate, array_for_all returns 
   false immediately without testing the other members.  It achieves this
   by throwing an exception and immediately catching it. *)

exception Short_circuit
let array_for_all pred ar = 
  try Array.iter (fun x -> if pred x then () else raise Short_circuit) ar;
      true
  with Short_circuit -> false;;

(* terminal checks to see if the end of the game has been reached. *)

let terminal pos = 
  let full_board = array_for_all (fun x -> x <> None) pos.contents in
  let no_tiles_left = pos.tiles.(pos.turn) = [] in 
  full_board || no_tiles_left;;

(* score computes the score for each player in a position.  It does not
   have to be a final position.  If any nodes are empty they are treated
   as if they contain a zero.  To simplify the presentation I have
   separated out some of the auxiliary functions. *)

let contains_black_hole pos n = 
  match pos.contents.(n) with
  | Some (BlackHole, _) -> true
  | _ -> false

let contains_quasar pos n = 
  match pos.contents.(n) with
  | Some (Quasar, _) -> true
  | _ -> false

let active_black_hole pos n =
  contains_black_hole pos n && 
  not (List.exists (contains_black_hole pos) (fst pos.neighbors.(n)))

let destroyed pos n = List.exists (active_black_hole pos) (fst pos.neighbors.(n))

let active_quasar pos n =
  contains_quasar pos n & not (destroyed pos n)

let score pos = 
  let totals = Array.create pos.num_players 0 in
  let count n = function
    | Some (Number x, p) ->
        if destroyed pos n
        then ()
        else 
          let exponent = (* number of active neighboring quasars *)
	    List.length (List.filter (active_quasar pos) (fst pos.neighbors.(n)))
          in let multiplier = 1 lsl exponent (* binary shift left *)
          in totals.(p) <- totals.(p) + x * multiplier
    | _ -> () in
  Array.iteri count pos.contents;
  totals;;

(***** MOVES *****)

type move = { what : tile;
              where : int };;

let array_filter pred ar =
  let max = Array.length ar in 
  let rec find_from ind = 
    if ind >= max
    then []
    else if pred ar.(ind) 
    then ind :: find_from (ind + 1) 
    else find_from (ind + 1) in
  find_from 0;;

let remove_duplicates = function
  | [] -> []
  | x :: xs -> x :: List.filter (fun y -> y <> x) xs;;

let rec cross_product = fun lx ly ->
  match lx with
  | [] -> []
  | x :: xs -> (List.map (fun y -> (x, y)) ly) @ (cross_product xs ly);;

let legal pos =
  let empty_nodes = array_filter (fun x -> x = None) pos.contents in
  let tls = remove_duplicates pos.tiles.(pos.turn) in
  let make_move (node, tile) = { what = tile; where = node } in
  List.map make_move (cross_product empty_nodes tls);;

let rec remove_first x = function 
  | [] -> []
  | y :: ys -> if x = y then ys else y :: remove_first x ys;;

let transition move pos =
  let new_contents = Array.copy pos.contents
  and new_tiles = Array.copy pos.tiles
  in new_contents.(move.where) <- Some (move.what, pos.turn);
     new_tiles.(pos.turn) <- remove_first move.what new_tiles.(pos.turn);
     { pos with contents = new_contents;
		tiles = new_tiles;
		turn = (pos.turn + 1) mod pos.num_players };;


(***** PUTTING TOGETHER A GAME *****)

(* The five functions that define a game are packaged together
   into a single data type for convenience.  A function player
   that gets the player out of a position is also useful. *)

type ('a,'b) game = { 
  initial : 'a;
  terminal : 'a -> bool;
  score : 'a -> int array;
  legal : 'a -> 'b list;
  transition : 'b -> 'a -> 'a; 
  player : 'a -> int;
};;

(* Creates a constellation game on graph g with number of players n
   and tile set ts. *)

let constellations g n ts = {
  initial = initial g n ts;
  terminal = terminal;
  score = score;
  legal = legal;
  transition = transition;
  player = fun p -> p.turn; };;

(***** DISPLAY *****)

module G = Graphics;;

(* A map is a graph in which each node also has pixel coordinates. *)

type map = { adjacencies : graph; positions : (int * int) array };;

(* Maps for the given graphs *)

let map1 = { 
  adjacencies = graph1;
  positions = [| (300,400) ; (500,300) ; (400,100) ; (200,100) ; (100,300) |]
};;

let map2 = {
  adjacencies = graph2;
  positions = [| (90,300) ;
		 (90,240) ;
		 (30,210) ;
		 (90,180) ;
		 (90,120) ;
		 (150,210) ;
		 (150,150) ;
		 (210,210) ;
		 (270,270) ;
		 (270,150) ;
		 (270,120) ;
		 (270,90) ;
		 (330,210) ;
		 (390,240) ;
		 (390,210) ;
		 (390,150) ;
		 (450,270) ;
		 (450,210) ;
		 (450,150) ;
		 (450,120) ;
		 (510,180) ;
		 (570,180) |] };;

let map3 = {
  adjacencies = graph3;
  positions = [| (270,380) ;
		 (270,290) ;
		 (220,200) ;
		 (320,200) ;
		 (170,110) ;
		 (370,110) |] };;

let map4 = {
  adjacencies = graph4;
  positions = [| (190,240) ;
		 (130,210) ;
		 (190,180) ;
		 (190,120) ;
		 (250,210) ;
		 (250,150) ;
		 (310,210) ;
		 (370,270) ;
		 (370,150) ;
		 (430,210) |] };;

let map5 = {
  adjacencies = graph5;
  positions = [| (110,210) ;
		 (170,270) ;
		 (170,150) ;
		 (170,120) ;
		 (170,90) ;
		 (230,210) ;
		 (290,240) ;
		 (290,210) ;
		 (290,150) ;
		 (350,270) ;
		 (350,210) ;
		 (350,150) ;
		 (350,120) ;
		 (410,180) |] };;


(* Drawing functions *)

let draw_circle color = function (x,y) ->
  G.set_color color;
  G.fill_circle x y 7;
  G.set_color G.black;
  G.draw_circle x y 7;;

let draw_map m = 
  let draw_pair i j = 
    match (m.positions.(i), m.positions.(j)) with
      ( (xi, yi), (xj, yj) ) -> G.moveto xi yi; G.lineto xj yj
  and draw_individual i = function (ns, covered) ->
    if covered
    then draw_circle G.black m.positions.(i)
    else draw_circle G.white m.positions.(i) in
  Array.iteri (fun i ns -> List.iter (draw_pair i) (fst ns)) m.adjacencies;
  Array.iteri draw_individual m.adjacencies;;
  
let colors = [| G.red; G.blue; G.green; G.yellow; G.cyan; G.magenta |];;

let tile_to_string = function
  | BlackHole -> "B"
  | Quasar -> "Q"
  | Number n -> string_of_int n
  | Unknown -> "?" ;;

let show_tile t p = 
  G.set_color colors.(p mod 6);
  G.draw_string (tile_to_string t);
  G.set_color G.black;;

let prep_row x =
  G.set_color G.white;
  G.fill_rect 0 (x * 12) 600 12;
  G.set_color G.black;
  G.moveto 12 (x * 12) ;;

let show_position m pl pos = 
  let show_loc i = function
    | None -> ();
    | Some (t, pl') -> 
	if (snd m.adjacencies.(i) & pl' <> pl) 
	then draw_circle colors.(pl' mod 6) m.positions.(i)
	else match m.positions.(i) with
	  (x,y) -> 
	    G.set_color G.white;
	    G.fill_circle x y 6;
	    G.moveto (x-2) (y-5); 
	    show_tile t pl'
  in let maybe_show_tile t pl' =
    if pl' = pl
    then show_tile t pl'
    else show_tile Unknown pl'
  in let show_tile_list i l =
    prep_row (i + 2);
    G.set_color colors.(i);
    G.draw_string "Player ";
    G.draw_string (string_of_int (i + 1));
    G.draw_string ": ";
    List.iter (fun t -> maybe_show_tile t i; G.draw_char ' ') l
  in begin
    Array.iteri show_loc pos.contents;
    Array.iteri show_tile_list pos.tiles;
    prep_row 1;
    G.draw_string "Player ";
    G.draw_string (string_of_int (pos.turn + 1));
    G.draw_string " to move "
  end;;

let final_scores m p ss =
  let show_player_score i s =
    prep_row (i + 2);
    G.set_color colors.(i);
    G.draw_string "Player ";
    G.draw_string (string_of_int (i + 1));
    G.draw_string " : ";
    G.draw_string (string_of_int s) 
  in let show_loc i = function
    | None -> ();
    | Some (t, pl) ->
	match m.positions.(i) with
	  (x,y) ->
	    G.set_color G.white;
	    G.fill_circle x y 6;
	    G.moveto (x-2) (y-5); 
	    show_tile t pl
  in begin
    Array.iteri show_loc p.contents;
    Array.iteri show_player_score ss;
    prep_row 1;
    G.draw_string "GAME OVER"
  end;;

(* The display operations for playing a game are packaged into a data
   structure with three functional components: one to be used when 
   beginning the game, one each time the position changes, and one
   at the end (it receives the final scores as argument). *)
type 'a display = {
  start : unit -> unit;
  update : 'a -> unit;
  finish : 'a -> int array -> unit;
};;



(* Display functions for a constellation game played on map m, 
   from the point of view of player pl. *)
let map_display m pl = {
  start = (fun _ -> G.open_graph ""; G.clear_graph (); draw_map m);
  update = show_position m pl;
  finish = final_scores m;
};; 

(* A display that does nothing.  
   Useful if you want to run many games quickly.  *)
let null_display m = {
    start = (fun _ -> ());
    update = (fun _ -> ());
    finish = (fun _ _ -> ());
};;
  
(***** CONTROLLING TIME *****)

(* time_limited t f x d attempts to compute f x within the alloted
   time t.  If time runs out, the default value d is returned. 
   This function allows us to set a time limit on every move.
   A limit of 0 corresponds to unlimited time. *)

exception Time
let time_limited (t : float) (f : 'a -> 'b) (x : 'a) (d : 'b) =
  let old_signal =
    Sys.signal Sys.sigvtalrm (Sys.Signal_handle (fun x -> raise Time))
  in let result = ref d
  in let run =
    try
      ignore (Unix.setitimer Unix.ITIMER_VIRTUAL 
		{ Unix.it_interval = 0.0; Unix.it_value = t });
      result := f x;
      ignore (Unix.setitimer Unix.ITIMER_VIRTUAL 
		  { Unix.it_interval = 0.0; Unix.it_value = 0.0 })
    with Time -> print_string "OUT OF TIME!\n"
  in run; Sys.set_signal Sys.sigvtalrm old_signal; !result;;

(***** PLAYING A GAME *****)

(* A player is any function that takes a position and a set
   of legal moves, and picks a move. *)

type ('a,'b) player = 'a -> 'b list -> 'b;;

(* A random player simply picks one of the legal moves at random *)

let random : ('a,'b) player = fun pos moves ->
  List.nth moves (Random.int (List.length moves))

(* A match is put together from the game rules, display functions,
   the players (there should be one for each player in the rules),
   and a time limit on moves. *)

type ('a,'b) mtch = { 
  rules : ('a,'b) game;
  display : 'a display;
  players : ('a,'b) player array;
  time_limit : float;
};;

(* Play takes a match a plays it from start to finish. *)

let play m = 
  m.display.start ();
  let current = ref m.rules.initial in 
  m.display.update !current;

  while (not (m.rules.terminal !current)) do
    let p = m.rules.player !current in 
    (* let mv = m.players.(p) !current (m.rules.legal !current) in *)
    let player_info = info !current p in
    let mv = time_limited
               m.time_limit
               (m.players.(p) player_info)
               (m.rules.legal player_info)
               (random !current (m.rules.legal player_info)) in
    current := transition mv !current;
    m.display.update !current;
  done;
  let final = m.rules.score !current in
  m.display.finish !current final;
  Array.iteri (fun i x -> Printf.printf "%d scored %d\n" i x) final;;

(* Play a constellations game on map m, with players ps,  
  tile lists ts and time limit lim, from the point of view of player i *)

let play_constellations m ps ts lim i = 
  play { rules = constellations m.adjacencies (Array.length ps) ts;
	 display = map_display m i;
	 players = ps;
	 time_limit = lim };;

(***** AN INTERACTIVE PLAYER *****)

(* This player allows you to play constellations interactively.
   When it is your turn to move, click on a map location, and press
   a key for the tile type ('b' for black hole, 'q' for quasar, or the 
   desired digit.   Type 'CTRL-C' to quit.  *)

exception Input_error of string

let ctrlc = char_of_int 3

let interactive map pos moves = 
  let tile = ref None
  and loc = ref (-1) in 
  let read_key st = 
    match st.G.key with
    | 'b' -> BlackHole
    | 'q' -> Quasar
    | c when c >= '0' && c <= '9' -> Number (int_of_char c - int_of_char '0')
    | c when c = ctrlc -> print_string "Interrupted!\n"; raise Exit
    | c -> raise (Input_error "Invalid tile!") in
  let check_tile t =
    if List.mem t pos.tiles.(pos.turn)
    then t
    else raise (Input_error "You don't have that tile!") in
  let read_click st =
    let close (x', y') = 
      abs (st.G.mouse_x - x') < 5 && abs (st.G.mouse_y - y') < 5 in
    match array_filter close map.positions with
    | [] -> raise (Input_error "Location is not a node!")
    | [n] -> n
    | _ -> raise (Input_error "Ambiguous location!") in
  let check_loc n =
    match pos.contents.(n) with
    | None -> n
    | _ -> raise (Input_error "Node already contains a tile!") in
  while !tile = None || !loc = -1 do
    try
      let st = G.wait_next_event [G.Button_down; G.Key_pressed] in
      if st.G.button then loc := check_loc (read_click st) else ();
      if st.G.keypressed then tile := Some (check_tile (read_key st)) else ();
      prep_row 36 (* clear error *)
    with Input_error s -> 
      prep_row 36;
      G.draw_string s;
      G.sound 421 100
  done;
  match !tile with
  | Some t -> { what = t; where = !loc }
  | _ -> failwith "Shouldn't happen!";;

(* Play with two interactive players - just supply map and tile lists;
   play from the point of view of player i. *)

let play2 m ts i = 
  play_constellations m [| interactive m; interactive m |] ts 0.0 i;;

(* Play against a random player - you are player i *)

let play_rand m ts i = 
  play_constellations m 
    (Array.init 2 (fun j -> if j = i then interactive m else random))
    ts 2.0 i;;