From debaffddb210096a01c9965e0ca1611402ce1f05 Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Mon, 3 Sep 2012 02:21:26 -0400 Subject: [PATCH] Forest-fire model 001. --- forest-fire/001/.gitignore | 4 + forest-fire/001/Makefile | 18 +++ forest-fire/001/src/forest_fire.ml | 180 +++++++++++++++++++++++++++++ 3 files changed, 202 insertions(+) create mode 100644 forest-fire/001/.gitignore create mode 100644 forest-fire/001/Makefile create mode 100644 forest-fire/001/src/forest_fire.ml diff --git a/forest-fire/001/.gitignore b/forest-fire/001/.gitignore new file mode 100644 index 0000000..a97bb19 --- /dev/null +++ b/forest-fire/001/.gitignore @@ -0,0 +1,4 @@ +bin/* +*.o +*.cmi +*.cmx diff --git a/forest-fire/001/Makefile b/forest-fire/001/Makefile new file mode 100644 index 0000000..7da721b --- /dev/null +++ b/forest-fire/001/Makefile @@ -0,0 +1,18 @@ +COMPILER="ocamlopt" +OBJ_EXT="cmx" + + +compile: + @mkdir -p bin + @ocamlfind $(COMPILER) -linkpkg -package unix \ + -o bin/forest_fire \ + src/forest_fire.ml + + +clean: + @rm -rf bin + @find src \ + -iname '*.o' \ + -or -iname '*.cmi' \ + -or -iname '*.$(OBJ_EXT)' \ + | xargs rm diff --git a/forest-fire/001/src/forest_fire.ml b/forest-fire/001/src/forest_fire.ml new file mode 100644 index 0000000..98dad01 --- /dev/null +++ b/forest-fire/001/src/forest_fire.ml @@ -0,0 +1,180 @@ +open Printf + + +(* ------------------------------------------------------------------------- * + * Constants + * ------------------------------------------------------------------------- *) +let f = 0.01 (* Probability of spontaneous ignition *) +let p = 1.0 (* Probability of spontaneous growth *) + +let default_x = 80 +let default_y = 25 + +let char_empty = ' ' +let char_tree = 'T' +let char_burning = '#' + +let ansi_color_tree = "\027[0;32m" (* Green *) +let ansi_color_burning = "\027[1;31m" (* Red *) +let ansi_color_off = "\027[0m" + +let ansi_code_clear = "\027[2J" (* Clear screen *) +let ansi_code_reset = "\027[1;1H" (* Reset cursor position *) + + +(* ------------------------------------------------------------------------- * + * Types + * ------------------------------------------------------------------------- *) +type cell_state = + | Empty | Tree | Burning + + +type direction = + | N | NE | E | SE | S | SW | W | NW + + +type options = + { size : int * int + } + + +(* ------------------------------------------------------------------------- * + * Utils + * ------------------------------------------------------------------------- *) + +(* Hack to sleep less than 1 sec *) +let minisleep subsec = + ignore (Unix.select [] [] [] subsec) + + +let term_clear () = + print_string ansi_code_clear + + +let term_reset () = + print_string ansi_code_reset + + +let get_opts argv = + let usage = "" + + and x = ref default_x + and y = ref default_y in + + let speclist = Arg.align [ + ("-x", Arg.Set_int x, " X."); + ("-y", Arg.Set_int y, " Y."); + ] in + + Arg.parse speclist (fun _ -> ()) usage; + + { size = !x, !y + } + + +(* ------------------------------------------------------------------------- * + * Core + * ------------------------------------------------------------------------- *) +let directions = + [N; NE; E; SE; S; SW; W; NW] + + +let offset_of_direction = function + (* Direction -> x, y *) + | N -> 0, -1 + | NE -> 1, -1 + | E -> 1, 0 + | SE -> 1, 1 + | S -> 0, 1 + | SW -> -1, 1 + | W -> -1, 0 + | NW -> -1, -1 + + +let offsets = + List.map (offset_of_direction) directions + + +let is_probable = function + | probability when (Random.float 1.0) <= probability -> true + | _ -> false + + +let init_cell_state = function + | () when is_probable p -> Tree + | () -> Empty + + +let init_forest (x, y) = + Array.map (Array.map (init_cell_state)) (Array.make_matrix y x ()) + + +let string_of_state = function + | Empty -> sprintf "%c" char_empty + | Tree -> sprintf "%s%c%s" ansi_color_tree char_tree ansi_color_off + | Burning -> sprintf "%s%c%s" ansi_color_burning char_burning ansi_color_off + + +let new_state = function + | Burning, _ -> Empty + | Tree, 0 when is_probable f -> Burning + | Tree, neighbors_burning when neighbors_burning > 0 -> Burning + | Empty, _ when is_probable p -> Tree + | state, _ -> state + + +let print_forest forest = + Array.iter + ( + fun row -> + Array.iter + ( + fun state -> + print_string (string_of_state state) + ) + row; + print_newline () + ) + forest + + +let is_onside width height (x, y) = + x >= 0 && y >= 0 && x < width && y < height + + +let next_generation forest (width, height) = + Array.mapi + ( + fun iy row -> + Array.mapi + ( + fun ix state -> + let neighbors = List.map (fun (ox, oy) -> ox + ix, oy + iy) offsets in + let neighbors = List.filter (is_onside width height) neighbors in + let neighbor_states = List.map (fun (x, y) -> forest.(y).(x)) neighbors in + let burning_states = List.filter (fun s -> s == Burning) neighbor_states in + new_state (state, (List.length burning_states)) + ) + row + ) + forest + + +let rec burn forest size = + term_reset (); + print_forest forest; + minisleep 0.1; + burn (next_generation forest size) size + + +let main argv = + Random.self_init (); + + let opts = get_opts argv in + let forest = init_forest opts.size in + + term_clear (); + burn forest opts.size + + +let () = main Sys.argv -- 2.20.1