BomberMan/again.ml

656 lines
23 KiB
OCaml

(*
TODO :
- deal with double bombing (DONE)
- well shit ==> dash (DONE (needs dash to be fixed tho))
- deeper analysis on pathfinfing
*)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let debug_all = false ;;
let logg = true ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
type pt = {
x : int ;
y : int ;
}
type bomb = {
xy : pt ;
size : int ;
det_time : float ;
}
type player = {
id : int ;
xy : pt ;
nspeed : int ;
nbomb_atonce : int ;
bomb_radius : int ;
ndash : int ;
ntraps : int ;
}
type boost = {
xy : pt ;
spec : int ;
}
let default_point = {
x = 0 ;
y = 0 ;
}
let default_bomb = {
xy = default_point ;
size = 0 ;
det_time = 0. ;
}
and default_player = {
id = 0 ;
xy = default_point ;
nspeed = 0 ;
nbomb_atonce = 0 ;
bomb_radius = 0 ;
ndash = 0 ;
ntraps = 0 ;
}
and default_boost = {
xy = default_point ;
spec = 0 ;
}
and useless = ref 0 ;;
type game_data = {
mutable dt : float ;
mutable player_id : int ;
mutable laby : int array array ;
mutable nbombs : int ;
mutable bombs : bomb array ;
mutable nplayers : int ;
mutable players : player array ;
mutable nboosts : int ;
mutable boosts : boost array ;
}
type danger_map = {
explosionTimes : (float list) array array ;
playersTimes : (float list) array array ;
bonusMap : bool array array ;
explodedCrates : bool array array ;
}
type moveType = EscapeDeath | BlowUpCrates | KillPlayers | ClaimLand ;;
exception ReturnInt of int ;;
exception ReturnBool of bool ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let order = [|(1, 0); (-1, 0); (0, 1); (0, -1)|] ;;
let current_status = ref BlowUpCrates ;;
let action = ref 0 ;;
let dash_left = ref 0 ;;
let equal_pt (p1 : pt) (p2 : pt) =
p1.x = p2.x && p1.y = p2.y ;;
let swap arr i j =
let temp = arr.(i) in
arr.(i) <- arr.(j) ;
arr.(j) <- temp ;;
let is_valid i j len hei =
i >= 0 && j >= 0 && i < len && j < hei ;;
let print_direction = function
| 0 -> Printf.fprintf stderr "NORTH "
| 1 -> Printf.fprintf stderr "EAST "
| 2 -> Printf.fprintf stderr "SOUTH "
| 3 -> Printf.fprintf stderr "WEST "
| 4 -> Printf.fprintf stderr "STILL "
| _-> failwith "ERROR : invalid direction" ;;
let delta i j =
if i = j then 1 else 0 ;;
let overwrite_file (filename : string) =
let ptr = open_out filename in
close_out ptr ;;
let rec pop_list elt = function
| [] -> []
| h::t when h = elt -> t
| h::t -> h::(pop_list elt t) ;;
let is_empty_lst = function
| [] -> true
| _ -> false ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let print_game_data (gd : game_data) =
Printf.fprintf stderr "--------------------------------| Board data |--------------------------------\n" ;
Printf.fprintf stderr "Time : %f\n" gd.dt ;
Printf.fprintf stderr "ID : %d\n" gd.player_id ;
Printf.fprintf stderr "Laby [of size %d %d]:\n" (Array.length gd.laby) (Array.length gd.laby.(0));
for l = 0 to Array.length gd.laby -1 do
Printf.fprintf stderr " " ;
for c = 0 to Array.length gd.laby.(l) -1 do
Printf.fprintf stderr "%d " gd.laby.(l).(c) ;
done;
Printf.fprintf stderr "\n"
done ;
Printf.fprintf stderr "Bombs (%d) : \n" gd.nbombs ;
for b = 0 to gd.nbombs -1 do
Printf.fprintf stderr " [Bomb] (at %d %d) (of size %d) (blowing up at %f)\n" gd.bombs.(b).xy.x gd.bombs.(b).xy.y gd.bombs.(b).size gd.bombs.(b).det_time ;
done;
Printf.fprintf stderr "Players (%d) : \n" gd.nplayers ;
for b = 0 to gd.nplayers -1 do
Printf.fprintf stderr " [Player %d] (at %d %d) (holding %d %d %d %d %d)\n" gd.players.(b).id gd.players.(b).xy.x gd.players.(b).xy.y gd.players.(b).nspeed gd.players.(b).nbomb_atonce gd.players.(b).bomb_radius gd.players.(b).ndash gd.players.(b).ntraps ;
done;
Printf.fprintf stderr "Boosts (%d) : \n" gd.nboosts ;
for b = 0 to gd.nboosts -1 do
Printf.fprintf stderr " [Boost] (at %d %d) (of type %d)\n" gd.boosts.(b).xy.x gd.boosts.(b).xy.y gd.boosts.(b).spec ;
done;;
let print_dangers (dgs : danger_map) =
for w = 0 to Array.length dgs.explosionTimes -1 do
for h = 0 to Array.length dgs.explosionTimes.(0) -1 do
Printf.fprintf stderr "%d " ((List.length dgs.explosionTimes.(w).(h)) + (List.length dgs.playersTimes.(w).(h))) ;
done ;
Printf.fprintf stderr "\n" ;
done ;;
let print_gain_map (map : int array array) =
Printf.fprintf stderr "--------------------------------| Gain levels |--------------------------------\n" ;
for l = 0 to (Array.length map -1) do
for c = 0 to (Array.length map.(l) -1) do
Printf.fprintf stderr "%d " map.(l).(c) ;
done;
Printf.fprintf stderr "\n"
done ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let rec ln_b b = function
| k when k < 0 -> failwith "are you sure about that ?"
| k when k < b -> 0
| k -> 1 + ln_b b (k/b) ;;
let get_meta_info (pid : int) =
let ptr = open_in ("main_"^(string_of_int pid)^".sav") in
let fct0 () = match (int_of_string (input_line ptr)) with
| 0 -> current_status := EscapeDeath
| 1 -> current_status := BlowUpCrates
| 2 -> current_status := ClaimLand
| 3 -> current_status := KillPlayers
| _ -> current_status := EscapeDeath
in
fct0 () ;
try
let resu = int_of_string (input_line ptr) in
dash_left := resu -1;
close_in ptr
with
| End_of_file -> close_in ptr ;;
let set_meta_info (pid : int) =
let ptr = open_out ("main_"^(string_of_int pid)^".sav") in
let fct0 () = match !current_status with
| EscapeDeath -> Printf.fprintf ptr "0"
| BlowUpCrates -> Printf.fprintf ptr "1"
| ClaimLand -> Printf.fprintf ptr "2"
| KillPlayers -> Printf.fprintf ptr "3"
in
fct0 () ;
if !dash_left > 0 then
Printf.fprintf ptr "\n%d" !dash_left ;
close_out ptr ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let int_of_string (str : string) =
String.fold_right (fun ch acc -> let cd = Char.code ch in if cd >= 48 || cd <= 57 then 10*acc + cd - 48 else failwith "not an integer\n") str 0 ;;
let string_of_int (k0 : int) =
String.make (1) (Char.chr (k0 + 48)) ;;
let int_n_of_string (str : string) (n : int) (nlast : int ref) =
let res = Array.make n 0 in
let rec aux idres idstr = match idstr with
| k when k = String.length str || idres >= n ->
nlast := k
| k ->
if str.[k] = ' ' then
aux (idres+1) (k+1)
else begin
let cd = Char.code str.[k] in
if cd >= 48 && cd <= 57 then begin
res.(idres) <- 10 * res.(idres) + cd - 48 ;
aux (idres) (k+1)
end
else
failwith "not an integer (n/n)\n"
end
in
aux 0 0 ;
res ;;
let parse_input (str : string) =
let ptr = open_in str in
let (res : game_data) = {dt = 0. ; player_id = 0 ; laby = [||] ; nbombs = 0 ; bombs = [||] ; nplayers = 0 ; players = [||] ; nboosts = 0 ; boosts = [||] ;} in
try
(* time *)
if debug_all then Printf.fprintf stderr "Time\n" ;
res.dt <- Float.of_string (input_line ptr) ;
(* player_id *)
if debug_all then Printf.fprintf stderr "PID\n" ;
res.player_id <- int_of_string (input_line ptr) ;
(* maze *)
if debug_all then Printf.fprintf stderr "Maze\n" ;
let msize = int_n_of_string (input_line ptr) 2 useless in
res.laby <- Array.make msize.(0) [||] ;
for lane = 0 to msize.(0) -1 do
let psd = input_line ptr in
res.laby.(lane) <- int_n_of_string psd msize.(1) useless ;
done;
(* bombs *)
if debug_all then Printf.fprintf stderr "Boom\n" ;
res.nbombs <- int_of_string (input_line ptr) ;
res.bombs <- Array.make res.nbombs default_bomb ;
for b = 0 to res.nbombs -1 do
let psd = input_line ptr
and last = ref 0 in
let dat = int_n_of_string psd 3 last in
let dtime = Float.of_string (String.init (String.length psd - !last) (fun i -> psd.[i + !last])) in
res.bombs.(b) <- {xy = {x = dat.(0) ; y = dat.(1) ;} ; size = dat.(2) ; det_time = dtime ;
}
done;
(* players *)
if debug_all then Printf.fprintf stderr "Players\n" ;
res.nplayers <- int_of_string (input_line ptr) ;
res.players <- Array.make res.nplayers default_player ;
for p = 0 to res.nplayers -1 do
let dat = int_n_of_string (input_line ptr) 8 useless in
res.players.(p) <- {id = dat.(2) ; xy = {x = dat.(0) ; y = dat.(1) ;} ; nspeed = dat.(3) ; nbomb_atonce = dat.(4) ; bomb_radius = dat.(5) ; ndash = dat.(6) ; ntraps = dat.(7) ;}
done;
(* boosts *)
if debug_all then Printf.fprintf stderr "Boosts\n" ;
res.nboosts <- int_of_string (input_line ptr) ;
res.boosts <- Array.make res.nboosts default_boost ;
for p = 0 to res.nboosts -1 do
let dat = int_n_of_string (input_line ptr) 3 useless in
res.boosts.(p) <- {xy = {x = dat.(0) ; y = dat.(1) ;} ; spec = dat.(2)}
done;
if debug_all then Printf.fprintf stderr "Done!\n" ;
close_in ptr ;
res
with
| End_of_file ->
close_in ptr ;
failwith "cannot happen unless something is wrong" ;;
let build_danger_map (gd : game_data) =
let lines = Array.length gd.laby
and cols = Array.length gd.laby.(0) in
let (res : danger_map) = {
explosionTimes = Array.make lines [||] ;
playersTimes = Array.make lines [||] ;
bonusMap = Array.make lines [||] ;
explodedCrates = Array.make lines [||] ;
} in
for l = 0 to lines -1 do
res.explosionTimes.(l) <- Array.make cols [] ;
res.playersTimes.(l) <- Array.make cols [] ;
res.explodedCrates.(l) <- Array.make cols false ;
res.bonusMap.(l) <- Array.make cols false ;
done;
Array.sort
(
fun b1 b2 -> int_of_float (100. *. (b1.det_time -. b2.det_time))
)
gd.bombs ;
(*if gd.nbombs > 0 then
Printf.fprintf stderr "%f %f\n" (gd.bombs.(0).det_time) (gd.bombs.(Array.length gd.bombs -1).det_time) ;*)
(* add bombs *)
let halt = ref false in
for b = 0 to gd.nbombs -1 do
let bx = gd.bombs.(b).xy.x
and by = gd.bombs.(b).xy.y in
let bsize = gd.bombs.(b).size
and dtime = min (gd.bombs.(b).det_time) (List.fold_left min (gd.dt +. 1000.) res.explosionTimes.(bx).(by)) in
for dir = 0 to 3 do
for w = 0 to bsize do
if (not !halt) && (w > 0 || dir = 0) then begin
let nx = bx + w * (fst order.(dir))
and ny = by + w * (snd order.(dir)) in
if is_valid nx ny lines cols then begin
if (gd.laby.(nx).(ny) = 0 || gd.laby.(nx).(ny) >= 3) || (gd.laby.(nx).(ny) = 2 && res.explodedCrates.(nx).(ny)) then
res.explosionTimes.(nx).(ny) <- (dtime)::(res.explosionTimes.(nx).(ny))
else if gd.laby.(nx).(ny) = 1 then
halt := true
else if gd.laby.(nx).(ny) = 2 then begin
halt := true ;
res.explodedCrates.(nx).(ny) <- true ;
end
end
end
done;
halt := false ;
done
done;
(* add players *)
for p = 0 to gd.nplayers -1 do
if p <> gd.player_id then begin
let bx = gd.players.(p).xy.x
and by = gd.players.(p).xy.y in
let bsize = gd.players.(p).bomb_radius
and dtime = min (gd.dt +. 5.5) (min (List.fold_left min (gd.dt +. 1000.) res.explosionTimes.(bx).(by)) (List.fold_left min (gd.dt +. 1000.) res.playersTimes.(bx).(by))) in
if dtime <> gd.dt +. 5.5 then begin
for dir = 0 to 3 do
for w = 0 to bsize do
if (not !halt) && (w > 0 || dir = 0) then begin
let nx = bx + w * (fst order.(dir))
and ny = by + w * (snd order.(dir)) in
if is_valid nx ny lines cols then begin
if (gd.laby.(nx).(ny) = 0 || gd.laby.(nx).(ny) >= 3) || (gd.laby.(nx).(ny) = 2 && res.explodedCrates.(nx).(ny)) then
res.playersTimes.(nx).(ny) <- (dtime)::(res.playersTimes.(nx).(ny))
else if gd.laby.(nx).(ny) = 1 then
halt := true
else if gd.laby.(nx).(ny) = 2 then begin
halt := true ;
res.explodedCrates.(nx).(ny) <- true ;
end
end
end
done;
halt := false ;
done
end
end
done;
(* add bonuses *)
for b = 0 to gd.nboosts -1 do
res.bonusMap.(gd.boosts.(b).xy.x).(gd.boosts.(b).xy.y) <- true ;
done;
res ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let simulate_bomb (dgs : danger_map) (b : bomb) =
let saved_data = Hashtbl.create 30 in
let bx = b.xy.x
and by = b.xy.y in
let bsize = b.size
and dtime = min (b.det_time) (List.fold_left min (32760.) dgs.explosionTimes.(bx).(by)) in
let lines = Array.length dgs.explosionTimes
and cols = Array.length dgs.explosionTimes.(0) in
for dir = 0 to 3 do
for w = 0 to bsize do
if (w > 0 || dir = 0) then begin
let nx = bx + w * (fst order.(dir))
and ny = by + w * (snd order.(dir)) in
if is_valid nx ny lines cols then begin
Hashtbl.add saved_data (nx, ny) dtime ;
dgs.explosionTimes.(nx).(ny) <- (dtime)::(dgs.explosionTimes.(nx).(ny))
end
end
done;
done;
saved_data ;;
let simulate_bomb_deconstruct (dgs : danger_map) (bx : int) (by : int) (bsize : int) (dtime0 : float) =
let saved_data = Hashtbl.create 30 in
let dtime = min dtime0 (List.fold_left min (32760.) dgs.explosionTimes.(bx).(by)) in
let lines = Array.length dgs.explosionTimes
and cols = Array.length dgs.explosionTimes.(0) in
for dir = 0 to 3 do
for w = 0 to bsize do
if (w > 0 || dir = 0) then begin
let nx = bx + w * (fst order.(dir))
and ny = by + w * (snd order.(dir)) in
if is_valid nx ny lines cols then begin
Hashtbl.add saved_data (nx, ny) dtime ;
dgs.explosionTimes.(nx).(ny) <- (dtime)::(dgs.explosionTimes.(nx).(ny))
end
end
done;
done;
saved_data ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let reverse_simulate_bomb (dgs : danger_map) (save : (int * int, float) Hashtbl.t) =
Hashtbl.iter
(fun (x, y) dt ->
dgs.explosionTimes.(x).(y) <- pop_list dt (dgs.explosionTimes.(x).(y))
)
save ;;
let is_dead (dgs : danger_map) (x : int) (y : int) (t : float) (dt : float) =
(List.fold_left
(fun acc curtime ->
acc || (t >= curtime && t <= curtime +. dt)
)
false
dgs.explosionTimes.(x).(y)
) || (List.fold_left
(fun acc curtime ->
acc || (t >= curtime && t <= curtime +. dt)
)
false
dgs.playersTimes.(x).(y)
) ;;
let is_dead_2 (dgs : danger_map) (x : int) (y : int) (t : float) (dt : float) =
(List.fold_left
(fun acc curtime ->
acc || (t > curtime && t < curtime +. dt)
)
false
dgs.explosionTimes.(x).(y)
) ;;
let is_dead_all (dgs : danger_map) (x : int) (y : int) (t : float) (dt : float) = function
| true -> is_dead_2 dgs x y t dt
| false -> is_dead dgs x y t dt ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let contains_crate (gd : game_data) =
Array.fold_left
(fun b1 lst -> b1 || (Array.fold_left (fun b2 tile -> b2 || (tile = 2)) false lst)) false gd.laby ;;
let is_a_crate_nearby (gd : game_data) (dgs : danger_map) =
let pid = gd.player_id
and lines = Array.length gd.laby
and cols = Array.length gd.laby.(0) in
try
let halt = ref false in
let res = ref false in
for dir = 0 to 3 do
for o = 1 to gd.players.(pid).bomb_radius do
if not !halt then begin
let nx = gd.players.(pid).xy.x + o * (fst order.(dir))
and ny = gd.players.(pid).xy.y + o * (snd order.(dir)) in
if is_valid nx ny lines cols then begin
if gd.laby.(nx).(ny) = 2 then
res := true
else if gd.laby.(nx).(ny) = 1 then
halt := true
else if dgs.bonusMap.(nx).(ny) then
raise (ReturnBool false)
end
end
done;
halt := false ;
done;
!res
with
| ReturnBool b -> b ;;
let sees_a_crate (gd : game_data) (dgs : danger_map) (x : int) (y : int) =
let pid = gd.player_id
and lines = Array.length gd.laby
and cols = Array.length gd.laby.(0) in
try
let halt = ref false in
let res = ref false in
for dir = 0 to 3 do
for o = 1 to gd.players.(pid).bomb_radius do
if not !halt then begin
let nx = x + o * (fst order.(dir))
and ny = y + o * (snd order.(dir)) in
if is_valid nx ny lines cols then begin
if gd.laby.(nx).(ny) = 2 then
res := true
else if gd.laby.(nx).(ny) = 1 then
halt := true
else if dgs.bonusMap.(nx).(ny) then
raise (ReturnBool false)
end
end
done;
halt := false ;
done;
!res
with
| ReturnBool b -> b ;;
let bfs_for_crate (gd : game_data) (dgs : danger_map) (x0 : int) (y0 : int) (stime : float) (searchCrate : bool) (searchBonus : bool) (minDist : int) (ignorePlayers : bool) (maxDist : int) =
let lines = Array.length gd.laby
and cols = Array.length gd.laby.(0) in
let visited = Hashtbl.create 100 in
let q = Queue.create () in
let interval = Float.pow (0.9) (float_of_int gd.players.(gd.player_id).nspeed) in
Queue.add (x0, y0, stime +. interval, 4, 1) q ;
Queue.add (x0+1, y0, stime +. interval, 2, 1) q ;
Queue.add (x0-1, y0, stime +. interval, 0, 1) q ;
Queue.add (x0, y0+1, stime +. interval, 1, 1) q ;
Queue.add (x0, y0-1, stime +. interval, 3, 1) q ;
try
while not (Queue.is_empty q) do
let (x, y, ct, direction, polar) = Queue.pop q in
if is_valid x y lines cols && gd.laby.(x).(y) <> 1 && gd.laby.(x).(y) <> 2 then begin (* within the map *)
if Hashtbl.find_opt visited (x, y, polar) = None then begin (* has not been visited yet *)
Hashtbl.add visited (x, y, polar) 1 ;
if
not (is_dead_all dgs x y ct interval ignorePlayers) &&
ct < stime +. (float_of_int maxDist) *. interval &&
not (Array.fold_left (fun acc (b : bomb) -> acc || (b.xy.x = x && b.xy.y = y)) false gd.bombs)
then begin (* is not lethal *)
if
(ct >= stime +. (float_of_int minDist) *. interval) &&
(is_empty_lst dgs.explosionTimes.(x).(y)) && (* safe *)
(not searchCrate || (sees_a_crate gd dgs x y && not dgs.explodedCrates.(x).(y))) && (* sees a crate *)
(not searchBonus || dgs.bonusMap.(x).(y)) (* is a bonus *)
then begin
raise (ReturnInt direction)
end;
(*Queue.add (x, y, ct +. interval, direction, polar+1) q ;*)
if not (x0 == x && y0 == y) then begin
for dir = 0 to 3 do
Queue.add (x + (fst order.(dir)), y + (snd order.(dir)), ct +. interval, direction, polar) q ;
done;
end
end
end
end
done;
4 ;
with
| ReturnInt k -> k ;;
let move_crate (gd : game_data) (dgs : danger_map) =
let pid = gd.player_id in
let cxi = gd.players.(pid).xy.x
and cyi = gd.players.(pid).xy.y in
try
let bonusres = bfs_for_crate gd dgs cxi cyi gd.dt false true 0 false 7 in
if bonusres <> 4 then begin
if logg then Printf.fprintf stderr "bonus spotted\n" ;
raise (ReturnInt bonusres) ;
end;
if (is_a_crate_nearby gd dgs) && (is_empty_lst dgs.explosionTimes.(cxi).(cyi)) then begin
if gd.players.(pid).nbomb_atonce > 0 then begin
if logg then Printf.fprintf stderr "trying...\n" ;
let saved = simulate_bomb_deconstruct dgs cxi cyi gd.players.(pid).bomb_radius (gd.dt +. 5.5) in
let result = bfs_for_crate gd dgs cxi cyi gd.dt false false 1 false 80 in
if result <> 4 then begin
action := 1 ;
raise (ReturnInt result) ;
end;
reverse_simulate_bomb dgs saved ;
end
else begin
raise (ReturnInt 4)
end;
end;
if logg then Printf.fprintf stderr "searching...\n" ;
let rescr = bfs_for_crate gd dgs cxi cyi gd.dt true false 0 false 80 in
if rescr <> 4 then
rescr
else begin
if logg then Printf.fprintf stderr "searching 2...\n" ;
let rescr2 = bfs_for_crate gd dgs cxi cyi gd.dt false false 0 false 80 in
rescr2
end
with
| ReturnInt k -> k ;;
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------------------------------------------------------------------------------- *)
let game_map = parse_input "entrees.txt" ;;
if debug_all then print_game_data game_map ;;
let danger_data = build_danger_map game_map ;;
(*Printf.fprintf stderr "\n" ;;
print_dangers danger_data ;;*)
get_meta_info game_map.player_id ;;
(*Printf.fprintf stderr "\n" ;;
print_dangers danger_data ;;*)
let direction = move_crate game_map danger_data ;;
Printf.printf "%d %d" direction !action ;
if true || logg then Printf.fprintf stderr "[player %d] %d %d (at time %f)\n" game_map.player_id direction !action game_map.dt;
set_meta_info game_map.player_id ;;