4 let (|-) g f x = f (g x)
14 val string_with_color : string -> color -> string
16 val clear : unit -> unit
18 val reset : unit -> unit
26 let ansi_code_clear = "\027[2J" (* Clear screen *)
27 let ansi_code_reset = "\027[1;1H" (* Reset cursor position *)
29 let string_of_color = function
30 | `green -> "\027[0;32m"
31 | `red -> "\027[1;31m"
32 | `white -> "\027[1;37m"
34 let string_with_color s c =
35 sprintf "%s%s\027[0m" (string_of_color c) s
38 print_string ansi_code_clear
41 print_string ansi_code_reset
49 type t = {r : int; k : int}
54 val create : rs:int -> ks:int -> 'a -> 'a t
56 val get_neighbors : 'a t -> Point.t -> 'a list
58 val map : 'a t -> f:('a -> 'b) -> 'b t
60 val mapi : 'a t -> f:(Point.t -> 'a -> 'b) -> 'b t
62 val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit
64 val print : 'a t -> to_string:('a -> string) -> unit
69 type t = {r : int; k : int}
83 let all = [ NW ; N ; NE
91 | NW -> {r = -1; k = -1}
92 | N -> {r = -1; k = 0}
93 | NE -> {r = -1; k = 1}
94 | W -> {r = 0; k = -1}
96 | SW -> {r = 1; k = -1}
98 | SE -> {r = 1; k = 1}
101 type 'a t = 'a array array
103 let create ~rs ~ks x =
104 Array.make_matrix ~dimx:rs ~dimy:ks x
111 f {Point.r; Point.k} x
115 let print t ~to_string =
118 Array.iter r ~f:(fun x -> printf "%s" (to_string x));
123 Array.map t ~f:(Array.map ~f:(fun x -> f x))
130 f {Point.r; Point.k} x
134 let get t {Point.r; Point.k} =
137 let is_within_bounds t {Point.r; Point.k} =
139 | [||] -> assert false
141 r >= 0 && r < Array.length t &&
142 k >= 0 && k < Array.length t.(0)
144 let neighborhood t point =
145 List.map Direction.all ~f:Direction.to_offset
146 |> List.map ~f:(fun offset_point -> Point.(point + offset_point))
147 |> List.filter ~f:(is_within_bounds t)
149 let get_neighbors t point =
150 List.map (neighborhood t point) ~f:(get t)
158 val create : char -> Terminal.color option -> t
160 val to_string : t -> string
163 type t = { color : Terminal.color option
167 let create character color =
170 let to_string = function
171 | {color=None; character} ->
172 String.of_char character
173 | {color=Some c; character} ->
174 Terminal.string_with_color (String.of_char character) c
182 type intention = Friendly
186 type t = Alive of intention
190 type t = { state : State.t
191 ; pheno : PhenoType.t
198 val create : unit -> Cell.t
200 val transition : self:Cell.State.t
201 -> neighbors:Cell.State.t list
212 val of_int : int -> t
214 val to_int : t -> int
216 val to_cell : t -> Cell.t
218 val of_cell_state : Cell.State.t -> t
220 val next : t -> live_neighbors:int -> t
225 let of_int = function
230 let to_int = function
234 let to_pheno = function
235 | D -> PhenoType.create ' ' None
236 | A -> PhenoType.create 'o' (Some `white)
238 let of_cell_state = function
239 | Cell.State.Dead -> D
240 | Cell.State.Alive Cell.State.Friendly -> A
241 | Cell.State.Alive Cell.State.Neutral -> A
242 | Cell.State.Alive Cell.State.Hostile -> D
244 let to_cell_state = function
245 | D -> Cell.State.Dead
246 | A -> Cell.State.Alive Cell.State.Neutral
249 { Cell.state = t |> to_cell_state
250 ; Cell.pheno = t |> to_pheno
253 let next t ~live_neighbors =
255 | A when live_neighbors < 2 -> D
256 | A when live_neighbors < 4 -> A
257 | A when live_neighbors > 3 -> D
258 | D when live_neighbors = 3 -> A
264 Random.int 2 |> State.of_int |> State.to_cell
266 let live_neighbors neighbors =
267 neighbors |> List.map ~f:(State.of_cell_state |- State.to_int)
268 |> List.fold_left ~init:0 ~f:(+)
270 let transition ~self ~neighbors =
271 self |> State.of_cell_state
272 |> State.next ~live_neighbors:(live_neighbors neighbors)
277 module ForestFire : RULE =
283 val is_burning : t -> bool
285 val of_int : int -> t
287 val to_int : t -> int
289 val to_cell : t -> Cell.t
291 val of_cell_state : Cell.State.t -> t
293 val next : t -> burning_neighbors:int -> t
298 let is_burning = function
303 let of_int = function
309 let to_int = function
314 let to_pheno = function
315 | E -> PhenoType.create ' ' None
316 | T -> PhenoType.create 'T' (Some `green)
317 | B -> PhenoType.create '#' (Some `red)
319 let of_cell_state = function
320 | Cell.State.Dead -> E
321 | Cell.State.Alive Cell.State.Friendly -> T
322 | Cell.State.Alive Cell.State.Neutral -> E
323 | Cell.State.Alive Cell.State.Hostile -> B
325 let to_cell_state = function
326 | E -> Cell.State.Dead
327 | T -> Cell.State.Alive Cell.State.Friendly
328 | B -> Cell.State.Alive Cell.State.Hostile
331 { Cell.state = t |> to_cell_state
332 ; Cell.pheno = t |> to_pheno
335 let f = 0.000001 (* Probability of spontaneous ignition *)
336 let p = 0.1 (* Probability of spontaneous growth *)
339 (Random.float 1.0) <= p
341 let next t ~burning_neighbors =
342 match t, burning_neighbors with
343 | E, _ when is_probable p -> T
345 | T, 0 when is_probable f -> B
346 | T, _ when burning_neighbors > 0 -> B
352 Random.int 3 |> State.of_int |> State.to_cell
354 let burning_neighbors neighbors =
355 neighbors |> List.map ~f:State.of_cell_state
356 |> List.filter ~f:State.is_burning
357 |> List.map ~f:State.to_int
358 |> List.fold_left ~init:0 ~f:(+)
360 let transition ~self ~neighbors =
361 self |> State.of_cell_state
362 |> State.next ~burning_neighbors:(burning_neighbors neighbors)
371 val create : rows:int
374 -> rules: (module RULE) list
380 type cell = { data : Cell.t
381 ; rule : (module RULE)
384 type t = { grid : cell Matrix.t
385 ; interval : Time.Span.t
389 let create ~rows:rs ~columns:ks ~interval ~rules =
390 let n = List.length rules in
392 let rule = List.nth_exn rules (Random.int n) in
393 let module Rule = (val rule : RULE) in
395 ; data = Rule.create ()
399 { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ())
400 ; interval = Time.Span.of_float interval
401 ; bar = String.make ks '-'
404 let cell_to_string cell =
405 PhenoType.to_string cell.data.Cell.pheno
410 Matrix.print t.grid ~to_string:cell_to_string;
415 Matrix.mapi t.grid ~f:(
416 fun point {rule; data} ->
417 let module Rule = (val rule : RULE) in
418 let neighbors = Matrix.get_neighbors t.grid point in
421 ~self:data.Cell.state
422 ~neighbors:(List.map neighbors ~f:(fun c -> c.data.Cell.state))
431 Time.pause t.interval;
436 let main interval () =
438 let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
440 [ (module Life : RULE)
441 ; (module ForestFire : RULE)
444 Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules)
448 let summary = "Polymorphic Cellular Automata" in
449 let spec = Command.Spec.(empty
450 +> flag "-i" (optional_with_default 0.1 float)
451 ~doc:" Induced interval between generations."
454 Command.basic ~summary spec main
457 let () = Command.run spec