9 val string_with_color : string -> color -> string
11 val clear : unit -> unit
13 val reset : unit -> unit
19 let ansi_code_clear = "\027[2J" (* Clear screen *)
20 let ansi_code_reset = "\027[1;1H" (* Reset cursor position *)
22 let string_of_color = function
23 | `green -> "\027[0;32m"
24 | `red -> "\027[1;31m"
26 let string_with_color s c =
27 sprintf "%s%s\027[0m" (string_of_color c) s
30 print_string ansi_code_clear
33 print_string ansi_code_reset
37 module type MATRIX = sig
39 type t = {r : int; k : int}
44 val create : rs:int -> ks:int -> 'a -> 'a t
46 val get_neighbors : 'a t -> Point.t -> 'a list
48 val map : 'a t -> f:('a -> 'b) -> 'b t
50 val mapi : 'a t -> f:(Point.t -> 'a -> 'b) -> 'b t
52 val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit
54 val print : 'a t -> to_string:('a -> string) -> unit
57 module Matrix : MATRIX = struct
59 type t = {r : int; k : int}
67 module Direction = struct
72 let all = [ NW ; N ; NE
80 | NW -> {r = -1; k = -1}
81 | N -> {r = -1; k = 0}
82 | NE -> {r = -1; k = 1}
83 | W -> {r = 0; k = -1}
85 | SW -> {r = 1; k = -1}
87 | SE -> {r = 1; k = 1}
90 type 'a t = 'a array array
92 let create ~rs ~ks x =
93 Array.make_matrix ~dimx:rs ~dimy:ks x
100 f {Point.r; Point.k} x
104 let print t ~to_string =
107 Array.iter r ~f:(fun x -> printf "%s" (to_string x));
112 Array.map t ~f:(Array.map ~f:(fun x -> f x))
119 f {Point.r; Point.k} x
123 let get t {Point.r; Point.k} =
126 let is_within_bounds t {Point.r; Point.k} =
128 | [||] -> assert false
130 r >= 0 && r < Array.length t &&
131 k >= 0 && k < Array.length t.(0)
133 let neighborhood t point =
134 List.map Direction.all ~f:Direction.to_offset
135 |> List.map ~f:(fun offset_point -> Point.(point + offset_point))
136 |> List.filter ~f:(is_within_bounds t)
138 let get_neighbors t point =
139 List.map (neighborhood t point) ~f:(get t)
148 module State = struct
153 module PhenoType : sig
156 val create : char -> Terminal.color option -> t
158 val to_string : t -> string
160 type t = { color : Terminal.color option
164 let create character color =
167 let to_string = function
168 | {color=None; character} ->
169 String.of_char character
170 | {color=Some c; character} ->
171 Terminal.string_with_color (String.of_char character) c
176 type t = { msg : Msg.t
177 ; pheno : PhenoType.t
183 module type RULE = sig
184 val create : unit -> Cell.t
186 val transition : state:State.t -> inputs:Msg.t list -> Cell.t
190 module Conway : RULE = struct
193 let state_of_string : (string -> state) = function
198 let state_of_int : (int -> state) = function
203 let int_of_state : (state -> int) = function
207 let string_of_state : (state -> string) = function
211 let msg_of_state : (state -> Msg.t) =
214 let pheno_of_state : (state -> PhenoType.t) = function
215 | D -> PhenoType.create ' ' None
216 | A -> PhenoType.create 'o' None
219 msg |> state_of_string |> int_of_state
221 let next state ~live_neighbors =
223 | A when live_neighbors < 2 -> D
224 | A when live_neighbors < 4 -> A
225 | A when live_neighbors > 3 -> D
226 | D when live_neighbors = 3 -> A
230 let cell_of_state s =
231 { Cell.msg = s |> msg_of_state
232 ; Cell.pheno = s |> pheno_of_state
233 ; Cell.state = s |> string_of_state
237 Random.int 2 |> state_of_int |> cell_of_state
239 let live_neighbors inputs =
240 inputs |> List.map ~f:int_of_msg |> List.fold_left ~init:0 ~f:(+)
242 let transition ~state ~inputs =
245 |> next ~live_neighbors:(live_neighbors inputs)
250 module Automaton : sig
253 val create : rows:int
256 -> rules: (module RULE) list
261 type cell = { data : Cell.t
262 ; rule : (module RULE)
265 type t = { grid : cell Matrix.t
266 ; interval : Time.Span.t
270 let create ~rows:rs ~columns:ks ~interval ~rules =
271 let n = List.length rules in
272 let i = Random.int n in
274 let rule = List.nth_exn rules i in
275 let module Rule = (val rule : RULE) in
277 ; data = Rule.create ()
281 { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ())
282 ; interval = Time.Span.of_float interval
283 ; bar = String.make ks '-'
286 let cell_to_string cell =
287 PhenoType.to_string cell.data.Cell.pheno
292 Matrix.print t.grid ~to_string:cell_to_string;
297 Matrix.mapi t.grid ~f:(
298 fun point {rule; data} ->
299 let module Rule = (val rule : RULE) in
300 let neighbors = Matrix.get_neighbors t.grid point in
303 ~state:data.Cell.state
304 ~inputs:(List.map neighbors ~f:(fun cell -> cell.data.Cell.msg))
313 Time.pause t.interval;
320 let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
321 let interval = 0.1 in
323 [ (module Conway : RULE)
326 Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules)
330 let summary = "Polymorphic Cellular Automata" in
331 let spec = Command.Spec.empty in
332 Command.basic ~summary spec main
335 let () = Command.run spec