let (|-) g f x = f (g x)
-module Terminal : sig
+module Terminal :
+sig
type color = [ `green
| `red
| `white
val clear : unit -> unit
val reset : unit -> unit
-end = struct
+end =
+struct
type color = [ `green
| `red
| `white
end
-module type MATRIX = sig
- module Point : sig
+module Matrix :
+sig
+ module Point :
+ sig
type t = {r : int; k : int}
end
type 'a t
- val create : rs:int -> ks:int -> 'a -> 'a t
+ val make : rs:int -> ks:int -> 'a -> 'a t
val get_neighbors : 'a t -> Point.t -> 'a list
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' =
}
end
- module Direction = struct
+ module Direction =
+ struct
type t = NW | N | NE
| W | E
| SW | S | SE
type 'a t = 'a array array
- let create ~rs ~ks x =
+ let make ~rs ~ks x =
Array.make_matrix ~dimx:rs ~dimy:ks x
let iter t ~f =
let neighborhood t point =
List.map Direction.all ~f:Direction.to_offset
- |> List.map ~f:(fun offset_point -> Point.(point + offset_point))
+ |> List.map ~f:(Point.(+) point)
|> List.filter ~f:(is_within_bounds t)
let get_neighbors t point =
end
-module PhenoType : sig
+module PhenoType :
+sig
type t
- val create : char -> Terminal.color option -> t
+ val make : char -> Terminal.color option -> t
val to_string : t -> string
-end = struct
+end =
+struct
type t = { color : Terminal.color option
; character : char
}
- let create character color =
+ let make character color =
{color; character}
let to_string = function
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
end
-module type RULE = sig
- val create : unit -> Cell.t
+module type RULE =
+sig
+ val init : unit -> Cell.t
val transition : self:Cell.State.t
-> neighbors:Cell.State.t list
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 random : unit -> 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
+ let random () =
+ match Random.int 2 with
| 0 -> D
| 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)
+ | D -> PhenoType.make ' ' None
+ | A -> PhenoType.make '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 init =
+ State.random |- 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 random : unit -> t
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
| T -> false
| B -> true
- let of_int = function
+ let random () =
+ match Random.int 3 with
| 0 -> E
| 1 -> T
| 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)
+ | E -> PhenoType.make ' ' None
+ | T -> PhenoType.make 'T' (Some `green)
+ | B -> PhenoType.make '#' (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 init =
+ State.random |- 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
+ val make : rows:int
-> columns:int
-> interval:float
-> rules: (module RULE) list
-> t
val loop : t -> unit
-end = struct
+end =
+struct
type cell = { data : Cell.t
; rule : (module RULE)
}
; bar : string
}
- let create ~rows:rs ~columns:ks ~interval ~rules =
+ let make ~rows:rs ~columns:ks ~interval ~rules =
let n = List.length rules in
let init () =
let rule = List.nth_exn rules (Random.int n) in
let module Rule = (val rule : RULE) in
{ rule
- ; data = Rule.create ()
+ ; data = Rule.init ()
}
in
Terminal.clear ();
- { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ())
+ { grid = Matrix.map ~f:init (Matrix.make ~rs ~ks ())
; interval = Time.Span.of_float interval
; bar = String.make ks '-'
}
; (module ForestFire : RULE)
]
in
- Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules)
+ Automaton.loop (Automaton.make ~rows:(rows - 3) ~columns ~interval ~rules)
let spec =
home / code / cellular-automata.git / blobdiff