open Core.Std
+module Terminal : sig
+ type color = [ `green
+ | `red
+ ]
+
+ val string_with_color : string -> color -> string
+
+ val clear : unit -> unit
+
+ val reset : unit -> unit
+end = struct
+ type color = [ `green
+ | `red
+ ]
+
+ let ansi_code_clear = "\027[2J" (* Clear screen *)
+ let ansi_code_reset = "\027[1;1H" (* Reset cursor position *)
+
+ let string_of_color = function
+ | `green -> "\027[0;32m"
+ | `red -> "\027[1;31m"
+
+ let string_with_color s c =
+ sprintf "%s%s\027[0m" (string_of_color c) s
+
+ let clear () =
+ print_string ansi_code_clear
+
+ let reset () =
+ print_string ansi_code_reset
+end
+
+
module type MATRIX = sig
module Point : sig
type t = {r : int; k : int}
end
-module PhenoType = struct
- type t = string
+module PhenoType : sig
+ type t
+
+ val create : char -> Terminal.color option -> t
+
+ val to_string : t -> string
+end = struct
+ type t = { color : Terminal.color option
+ ; character : char
+ }
+
+ let create character color =
+ {color; character}
+
+ let to_string = function
+ | {color=None; character} ->
+ String.of_char character
+ | {color=Some c; character} ->
+ Terminal.string_with_color (String.of_char character) c
end
string_of_state
let pheno_of_state : (state -> PhenoType.t) = function
- | D -> " "
- | A -> "o"
+ | D -> PhenoType.create ' ' None
+ | A -> PhenoType.create 'o' None
let int_of_msg msg =
msg |> state_of_string |> int_of_state
Random.int 2 |> state_of_int |> cell_of_state
let live_neighbors inputs =
- inputs |> List.map ~f:int_of_msg |> List.fold_left ~init:0 ~f:(+)
+ inputs
+ |> List.filter ~f:(function "D" | "A" -> true | _ -> false)
+ |> List.map ~f:int_of_msg
+ |> List.fold_left ~init:0 ~f:(+)
let transition ~state ~inputs =
state
end
-module Terminal : sig
- val clear : unit -> unit
- val reset : unit -> unit
-end = struct
- let ansi_code_clear = "\027[2J" (* Clear screen *)
- let ansi_code_reset = "\027[1;1H" (* Reset cursor position *)
+module ForestFire : RULE = struct
+ type state = E | T | B
- let clear () =
- print_string ansi_code_clear
+ let string_of_state : (state -> string) = function
+ | E -> "E"
+ | T -> "T"
+ | B -> "B"
- let reset () =
- print_string ansi_code_reset
+ let msg_of_state : (state -> Msg.t) =
+ string_of_state
+
+ let pheno_of_state : (state -> PhenoType.t) = function
+ | E -> PhenoType.create ' ' None
+ | T -> PhenoType.create 'T' (Some `green)
+ | B -> PhenoType.create '#' (Some `red)
+
+ let cell_of_state s =
+ { Cell.msg = s |> msg_of_state
+ ; Cell.pheno = s |> pheno_of_state
+ ; Cell.state = s |> string_of_state
+ }
+
+ let state_of_string : (string -> state) = function
+ | "E" -> E
+ | "T" -> T
+ | "B" -> B
+ | _ -> assert false
+
+ let state_of_int : (int -> state) = function
+ | 0 -> E
+ | 1 -> T
+ | 2 -> B
+ | _ -> assert false
+
+ let create () =
+ Random.int 3 |> state_of_int |> cell_of_state
+
+ let f = 0.000001 (* Probability of spontaneous ignition *)
+ let p = 0.1 (* Probability of spontaneous growth *)
+
+ let is_probable = function
+ | probability when (Random.float 1.0) <= probability -> true
+ | _ -> false
+
+ let next state ~burning_neighbors =
+ match state, burning_neighbors with
+ | E, _ when is_probable p -> T
+ | E, _ -> E
+ | T, 0 when is_probable f -> B
+ | T, _ when burning_neighbors > 0 -> B
+ | T, _ -> T
+ | B, _ -> E
+
+ let burning_neighbors inputs =
+ inputs
+ |> List.filter_map ~f:(function "B" -> Some 1 | _ -> None)
+ |> List.fold_left ~init:0 ~f:(+)
+
+ let transition ~state ~inputs =
+ state
+ |> state_of_string
+ |> next ~burning_neighbors:(burning_neighbors inputs)
+ |> cell_of_state
end
let create ~rows:rs ~columns:ks ~interval ~rules =
let n = List.length rules in
- let i = Random.int n in
let init () =
- let rule = List.nth_exn rules i in
+ let rule = List.nth_exn rules (Random.int n) in
let module Rule = (val rule : RULE) in
{ rule
; data = Rule.create ()
}
let cell_to_string cell =
- cell.data.Cell.pheno
+ PhenoType.to_string cell.data.Cell.pheno
let print t =
Terminal.reset ();
let interval = 0.1 in
let rules =
[ (module Conway : RULE)
+ ; (module ForestFire : RULE)
]
in
Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules)