X-Git-Url: https://git.xandkar.net/?p=cellular-automata.git;a=blobdiff_plain;f=polymorphism%2F001%2Fsrc%2Fpolymorphism.ml;h=ab2cbd5b89e744eaf8fda0b749e3477bbcce82b3;hp=7b48faf681d45a53c63166c21f8f1c4dd06cce4f;hb=fd22df899f4fb6b3499f89fdcfd84462d89f40de;hpb=a0d860e45b892ba0bd5aff132c24b23bd9ebeff1

diff --git a/polymorphism/001/src/polymorphism.ml b/polymorphism/001/src/polymorphism.ml
index 7b48faf..ab2cbd5 100644
--- a/polymorphism/001/src/polymorphism.ml
+++ b/polymorphism/001/src/polymorphism.ml
@@ -4,7 +4,8 @@ open Core.Std
 let (|-) g f x = f (g x)
 
 
-module Terminal : sig
+module Terminal :
+sig
   type color = [ `green
                | `red
                | `white
@@ -15,7 +16,8 @@ module Terminal : sig
   val clear : unit -> unit
 
   val reset : unit -> unit
-end = struct
+end =
+struct
   type color = [ `green
                | `red
                | `white
@@ -40,8 +42,10 @@ end = struct
 end
 
 
-module type MATRIX = sig
-  module Point : sig
+module Matrix :
+sig
+  module Point :
+  sig
     type t = {r : int; k : int}
   end
 
@@ -58,10 +62,10 @@ module type MATRIX = sig
   val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit
 
   val print : 'a t -> to_string:('a -> string) -> unit
-end
-
-module Matrix : MATRIX = struct
-  module Point = struct
+end =
+struct
+  module Point =
+  struct
     type t = {r : int; k : int}
 
     let (+) p p' =
@@ -70,7 +74,8 @@ module Matrix : MATRIX = struct
       }
   end
 
-  module Direction = struct
+  module Direction =
+  struct
     type t = NW | N | NE
            | W  |     E
            | SW | S | SE
@@ -146,13 +151,15 @@ module Matrix : MATRIX = struct
 end
 
 
-module PhenoType : sig
+module PhenoType :
+sig
   type t
 
   val create : char -> Terminal.color option -> t
 
   val to_string : t -> string
-end = struct
+end =
+struct
   type t = { color     : Terminal.color option
            ; character : char
            }
@@ -168,9 +175,15 @@ end = struct
 end
 
 
-module Cell = struct
-  module State = struct
-    type t = Alive of char
+module Cell =
+struct
+  module State =
+  struct
+    type intention = Friendly
+                   | Neutral
+                   | Hostile
+
+    type t = Alive of intention
            | Dead
   end
 
@@ -180,7 +193,8 @@ module Cell = struct
 end
 
 
-module type RULE = sig
+module type RULE =
+sig
   val create : unit -> Cell.t
 
   val transition : self:Cell.State.t
@@ -189,18 +203,23 @@ module type RULE = sig
 end
 
 
-module Life : RULE = struct
-  module State : sig
+module Life : RULE =
+struct
+  module State :
+  sig
     type t = D | A
 
     val of_int : int -> t
 
-    val to_int : t -> int
+    val is_alive : t -> bool
 
     val to_cell : t -> Cell.t
 
     val of_cell_state : Cell.State.t -> t
-  end = struct
+
+    val next : t -> live_neighbors:int -> t
+  end =
+  struct
     type t = D | A
 
     let of_int = function
@@ -208,66 +227,71 @@ module Life : RULE = struct
       | 1 -> A
       | _ -> assert false
 
