1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
open Core
open Main
let ( |> ) x f = f x
module G = 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) act =
let (pg, pp) = decode act in
match gs with
| TurnOf player when
(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
->
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
| Empty -> TurnOf op
| X -> Won P1
| O -> Won P2
| T -> Tie
in
(new_s, new_m, Some pp)
| TurnOf x -> (Eliminated x, m, pgo)
| _ -> raise (Eliminated_ex "not someone's turn!")
let s (s, _, _) = s
let display_game (s, m, q) (pn1, pn2) =
(* TODO *)
()
end
|
