type 'a t
- val create : rs:int -> ks:int -> data:'a -> 'a t
+ val create : rs:int -> ks:int -> 'a -> 'a t
val get_neighbors : 'a t -> Point.t -> 'a list
val map : 'a t -> f:('a -> 'b) -> 'b t
- val mapi : 'a t -> f:(Point.t -> data:'a -> 'b) -> 'b t
+ val mapi : 'a t -> f:(Point.t -> 'a -> 'b) -> 'b t
- val iter : 'a t -> f:(Point.t -> data:'a -> unit) -> unit
+ val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit
val print : 'a t -> to_string:('a -> string) -> unit
end
type 'a t = 'a array array
- let create ~rs ~ks ~data =
- Array.make_matrix ~dimx:rs ~dimy:ks data
+ let create ~rs ~ks x =
+ Array.make_matrix ~dimx:rs ~dimy:ks x
let iter t ~f =
Array.iteri t ~f:(
fun r ks ->
Array.iteri ks ~f:(
- fun k data ->
- f {Point.r; Point.k} ~data
+ fun k x ->
+ f {Point.r; Point.k} x
)
)
Array.mapi t ~f:(
fun r ks ->
Array.mapi ks ~f:(
- fun k data ->
- f {Point.r; Point.k} ~data
+ fun k x ->
+ f {Point.r; Point.k} x
)
)
end
-module type CELL = sig
- type t
+module Msg = struct
+ type t = string
+end
+
+
+module State = struct
+ type t = string
+end
+
+
+module PhenoType = struct
+ type t = string
+end
+
- val create : unit -> t
+module Cell = struct
+ type t = { msg : Msg.t
+ ; pheno : PhenoType.t
+ ; state : State.t
+ }
+end
- val to_string : t -> string
- val state : t -> int
+module type RULE = sig
+ val create : unit -> Cell.t
- val react : t -> states:int list -> t
+ val transition : state:State.t -> inputs:Msg.t list -> Cell.t
end
-module Conway : CELL = struct
- type t = D | A
+module Conway : RULE = struct
+ type state = D | A
+
+ let state_of_string : (string -> state) = function
+ | "D" -> D
+ | "A" -> A
+ | _ -> assert false
- let of_int = function
+ let state_of_int : (int -> state) = function
| 0 -> D
| 1 -> A
| _ -> assert false
- let to_int = function
+ let int_of_state : (state -> int) = function
| D -> 0
| A -> 1
- let to_string = function
+ let string_of_state : (state -> string) = function
+ | D -> "D"
+ | A -> "A"
+
+ let msg_of_state : (state -> Msg.t) =
+ string_of_state
+
+ let pheno_of_state : (state -> PhenoType.t) = function
| D -> " "
| A -> "o"
- let create () =
- Random.int 2 |> of_int
-
- let state = to_int
+ let int_of_msg msg =
+ msg |> state_of_string |> int_of_state
- let react t ~states =
- let live_neighbors = List.fold_left states ~init:0 ~f:(+) in
- match t with
+ let next state ~live_neighbors =
+ match state 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
+
+ let cell_of_state s =
+ { Cell.msg = s |> msg_of_state
+ ; Cell.pheno = s |> pheno_of_state
+ ; Cell.state = s |> string_of_state
+ }
+
+ let create () =
+ 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:(+)
+
+ let transition ~state ~inputs =
+ state
+ |> state_of_string
+ |> next ~live_neighbors:(live_neighbors inputs)
+ |> cell_of_state
end
-let rec loop bar grid =
- print_endline bar;
- Matrix.print grid ~to_string:Conway.to_string;
- print_endline bar;
- let grid =
- Matrix.mapi grid ~f:(fun point ~data:cell ->
- let neighbors = Matrix.get_neighbors grid point in
- Conway.react cell ~states:(List.map neighbors ~f:Conway.state)
- )
- in
- Unix.sleep 1;
- loop bar grid
+module Automaton : sig
+ type t
+
+ val create : rows:int
+ -> columns:int
+ -> interval:float
+ -> rules: (module RULE) list
+ -> t
+
+ val loop : t -> unit
+end = struct
+ type cell = { data : Cell.t
+ ; rule : (module RULE)
+ }
+
+ type t = { grid : cell Matrix.t
+ ; interval : Time.Span.t
+ ; bar : string
+ }
+
+ 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 module Rule = (val rule : RULE) in
+ { rule
+ ; data = Rule.create ()
+ }
+ in
+ { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ())
+ ; interval = Time.Span.of_float interval
+ ; bar = String.make ks '-'
+ }
+
+ let cell_to_string cell =
+ cell.data.Cell.pheno
+
+ let print t =
+ print_endline t.bar;
+ Matrix.print t.grid ~to_string:cell_to_string;
+ print_endline t.bar
+
+ let next t =
+ let grid =
+ Matrix.mapi t.grid ~f:(
+ fun point {rule; data} ->
+ let module Rule = (val rule : RULE) in
+ let neighbors = Matrix.get_neighbors t.grid point in
+ let data =
+ Rule.transition
+ ~state:data.Cell.state
+ ~inputs:(List.map neighbors ~f:(fun cell -> cell.data.Cell.msg))
+ in
+ {rule; data}
+ )
+ in
+ {t with grid}
+
+ let rec loop t =
+ print t;
+ Time.pause t.interval;
+ loop (next t)
+end
let main () =
Random.self_init ();
- let rs, ks = Or_error.ok_exn Linux_ext.get_terminal_size () in
- Matrix.create ~rs:(rs - 3) ~ks ~data:()
- |> Matrix.map ~f:Conway.create
- |> loop (String.make ks '-')
+ let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
+ let interval = 0.1 in
+ let rules =
+ [ (module Conway : RULE)
+ ]
+ in
+ Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules |> Automaton.loop
let spec =