Implement morpion_rec

3 files changed, 169 insertions, 3 deletions

diff --git a/judge/core.ml b/judge/core.ml
index 0f665c2..259bc1e 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -28,7 +28,7 @@ module type GAME = sig
 
 	val new_game : game
 
-	val turn : game -> player -> string -> game
+	val play : game -> player -> string -> game
 	val s    : game -> game_status
 
 	val display_game : game -> (string * string) -> unit
@@ -287,7 +287,7 @@ module Core (G: GAME) : CORE = struct
 					p.s <- StandBy !game_time;
 				| Play act, Thinking (time, beg_r) ->
 					let end_r = Unix.gettimeofday () in
-					let new_g = G.turn (List.hd g.hist) pi act in
+					let new_g = G.play (List.hd g.hist) pi act in
 					let new_s = G.s new_g in
 					send_m p OK;
 					send_m op (Play act);
diff --git a/judge/dummy_game.ml b/judge/dummy_game.ml
index 29fe88b..1e72682 100644
--- a/judge/dummy_game.ml
+++ b/judge/dummy_game.ml
@@ -7,7 +7,7 @@ module Dummy : GAME = struct
 
   let new_game = (10, [], TurnOf P1)
 
-  let turn (g, l, s0) p xx =
+  let play (g, l, s0) p xx =
     if s0 <> TurnOf p || g <= 0 then
       (g, l, Eliminated p)
     else
diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml
new file mode 100644
index 0000000..337116a
--- /dev/null
+++ b/judge/morpion_rec.ml
@@ -0,0 +1,166 @@
+open Core
+open Main
+
+let ( |> ) x f = f x
+
+module Morpion_rec : sig
+
+	type game		(* immutable structure *)
+
+	val name : string
+	val id   : string
+
+	val new_game : game
+
+  val possibilities : game -> string list
+	val play : game -> player -> string -> game
+	val s    : game -> game_status
+
+	val display_game : game -> (string * string) -> unit
+
+end = struct
+  
+  exception Invalid_pos
+
+  type loc1 = int * int
+  type loc = loc1 * loc1
+
+  type c =
+      | Empty
+      | X
+      | O
+      | T
+
+  type 'a r = 'a * 'a * 'a
+  type 'a morpion = 'a r * 'a r * 'a r
+
+  type game = game_status * c morpion morpion * loc1 option
+
+  (* all_p1 : loc1 list *)
+  let all_p1 = [ 1,1; 1,2; 1,3; 2,1; 2,2; 2,3; 3,1; 3,2; 3,3 ]
+  (* all_w_s : loc1 list list *)
+  let all_w_p1l = [
+      [ 1,1; 1,2; 1,3 ];
+      [ 2,1; 2,2; 2,3 ];
+      [ 3,1; 3,2; 3,3 ];
+      [ 1,1; 2,1; 3,1 ];
+      [ 1,2; 2,2; 3,2 ];
+      [ 1,3; 2,3; 3,3 ];
+      [ 1,1; 2,2; 3,3 ];
+      [ 1,3; 2,2; 3,1 ];
+    ]
+
+  (* encode : loc -> string *)
+  let encode ((xg, yg), (xp, yp)) =
+    Format.sprintf "%d %d %d %d" xg yg xp yp
+  (* decode : string -> loc *)
+  let decode s =
+    Scanf.sscanf s "%d %d %d %d"
+      (fun xg yg xp yp -> (xg, yg), (xp, yp))
+
+  (* getp0 : ('a, 'a, 'a) -> int -> 'a *)
+  let getp0 (a, b, c) x = match x with
+    | 1 -> a | 2 -> b | 3 -> c
+    | _ -> raise Invalid_pos
+  (* getp1 : 'a morpion -> loc1 -> 'a *)
+  let getp1 m (px, py) =
+    getp0 (getp0 m px) py
+  (* getp : 'a morpion morpion -> loc2 -> 'a *)
+  let getp m (pg, pp) =
+    getp1 (getp1 m pg) pp
+
+  (* setp0 : ('a, 'a, 'a) -> int -> 'a -> ('a, 'a, 'a) *)
+  let setp0 (a, b, c) x v = match x with
+    | 1 -> (v, b, c)
+    | 2 -> (a, v, c)
+    | 3 -> (a, b, v)
+    | _ -> raise Invalid_pos
+  (* setp1 : 'a morpion -> loc1 -> 'a -> 'a morpion *)
+  let setp1 m (px, py) v =
+    setp0 m px (setp0 (getp0 m px) py v) 
+  (* setp2 : 'a morpion morpion -> loc2 -> 'a -> 'a morpion morpion *)
+  let setp m (pg, pp) v =
+    setp1 m pg (setp1 (getp1 m pg) pp v)
+
+  (* r : 'a -> ('a, 'a, 'a) *)
+  let r x = (x, x, x)
+
+  (* *************************** *)
+  (* Début du code intéressant ! *)
+
+  let id = "morpion_rec"
+  let name = "Morpion récursif!"
+
+  let new_game = 
+    TurnOf P1, r (r (r (r Empty))), None
+
+  let full_pm m =
+    List.for_all (fun p -> getp1 m p <> Empty) all_p1
+
+
+  let possibilities (s, m, lg) =
+    let pg_poss = match lg with
+      | None -> all_p1
+      | Some x -> if full_pm (getp1 m x) then all_p1 else [x]
+    in
+    List.flatten
+      (List.map (fun pg ->
+          all_p1
+          |> List.filter (fun pp -> getp m (pg, pp) = Empty)
+          |> List.map (fun pp -> (pg, pp)))
+        pg_poss)
+    |> List.map encode
+
+  let reduce_m rf m =
+    match
+      all_w_p1l
+      |> List.map (List.map (fun x -> rf (getp1 m x)))
+      |> List.map (function
+            | l when List.for_all ((=) X) l -> X
+            | l when List.for_all ((=) O) l -> O
+            | l when List.exists ((=) X) l && List.exists ((=) O) l -> T
+            | _ -> Empty)
+    with
+    | l when List.exists ((=) X) l -> X
+    | l when List.exists ((=) O) l -> O
+    | l when List.exists ((=) Empty) l -> Empty
+    | _ -> T
+
+  let play (gs, m, pgo) player act =
+    let elim = (Eliminated player, m, pgo) in
+    let op = other_player player in
+    let (pg, pp) = decode act in
+    if
+      gs = TurnOf player
+    && (match pgo with
+        | None -> true
+        | Some x when full_pm (getp1 m x) -> true
+        | Some x when pg = x -> true
+        | _ -> false)
+    && getp m (pg, pp) = Empty
+    then
+      let new_m = setp m (pg, pp) (match player with P1 -> X | P2 -> O) in
+      let new_s = match reduce_m (reduce_m (fun x -> x)) new_m with
+        | Empty -> TurnOf op
+        | X -> Won P1
+        | O -> Won P2
+        | T -> Tie
+      in
+      (new_s, new_m, Some pp)
+    else elim
+
+  let s (s, _, _) = s
+
+  let display_game (s, m, q) (pn1, pn2) =
+    (* TODO *)
+    ()
+
+
+end
+
+module C = Core(Morpion_rec)
+module Main = Juge(C)
+
+let () = Main.run ()
+
+