diff options
Diffstat (limited to 'judge/morpion_rec.ml')
| -rw-r--r-- | judge/morpion_rec.ml | 166 |
1 files changed, 166 insertions, 0 deletions
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 () + + |