Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 319 lines (275 sloc) 13.144 kb
011010a @martani Code commit of OCaml Maze square.ml and bee.ml
authored
1 (* MARTANI Fakhrou - http://martani.net - 2009 (modified April 2012) *)
207b1cd @martani Code commit of OCaml Maze square.ml and bee.ml
authored
2
3 (*
4 To compile:
5 - Windows:
6 ocamlc -thread unix.cma threads.cma graphics.cma -o bee.exe bee.ml
7 - Linux:
8 ocamlc -thread unix.cma threads.cma graphics.cma -o bee bee.ml
9
10 - To change the size of the maze, change the parameters to the function "make_labyrinth width height" at the end of this file
11 - To change the starting/end point change the parameters of the function "solve" as follows:
12 solve laby start_x start_y end_x end_y
13 *)
14
15 open Graphics;;
16
17 type door = Left | Right | TopLeft | TopRight | BottomLeft | BottomRight;;
18 type cell = {mutable color : int ; mutable doors:door list};;
19 type labyrinth = {width : int; height : int; cells : cell array array};;
20
21 let new_labyrinth w h =
22 { width = w; height = h; cells =
23 Array.init w (fun y ->
24 Array.init h (fun x ->
25 {color = y * w + x + 10; doors = []}
26 )
27 )
28 };;
29
30 exception No_Cell of door;;
31 Random.self_init ();;
32
33 let open_door laby x y door =
34 let cl = laby.cells.(x).(y) in
35 if List.mem door cl.doors = false then
36 cl.doors <- door::cl.doors;;
37
38 let door_opened laby x y door =
39 let cl = laby.cells.(x).(y) in
40 List.mem door cl.doors;;
41
42 let door_closed laby x y door =
43 not (door_opened laby x y door);;
44
45 let neighbour laby x y door =
46 let newx, newy =
47 (*print_string "asking for : ";print_int x;print_string " | ";print_int y;print_string "\n";*)
48 match door with
49 Left -> if x <1 or x >= laby.width or y < 0 or y >= laby.height then raise (No_Cell Left)
50 else
51 x-1, y
52 | Right -> if x < 0 or x >= laby.width - 1 or y < 0 or y >= laby.height then raise (No_Cell Left)
53 else
54 x + 1, y
55 | BottomLeft -> if y < 1 or y >= laby.height or (x = 0 && y mod 2 = 0) or x < 0 or x >= laby.width then
56 raise (No_Cell Left)
57 else
58 (
59 if y mod 2 = 0 then
60 x - 1, y - 1
61 else
62 x, y-1
63 )
64 | BottomRight -> if y < 1 or y >= laby.height or x < 0 or (x = laby.width - 1 && y mod 2 = 1) or x > laby.width - 1 then
65 raise (No_Cell Left)
66 else
67 (
68 if y mod 2 = 0 then
69 x, y - 1
70 else
71 x + 1, y-1
72 )
73
74 | TopLeft -> if y < 0 or y >= laby.height - 1 or (x = 0 && y mod 2 = 0) or x < 0 or x >= laby.width then raise (No_Cell Left)
75 else
76 (
77 if y mod 2 = 0 then
78 x -1 , y + 1
79 else
80 x, y+1
81 )
82
83 | TopRight -> if y < 0 or y >= laby.height - 1 or x < 0 or (x = laby.width - 1 && y mod 2 = 1) or x > laby.width - 1 then raise (No_Cell Left)
84 else
85 (
86 if y mod 2 = 0 then
87 x, y + 1
88 else
89 x + 1, y + 1
90 )
91 in
92 (*print_string "result for : ";print_int newx;print_string " | ";print_int newy;print_string "\n";*)
93 newx, newy;;
94
95 let opposite door =
96 match door with
97 Left -> Right
98 | Right -> Left
99 | TopLeft -> BottomRight
100 | BottomLeft -> TopRight
101 | TopRight -> BottomLeft
102 | BottomRight -> TopLeft;;
103
104 let all_doors = [Left; Right; TopLeft; BottomLeft; TopRight; BottomRight];;
105
106 let rec choose_door laby op =
107 try
108 let rnd_x = Random.int laby.width in
109 let rnd_y = Random.int laby.height in
110 let index = Random.int (List.length all_doors) in
111 let dr = List.nth all_doors index in
112 let _ = neighbour laby rnd_x rnd_y dr in
113 op rnd_x rnd_y dr
114 with
115 _ -> choose_door laby op
116 ;;
117 let rec change_color laby x y c =
118 let cl = laby.cells.(x).(y) in
119 cl.color <- c;
120
121 List.iter (fun dr ->
122 try
123 let nbx, nby = neighbour laby x y dr in
124 if laby.cells.(nbx).(nby).color <> c then
125 (
126 change_color laby nbx nby c;
127 )
128 with
129 _ -> ()
130 ) cl.doors
131 ;;
132
133 let connect laby x y d =
134 try
135 let xn, yn = neighbour laby x y d in
136 let cl = laby.cells.(x).(y) in
137 let cl_new = laby.cells.(xn).(yn) in
138 if cl.color = cl_new.color then
139 raise (No_Cell Left)
140 else
141 (
142 change_color laby xn yn (cl.color);
143 open_door laby x y d;
144 open_door laby xn yn (opposite d);
145 true
146 )
147 with
148 _ -> false;;
149
150 let make_labyrinth width height =
151 let laby = new_labyrinth width height in
152
153 let colors_count = ref (width * height) in
154 while (!colors_count > 1) do
155 if (choose_door laby (connect laby)) then
156 colors_count := !colors_count - 1
157 done;
158 laby
159 ;;
160
161 (********************************* graphics *****************************************)
162 open_graph " 700x600";;
163 set_line_width 1;;
164
165 let get_closed_doors lst_doors all_doors =
166 List.fold_left (fun acc dr -> if List.mem dr lst_doors then acc else dr::acc) [] all_doors;;
167
168 (* draw cell doors *)
169 let draw_cell laby x y =
170 let cl = laby.cells.(x).(y) in
171 let cell_width_tmp = 600 / laby.width in
172 let cell_height_tmp = 600 / laby.height in
173 let cell_width = if cell_width_tmp < cell_height_tmp then cell_width_tmp else cell_height_tmp in
174 set_color 4878475;
175 List.iter (fun dr ->
176 match dr with
177 Left -> moveto (50 + cell_width * x + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + cell_width / 4);
178 lineto (50 + cell_width * x + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + 3 * cell_width / 4)
179
180 |Right -> moveto (50 + cell_width * (x+1) + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + cell_width / 4);
181 lineto (50 + cell_width * (x+1) + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + 3 * cell_width / 4)
182
183 |TopLeft -> moveto (50 + cell_width * x + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + 3 * cell_width / 4);
184 lineto (50 + cell_width * x + ((y mod 2) * cell_width / 2) + cell_width / 2) (50 + 3 * cell_width * y / 4 + cell_width)
185
186 |TopRight -> moveto (50 + cell_width * x + ((y mod 2) * cell_width / 2) + cell_width / 2) (50 + 3 * cell_width * y / 4 + cell_width);
187 lineto (50 + cell_width * (x+1) + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + 3 * cell_width / 4)
188
189 |BottomLeft -> moveto (50 + cell_width * x + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + cell_width / 4);
190 lineto (50 + cell_width * x + ((y mod 2) * cell_width / 2) + cell_width / 2) (50 + 3 * cell_width * y / 4)
191
192 |BottomRight -> moveto (50 + cell_width * x + ((y mod 2) * cell_width / 2) + cell_width / 2) (50 + 3 * cell_width * y / 4);
193 lineto (50 + cell_width * (x+1) + ((y mod 2) * cell_width / 2)) (50 + 3 * cell_width * y / 4 + cell_width / 4)
194 ) (get_closed_doors cl.doors all_doors);;
195
196 let color_cell laby x y =
197 set_color (laby.cells.(x).(y).color);
198 let cell_width_tmp = 600 / laby.width in
199 let cell_height_tmp = 600 / laby.height in
200 let cell_width = if cell_width_tmp < cell_height_tmp then cell_width_tmp else cell_height_tmp in
201 let coordinates = [|
202 (50 + cell_width * x + ((y mod 2) * cell_width / 2)), (50 + 3 * cell_width * y / 4 + cell_width / 4);
203 (50 + cell_width * x + ((y mod 2) * cell_width / 2)), (50 + 3 * cell_width * y / 4 + 3 * cell_width / 4);
204 (50 + cell_width * x + ((y mod 2) * cell_width / 2) + cell_width / 2), (50 + 3 * cell_width * y / 4 + cell_width);
205 (50 + cell_width * (x+1) + ((y mod 2) * cell_width / 2)), (50 + 3 * cell_width * y / 4 + 3 * cell_width / 4);
206 (50 + cell_width * (x+1) + ((y mod 2) * cell_width / 2)), (50 + 3 * cell_width * y / 4 + cell_width / 4);
207 (50 + cell_width * x + ((y mod 2) * cell_width / 2) + cell_width / 2), (50 + 3 * cell_width * y / 4)
208 |] in
209 fill_poly coordinates;;
210
211 (* iterate through a list with the index of the current element *)
212 let iteri f l =
213 let rec aux f i lst =
214 match lst with
215 [] -> ()
216 |hd::tl -> f i hd; aux f (i+1) tl
217 in aux f 0 l;;
218
219 (* make a uniform color of the maze *)
220 let reset_color laby =
221 Array.iter (fun array_cell ->
222 Array.iter (fun cl ->
223 cl.color <- 15461355
224 ) array_cell
225 ) laby.cells;;
226
227 exception Solved;;
228
229 (* once a door is used, we delete it from the list of doors associated to a cell so that we don't go through it again *)
230 let delete_door doors dr =
231 List.fold_left (fun acc x -> if x = dr then acc else x::acc ) [] doors;;
232
233
234 let solve laby public_x public_y ex ey =
235 (*colorer les 2 cellules cible et destination*)
236 laby.cells.(public_x).(public_y).color <- 0;
237 laby.cells.(ex).(ey).color <- 0;
238 color_cell laby public_x public_y;
239 draw_cell laby public_x public_y;
240 color_cell laby ex ey;
241 draw_cell laby ex ey;
242
243 try
244 let rec aux x y ex ey allowed_doors =
245 List.iter (fun dr -> try
246 let nx, ny = neighbour laby x y dr in
247 if nx = public_x && ny = public_y then
248 raise Solved
249 with
250 No_Cell x -> ()) allowed_doors;
251 if x = ex && y = ey then
252 raise Solved
253 else
254 (
255 (* print_string "working : "; print_int x; print_string " | ";print_int y;print_string "\n"; *)
256 laby.cells.(x).(y).color <- 13467442;
257 color_cell laby x y;
258 draw_cell laby x y;
259
260 (*[fr] si la cellule a une seule porte alors elle est forcement pas dans le chemin de la solution,
261 on retourne false dans ce cas, true si elle l'est. On change sa couleur *)
262 if List.length laby.cells.(x).(y).doors = 1 && (x <> public_x or y <> public_y)then
263 (
264 laby.cells.(x).(y).color <- 6724044 ;
265 color_cell laby x y;
266 draw_cell laby x y;
267 Thread.delay 0.02;
268 false
269 )
270 else
271 (
272 let res = ref true in
273 iteri (fun i dr ->
274 try
275 let nx, ny = neighbour laby x y dr in
276 let allowed_drs = delete_door laby.cells.(nx).(ny).doors (opposite dr) in
277
278 (*[fr] si la cellule suivante retourne false (pas dans le chemin) et on est dans la derniere porte
279 alors cette cellule aussi n'est pas dans le chemin *)
280 if (aux nx ny ex ey allowed_drs = false) && (List.length allowed_doors = i + 1) then
281 (
282 laby.cells.(x).(y).color <- 6724044 ;
283 laby.cells.(x).(y).color <- 6724044 ;
284 res := false;
285 )
286 else
287 res := true;
288
289 color_cell laby x y;
290 draw_cell laby x y;
291 Thread.delay 0.02;
292 with
293 No_Cell x -> ()
294 ) allowed_doors;
295 !res;
296 )
297 )
298 in
299 let _ = aux public_x public_y ex ey laby.cells.(public_x).(public_y).doors in ()
300 with
301 Solved -> print_string "solved";;
302
303
304 let show_labyrinth laby =
305 Array.iteri (fun i array_cell ->
306 Array.iteri (fun j cl ->
307 color_cell laby i j;
308 draw_cell laby i j;
309 ) array_cell
310 ) laby.cells;;
311
312
313 let laby = make_labyrinth 50 50;;
314 let _ = reset_color laby;;
315
316 show_labyrinth laby;;
317 solve laby 0 0 32 43;;
318
319 read_line ();;
Something went wrong with that request. Please try again.