4 module type MATRIX = sig
7 val create : rs:int -> ks:int -> data:'a -> 'a t
9 val get_neighbors : 'a t -> r:int -> k:int -> 'a list
11 val map : 'a t -> f:('a -> 'b) -> 'b t
13 val mapi : 'a t -> f:(r:int -> k:int -> data:'a -> 'b) -> 'b t
15 val iter : 'a t -> f:(r:int -> k:int -> data:'a -> unit) -> unit
17 val print : 'a t -> to_string:('a -> string) -> unit
20 module Matrix : MATRIX = struct
21 module Direction = struct
26 let all = [ NW ; N ; NE
31 let to_offset = function
43 type 'a t = 'a array array
45 let create ~rs ~ks ~data =
46 Array.make_matrix ~dimx:rs ~dimy:ks data
57 let print t ~to_string =
60 Array.iter r ~f:(fun x -> printf "%s" (to_string x));
65 Array.map t ~f:(Array.map ~f:(fun x -> f x))
79 let is_within_bounds t ~r ~k =
81 | [||] -> assert false
83 r >= 0 && r < Array.length t &&
84 k >= 0 && k < Array.length t.(0)
86 let neighborhood t ~r ~k =
87 List.map Direction.all ~f:Direction.to_offset
88 |> List.map ~f:(fun (ro, ko) -> (r + ro), (k + ko))
89 |> List.filter ~f:(fun (r, k) -> is_within_bounds t ~r ~k)
91 let get_neighbors t ~r ~k =
92 List.map (neighborhood t ~r ~k) ~f:(fun (r, k) -> get t ~r ~k)
96 module type CELL = sig
99 val create : unit -> t
101 val to_string : t -> string
105 val react : t -> states:int list -> t
109 module Conway : CELL = struct
112 let of_int = function
117 let to_int = function
121 let to_string = function
126 Random.int 2 |> of_int
130 let react t ~states =
131 let live_neighbors = List.fold_left states ~init:0 ~f:(+) in
133 | A when live_neighbors < 2 -> D
134 | A when live_neighbors < 4 -> A
135 | A when live_neighbors > 3 -> D
136 | D when live_neighbors = 3 -> A
144 let grid = Matrix.create ~rs ~ks ~data:() |> Matrix.map ~f:Conway.create in
145 Matrix.print grid ~to_string:Conway.to_string;
146 print_endline (String.make 80 '-');
148 Matrix.mapi grid ~f:(fun ~r ~k ~data:cell ->
149 let neighbors = Matrix.get_neighbors grid ~r ~k in
150 Conway.react cell ~states:(List.map neighbors ~f:Conway.state)
153 Matrix.print grid ~to_string:Conway.to_string
157 let summary = "Polymorphic Cellular Automata" in
159 let open Command.Spec in
161 +> flag "-rows" (optional_with_default 5 int) ~doc:"Height"
162 +> flag "-cols" (optional_with_default 5 int) ~doc:"Width"
164 Command.basic ~summary spec main
167 let () = Command.run spec