-    let to_int = function
-      | D -> 0
-      | A -> 1
+    let is_alive = function
+      | D -> false
+      | A -> true
 
     let to_pheno = function
       | D -> PhenoType.create ' ' None
       | A -> PhenoType.create 'o' (Some `white)
 
     let of_cell_state = function
-      | Cell.State.Dead      -> D
-      | Cell.State.Alive 'A' -> A
-      | Cell.State.Alive _   -> D  (* Foreign cell *)
+      | Cell.State.Dead                      -> D
+      | Cell.State.Alive Cell.State.Friendly -> A
+      | Cell.State.Alive Cell.State.Neutral  -> A
+      | Cell.State.Alive Cell.State.Hostile  -> D
 
     let to_cell_state = function
       | D -> Cell.State.Dead
-      | A -> Cell.State.Alive 'A'
+      | A -> Cell.State.Alive Cell.State.Neutral
 
     let to_cell t =
       { Cell.state = t |> to_cell_state
       ; Cell.pheno = t |> to_pheno
       }
-  end
 
-  let next state ~live_neighbors =
-    match state with
-    | State.A when live_neighbors < 2 -> State.D
-    | State.A when live_neighbors < 4 -> State.A
-    | State.A when live_neighbors > 3 -> State.D
-    | State.D when live_neighbors = 3 -> State.A
-    | State.A -> State.A
-    | State.D -> State.D
+    let next t ~live_neighbors =
+      match t with
+      | A when live_neighbors < 2 -> D
+      | A when live_neighbors < 4 -> A
+      | A when live_neighbors > 3 -> D
+      | D when live_neighbors = 3 -> A
+      | A -> A
+      | D -> D
+  end
 
   let create () =
     Random.int 2 |> State.of_int |> State.to_cell
 
-  let live_neighbors neighbors =
-    neighbors |> List.map ~f:(State.of_cell_state |- State.to_int)
-              |> List.fold_left ~init:0 ~f:(+)
+  let count_of_live =
+       List.map       ~f:State.of_cell_state
+    |- List.filter    ~f:State.is_alive
+    |- List.length
 
   let transition ~self ~neighbors =
     self |> State.of_cell_state
-         |> next ~live_neighbors:(live_neighbors neighbors)
+         |> State.next ~live_neighbors:(count_of_live neighbors)
          |> State.to_cell
 end
 
 
-module ForestFire : RULE = struct
-  module State : sig
+module ForestFire : RULE =
+struct
+  module State :
+  sig
     type t = E | T | B
 
     val is_burning : t -> bool
 
     val of_int : int -> t
 
-    val to_int : t -> int
-
     val to_cell : t -> Cell.t
 
     val of_cell_state : Cell.State.t -> t
-  end = struct
+
+    val next : t -> burning_neighbors:int -> t
+  end =
+  struct
     type t = E | T | B
 
     let is_burning = function
@@ -281,65 +305,60 @@ module ForestFire : RULE = struct
       | 2 -> B
       | _ -> assert false
 
-    let to_int = function
-      | E -> 0
-      | T -> 1
-      | B -> 2
-
     let to_pheno = function
       | E -> PhenoType.create ' ' None
       | T -> PhenoType.create 'T' (Some `green)
       | B -> PhenoType.create '#' (Some `red)
 
     let of_cell_state = function
-      | Cell.State.Dead      -> E
-      | Cell.State.Alive 'T' -> T
-      | Cell.State.Alive 'B' -> B
-      | Cell.State.Alive _   -> E  (* Foreign cell *)
+      | Cell.State.Dead                      -> E
+      | Cell.State.Alive Cell.State.Friendly -> T
+      | Cell.State.Alive Cell.State.Neutral  -> E
+      | Cell.State.Alive Cell.State.Hostile  -> B
 
     let to_cell_state = function
       | E -> Cell.State.Dead
-      | T -> Cell.State.Alive 'T'
-      | B -> Cell.State.Alive 'B'
+      | T -> Cell.State.Alive Cell.State.Friendly
+      | B -> Cell.State.Alive Cell.State.Hostile
 
     let to_cell t =
       { Cell.state = t |> to_cell_state
       ; Cell.pheno = t |> to_pheno
       }
-  end
 
-  let create () =
-    Random.int 3 |> State.of_int |> State.to_cell
+    let f = 0.000001  (* Probability of spontaneous ignition *)
+    let p = 0.1       (* Probability of spontaneous growth *)
 
-  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 is_probable p =
-    (Random.float 1.0) <= p
+    let next t ~burning_neighbors =
+      match t, 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
+  end
 
-  let next state ~burning_neighbors =
-    match state, burning_neighbors with
-    | State.E, _ when is_probable p         -> State.T
-    | State.E, _                            -> State.E
-    | State.T, 0 when is_probable f         -> State.B
-    | State.T, _ when burning_neighbors > 0 -> State.B
-    | State.T, _                            -> State.T
-    | State.B, _                            -> State.E
+  let create () =
+    Random.int 3 |> State.of_int |> State.to_cell
 
-  let burning_neighbors neighbors =
-    neighbors |> List.map ~f:State.of_cell_state
-              |> List.filter ~f:State.is_burning
-              |> List.map ~f:State.to_int
-              |> List.fold_left ~init:0 ~f:(+)
+  let count_of_burning =
+       List.map       ~f:State.of_cell_state
+    |- List.filter    ~f:State.is_burning
+    |- List.length
 
   let transition ~self ~neighbors =
     self |> State.of_cell_state
-         |> next ~burning_neighbors:(burning_neighbors neighbors)
+         |> State.next ~burning_neighbors:(count_of_burning neighbors)
          |> State.to_cell
 end
 
 
-module Automaton : sig
+module Automaton :
+sig
   type t
 
   val create  : rows:int
@@ -349,7 +368,8 @@ module Automaton : sig
              -> t
 
   val loop : t -> unit
-end = struct
+end =
+struct
   type cell = { data : Cell.t
               ; rule : (module RULE)
               }
@@ -406,10 +426,9 @@ end = struct
 end
 
 
-let main () =
+let main interval () =
   Random.self_init ();
   let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
-  let interval = 0.1 in
   let rules =
     [ (module Life : RULE)
     ; (module ForestFire : RULE)
@@ -420,7 +439,11 @@ let main () =
 
 let spec =
   let summary = "Polymorphic Cellular Automata" in
-  let spec = Command.Spec.empty in
+  let spec = Command.Spec.(empty
+    +> flag "-i" (optional_with_default 0.1 float)
+             ~doc:" Induced interval between generations."
+    )
+  in
   Command.basic ~summary spec main