forest-fire/001/src/forest_fire.ml

   1 open Printf
   2
   3
   4 (* ------------------------------------------------------------------------- *
   5  * Constants
   6  * ------------------------------------------------------------------------- *)
   7 let default_f = 0.01  (* Probability of spontaneous ignition *)
   8 let default_p = 1.0   (* Probability of spontaneous growth *)
   9
  10 let default_interval = 0.1  (* Induced interval between generations *)
  11
  12 let default_x = 80
  13 let default_y = 25
  14
  15 let char_empty   = ' '
  16 let char_tree    = 'T'
  17 let char_burning = '#'
  18
  19 let ansi_color_tree    = "\027[0;32m"  (* Green *)
  20 let ansi_color_burning = "\027[1;31m"  (* Red *)
  21 let ansi_color_off     = "\027[0m"
  22
  23 let ansi_code_clear = "\027[2J"    (* Clear screen *)
  24 let ansi_code_reset = "\027[1;1H"  (* Reset cursor position *)
  25
  26
  27 (* ------------------------------------------------------------------------- *
  28  * Types
  29  * ------------------------------------------------------------------------- *)
  30 type cell_state =
  31   | Empty | Tree | Burning
  32
  33
  34 type direction =
  35   | N | NE | E | SE | S | SW | W | NW
  36
  37
  38 type options =
  39   { size     : int * int
  40   ; prob     : float * float
  41   ; interval : float
  42   }
  43
  44
  45 (* ------------------------------------------------------------------------- *
  46  * Utils
  47  * ------------------------------------------------------------------------- *)
  48
  49 (* Hack to sleep less than 1 sec *)
  50 let minisleep subsec =
  51   ignore (Unix.select [] [] [] subsec)
  52
  53
  54 let term_clear () =
  55   print_string ansi_code_clear
  56
  57
  58 let term_reset () =
  59   print_string ansi_code_reset
  60
  61
  62 let get_opts argv =
  63   let usage = ""
  64
  65   and interval = ref default_interval
  66   and f = ref default_f
  67   and p = ref default_p
  68   and x = ref default_x
  69   and y = ref default_y in
  70
  71   let speclist =
  72     Arg.align
  73     [ ("-f", Arg.Set_float f, " Probability of spontaneous ignition.")
  74     ; ("-p", Arg.Set_float p, " Probability of spontaneous growth.")
  75     ; ("-x", Arg.Set_int x, " Forest width.")
  76     ; ("-y", Arg.Set_int y, " Forest height.")
  77     ; ("-i", Arg.Set_float interval, " Induced interval between generations.")
  78     ]
  79   in
  80
  81   Arg.parse speclist (fun _ -> ()) usage;
  82
  83   { size     = !x, !y
  84   ; prob     = !f, !p
  85   ; interval = !interval
  86   }
  87
  88
  89 (* ------------------------------------------------------------------------- *
  90  * Core
  91  * ------------------------------------------------------------------------- *)
  92 let directions =
  93   [N; NE; E; SE; S; SW; W; NW]
  94
  95
  96 let offset_of_direction = function
  97   (* Direction -> x, y *)
  98   | N  ->  0, -1
  99   | NE ->  1, -1
 100   | E  ->  1,  0
 101   | SE ->  1,  1
 102   | S  ->  0,  1
 103   | SW -> -1,  1
 104   | W  -> -1,  0
 105   | NW -> -1, -1
 106
 107
 108 let offsets =
 109   List.map (offset_of_direction) directions
 110
 111
 112 let is_probable = function
 113   | probability when (Random.float 1.0) <= probability -> true
 114   | _ -> false
 115
 116
 117 let init_cell_state (_, p) = function
 118   | () when is_probable p -> Tree
 119   | ()                    -> Empty
 120
 121
 122 let init_forest (x, y) prob =
 123   Array.map (Array.map (init_cell_state prob)) (Array.make_matrix y x ())
 124
 125
 126 let string_of_state = function
 127   | Empty   -> sprintf "%c" char_empty
 128   | Tree    -> sprintf "%s%c%s" ansi_color_tree char_tree ansi_color_off
 129   | Burning -> sprintf "%s%c%s" ansi_color_burning char_burning ansi_color_off
 130
 131
 132 let new_state = function
 133   | Burning, _, _                            -> Empty
 134   | Tree,    0, (f, _)    when is_probable f -> Burning
 135   | Tree,    n_burning, _ when n_burning > 0 -> Burning
 136   | Empty,   _, (_, p)    when is_probable p -> Tree
 137   | state,   _, _                            -> state
 138
 139
 140 let print_forest forest =
 141   Array.iter
 142   (
 143     fun row ->
 144       Array.iter
 145       (
 146         fun state ->
 147           print_string (string_of_state state)
 148       )
 149       row;
 150       print_newline ()
 151   )
 152   forest
 153
 154
 155 let is_onside width height (x, y) =
 156   x >= 0 && y >= 0 && x < width && y < height
 157
 158
 159 let next_generation forest (width, height) prob =
 160   Array.mapi
 161   (
 162     fun iy row ->
 163       Array.mapi
 164       (
 165         fun ix state ->
 166           let neighbors = List.map (fun (ox, oy) -> ox + ix, oy + iy) offsets in
 167           let neighbors = List.filter (is_onside width height) neighbors in
 168           let neighbor_states = List.map (fun (x, y) -> forest.(y).(x)) neighbors in
 169           let burning_states = List.filter (fun s -> s == Burning) neighbor_states in
 170           new_state (state, (List.length burning_states), prob)
 171       )
 172       row
 173   )
 174   forest
 175
 176
 177 let rec burn forest size prob interval =
 178   term_reset ();
 179   print_forest forest;
 180   minisleep interval;
 181   burn (next_generation forest size prob) size prob interval
 182
 183
 184 let main argv =
 185   Random.self_init ();
 186
 187   let opts = get_opts argv in
 188   let forest = init_forest opts.size opts.prob in
 189
 190   term_clear ();
 191   burn forest opts.size opts.prob opts.interval
 192
 193
 194 let () = main Sys.argv