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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
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 ()
|
