diff options
| -rw-r--r-- | judge/morpion_rec.ml | 69 |
1 files changed, 40 insertions, 29 deletions
diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml index 19b1623..0741742 100644 --- a/judge/morpion_rec.ml +++ b/judge/morpion_rec.ml @@ -17,7 +17,12 @@ module G = struct | T type 'a r = 'a * 'a * 'a - type 'a morpion = 'a r * 'a r * 'a r + type 'a morpion = ('a r * 'a r * 'a r) * c + + (* On enregistre dans une grille de morpion le résultat + pour cette grille : non attribué (Empty), X, O, ou nul (T) + Pour y acceder, utiliser reduct : 'a morpion -> c *) + let reduct (_, r) = r type game = game_status * c morpion morpion * loc1 option @@ -48,24 +53,48 @@ module G = struct | 1 -> a | 2 -> b | 3 -> c | _ -> raise Invalid_pos (* getp1 : 'a morpion -> loc1 -> 'a *) - let getp1 m (px, py) = + 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 + (* reduce_m : ('a -> c) -> 'a morpion -> c *) + 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 + | l when List.exists ((=) T) 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 + + (* 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) + (* setp1 : 'a morpion -> loc1 -> 'a -> ('a -> 'c) -> 'a morpion *) + let setp1 (m, r) (px, py) v rf = + let k = setp0 m px (setp0 (getp0 m px) py v) in + (k, if r = Empty then reduce_m rf (k, r) else r) + (* pourquoi ce if ? parce que si quelqu'un a déjà gagné un petit morpion, + alors même si l'adversaire aligne trois pions, le petit morpion lui + reste attribué... *) (* setp2 : 'a morpion morpion -> loc2 -> 'a -> 'a morpion morpion *) let setp m (pg, pp) v = - setp1 m pg (setp1 (getp1 m pg) pp v) + let im = setp1 (getp1 m pg) pp v (fun x -> x) in + let om = setp1 m pg im reduct in + om (* r : 'a -> ('a, 'a, 'a) *) let r x = (x, x, x) @@ -77,7 +106,7 @@ module G = struct let name = "Morpion récursif!" let new_game = - TurnOf P1, r (r (r (r Empty))), None + TurnOf P1, (r (r (r (r Empty), Empty)), Empty), None let full_pm m = List.for_all (fun p -> getp1 m p <> Empty) all_p1 @@ -96,21 +125,6 @@ module G = struct 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 - | l when List.exists ((=) T) 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) act = let (pg, pp) = decode act in @@ -125,7 +139,7 @@ module G = struct -> let op = other_player player in 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 + let new_s = match reduct new_m with | Empty -> TurnOf op | X -> Won P1 | O -> Won P2 @@ -168,7 +182,7 @@ module G = struct set_line_width 1 | _ -> () - let disp_r rf sdf box mor = + let disp_r sdf box mor = let x1, y1, x2, y2 = box in let dx, dy = (x2 - x1) / 3, (y2 - y1) / 3 in let x12, x23 = x1 + dx, x1 + 2 * dx in @@ -180,15 +194,12 @@ module G = struct x1, y12, x2, y12; x1, y23, x2, y23 |]; List.iter (fun p -> sdf (margin (subpos box p) 6) (getp1 mor p)) all_p1; - disp_l 2 box (rf mor) + disp_l 2 box (reduct mor) let display_game (s, mor, q) (pn1, pn2) = let cx, cy = center() in let box = cx - 200, cy - 200, cx + 200, cy + 200 in - disp_r - (reduce_m (reduce_m (fun x -> x))) - (disp_r (reduce_m (fun x -> x)) (disp_l 1)) - box mor; + disp_r (disp_r (disp_l 1)) box mor; begin match q, s with | Some p, TurnOf player -> let x1, y1, x2, y2 = margin (subpos box p) 3 in |