X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=polymorphism%2F001%2Fsrc%2Fpolymorphism.ml;h=6fc0ba9844ed6d708924076a61a626b95cef3755;hb=c30cad07ce8feb92fbfdcd1f17c36a3e2515668c;hp=cb65462af268e831b5181c39ef94a10d6d910845;hpb=479645750e2782b77b97a06cd8142dcfb8d704dd;p=cellular-automata.git

diff --git a/polymorphism/001/src/polymorphism.ml b/polymorphism/001/src/polymorphism.ml
index cb65462..6fc0ba9 100644
--- a/polymorphism/001/src/polymorphism.ml
+++ b/polymorphism/001/src/polymorphism.ml
@@ -1,6 +1,39 @@
 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}
@@ -117,8 +150,25 @@ module State = struct
 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
 
 
@@ -162,8 +212,8 @@ module Conway : RULE = struct
     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
@@ -187,7 +237,10 @@ module Conway : RULE = struct
     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
@@ -197,36 +250,68 @@ module Conway : RULE = struct
 end
 
 
-module Terminal : sig
-  type color = [ `green
-               | `red
-               ]
+module ForestFire : RULE = struct
+  type state = E | T | B
 
-  val string_with_color : string -> color -> string
+  let string_of_state : (state -> string) = function
+    | E -> "E"
+    | T -> "T"
+    | B -> "B"
 
-  val clear : unit -> unit
+  let msg_of_state : (state -> Msg.t) =
+    string_of_state
 
-  val reset : unit -> unit
-end = struct
-  type color = [ `green
-               | `red
-               ]
+  let pheno_of_state : (state -> PhenoType.t) = function
+    | E -> PhenoType.create ' ' None
+    | T -> PhenoType.create 'T' (Some `green)
+    | B -> PhenoType.create '#' (Some `red)
 
-  let ansi_code_clear = "\027[2J"    (* Clear screen *)
-  let ansi_code_reset = "\027[1;1H"  (* Reset cursor position *)
+  let cell_of_state s =
+    { Cell.msg   = s |> msg_of_state
+    ; Cell.pheno = s |> pheno_of_state
+    ; Cell.state = s |> string_of_state
+    }
 
-  let string_of_color = function
-    | `green -> "\027[0;32m"
-    | `red   -> "\027[1;31m"
+  let state_of_string : (string -> state) = function
+    | "E" -> E
+    | "T" -> T
+    | "B" -> B
+    | _   -> assert false
 
-  let string_with_color s c =
-    sprintf "%s%s\027[0m" (string_of_color c) s
+  let state_of_int : (int -> state) = function
+    | 0 -> E
+    | 1 -> T
+    | 2 -> B
+    | _ -> assert false
 
-  let clear () =
-    print_string ansi_code_clear
+  let create () =
+    Random.int 3 |> state_of_int |> cell_of_state
 
-  let reset () =
-    print_string ansi_code_reset
+  let f = 0.000001  (* Probability of spontaneous ignition *)
+  let p = 0.1       (* Probability of spontaneous growth *)
+
+  let is_probable p =
+    (Random.float 1.0) <= p
+
+  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
 
 
@@ -252,9 +337,8 @@ end = struct
 
   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 ()
@@ -267,7 +351,7 @@ end = struct
     }
 
   let cell_to_string cell =
-    cell.data.Cell.pheno
+    PhenoType.to_string cell.data.Cell.pheno
 
   let print t =
     Terminal.reset ();
@@ -304,6 +388,7 @@ let main () =
   let interval = 0.1 in
   let rules =
     [ (module Conway : RULE)
+    ; (module ForestFire : RULE)
     ]
   in
   Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules)