4 module type MATRIX = sig
6 type t = {r : int; k : int}
11 val create : rs:int -> ks:int -> 'a -> 'a t
13 val get_neighbors : 'a t -> Point.t -> 'a list
15 val map : 'a t -> f:('a -> 'b) -> 'b t
17 val mapi : 'a t -> f:(Point.t -> 'a -> 'b) -> 'b t
19 val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit
21 val print : 'a t -> to_string:('a -> string) -> unit
24 module Matrix : MATRIX = struct
26 type t = {r : int; k : int}
34 module Direction = struct
39 let all = [ NW ; N ; NE
47 | NW -> {r = -1; k = -1}
48 | N -> {r = -1; k = 0}
49 | NE -> {r = -1; k = 1}
50 | W -> {r = 0; k = -1}
52 | SW -> {r = 1; k = -1}
54 | SE -> {r = 1; k = 1}
57 type 'a t = 'a array array
59 let create ~rs ~ks x =
60 Array.make_matrix ~dimx:rs ~dimy:ks x
67 f {Point.r; Point.k} x
71 let print t ~to_string =
74 Array.iter r ~f:(fun x -> printf "%s" (to_string x));
79 Array.map t ~f:(Array.map ~f:(fun x -> f x))
86 f {Point.r; Point.k} x
90 let get t {Point.r; Point.k} =
93 let is_within_bounds t {Point.r; Point.k} =
95 | [||] -> assert false
97 r >= 0 && r < Array.length t &&
98 k >= 0 && k < Array.length t.(0)
100 let neighborhood t point =
101 List.map Direction.all ~f:Direction.to_offset
102 |> List.map ~f:(fun offset_point -> Point.(point + offset_point))
103 |> List.filter ~f:(is_within_bounds t)
105 let get_neighbors t point =
106 List.map (neighborhood t point) ~f:(get t)
115 module State = struct
120 module PhenoType = struct
126 type t = { msg : Msg.t
127 ; pheno : PhenoType.t
133 module type RULE = sig
134 val create : unit -> Cell.t
136 val transition : state:State.t -> inputs:Msg.t list -> Cell.t
140 module Conway : RULE = struct
143 let state_of_string : (string -> state) = function
148 let state_of_int : (int -> state) = function
153 let int_of_state : (state -> int) = function
157 let string_of_state : (state -> string) = function
161 let msg_of_state : (state -> Msg.t) =
164 let pheno_of_state : (state -> PhenoType.t) = function
169 msg |> state_of_string |> int_of_state
171 let next state ~live_neighbors =
173 | A when live_neighbors < 2 -> D
174 | A when live_neighbors < 4 -> A
175 | A when live_neighbors > 3 -> D
176 | D when live_neighbors = 3 -> A
180 let cell_of_state s =
181 { Cell.msg = s |> msg_of_state
182 ; Cell.pheno = s |> pheno_of_state
183 ; Cell.state = s |> string_of_state
187 Random.int 2 |> state_of_int |> cell_of_state
189 let live_neighbors inputs =
190 inputs |> List.map ~f:int_of_msg |> List.fold_left ~init:0 ~f:(+)
192 let transition ~state ~inputs =
195 |> next ~live_neighbors:(live_neighbors inputs)
200 module Automaton : sig
203 val create : rows:int
206 -> rules: (module RULE) list
211 type cell = { data : Cell.t
212 ; rule : (module RULE)
215 type t = { grid : cell Matrix.t
216 ; interval : Time.Span.t
220 let create ~rows:rs ~columns:ks ~interval ~rules =
221 let n = List.length rules in
222 let i = Random.int n in
224 let rule = List.nth_exn rules i in
225 let module Rule = (val rule : RULE) in
227 ; data = Rule.create ()
230 { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ())
231 ; interval = Time.Span.of_float interval
232 ; bar = String.make ks '-'
235 let cell_to_string cell =
240 Matrix.print t.grid ~to_string:cell_to_string;
245 Matrix.mapi t.grid ~f:(
246 fun point {rule; data} ->
247 let module Rule = (val rule : RULE) in
248 let neighbors = Matrix.get_neighbors t.grid point in
251 ~state:data.Cell.state
252 ~inputs:(List.map neighbors ~f:(fun cell -> cell.data.Cell.msg))
261 Time.pause t.interval;
268 let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
269 let interval = 0.1 in
271 [ (module Conway : RULE)
274 Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules)
278 let summary = "Polymorphic Cellular Automata" in
279 let spec = Command.Spec.empty in
280 Command.basic ~summary spec main
283 let () = Command.run spec