Commit | Line | Data |
---|---|---|
8c93b722 SK |
1 | open Core.Std |
2 | ||
3 | ||
4d49c95e | 4 | module type MATRIX = sig |
7c363dd8 SK |
5 | module Point : sig |
6 | type t = {r : int; k : int} | |
7 | end | |
8 | ||
4d49c95e SK |
9 | type 'a t |
10 | ||
a1665c92 | 11 | val create : rs:int -> ks:int -> 'a -> 'a t |
4d49c95e | 12 | |
7c363dd8 | 13 | val get_neighbors : 'a t -> Point.t -> 'a list |
4d49c95e | 14 | |
65dbef41 SK |
15 | val map : 'a t -> f:('a -> 'b) -> 'b t |
16 | ||
a1665c92 | 17 | val mapi : 'a t -> f:(Point.t -> 'a -> 'b) -> 'b t |
4d49c95e | 18 | |
a1665c92 | 19 | val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit |
0ce0e798 SK |
20 | |
21 | val print : 'a t -> to_string:('a -> string) -> unit | |
4d49c95e SK |
22 | end |
23 | ||
24 | module Matrix : MATRIX = struct | |
7c363dd8 SK |
25 | module Point = struct |
26 | type t = {r : int; k : int} | |
27 | ||
28 | let (+) p p' = | |
29 | { r = p.r + p'.r | |
30 | ; k = p.k + p'.k | |
31 | } | |
32 | end | |
33 | ||
394125ca SK |
34 | module Direction = struct |
35 | type t = NW | N | NE | |
36 | | W | E | |
37 | | SW | S | SE | |
38 | ||
39 | let all = [ NW ; N ; NE | |
40 | ; W ; E | |
41 | ; SW ; S ; SE | |
42 | ] | |
43 | ||
7c363dd8 SK |
44 | let to_offset = |
45 | let open Point in | |
46 | function | |
47 | | NW -> {r = -1; k = -1} | |
48 | | N -> {r = -1; k = 0} | |
49 | | NE -> {r = -1; k = 1} | |
50 | | W -> {r = 0; k = -1} | |
51 | | E -> {r = 0; k = 1} | |
52 | | SW -> {r = 1; k = -1} | |
53 | | S -> {r = 1; k = 0} | |
54 | | SE -> {r = 1; k = 1} | |
394125ca SK |
55 | end |
56 | ||
4d49c95e SK |
57 | type 'a t = 'a array array |
58 | ||
a1665c92 SK |
59 | let create ~rs ~ks x = |
60 | Array.make_matrix ~dimx:rs ~dimy:ks x | |
4d49c95e SK |
61 | |
62 | let iter t ~f = | |
63 | Array.iteri t ~f:( | |
63fe855d SK |
64 | fun r ks -> |
65 | Array.iteri ks ~f:( | |
a1665c92 SK |
66 | fun k x -> |
67 | f {Point.r; Point.k} x | |
4d49c95e SK |
68 | ) |
69 | ) | |
70 | ||
0ce0e798 SK |
71 | let print t ~to_string = |
72 | Array.iter t ~f:( | |
63fe855d SK |
73 | fun r -> |
74 | Array.iter r ~f:(fun x -> printf "%s" (to_string x)); | |
0ce0e798 SK |
75 | print_newline () |
76 | ) | |
77 | ||
4d49c95e | 78 | let map t ~f = |
65dbef41 SK |
79 | Array.map t ~f:(Array.map ~f:(fun x -> f x)) |
80 | ||
81 | let mapi t ~f = | |
4d49c95e | 82 | Array.mapi t ~f:( |
63fe855d SK |
83 | fun r ks -> |
84 | Array.mapi ks ~f:( | |
a1665c92 SK |
85 | fun k x -> |
86 | f {Point.r; Point.k} x | |
4d49c95e SK |
87 | ) |
88 | ) | |
89 | ||
7c363dd8 | 90 | let get t {Point.r; Point.k} = |
63fe855d | 91 | t.(r).(k) |
394125ca | 92 | |
7c363dd8 | 93 | let is_within_bounds t {Point.r; Point.k} = |
394125ca SK |
94 | match t with |
95 | | [||] -> assert false | |
96 | | t -> | |
97 | r >= 0 && r < Array.length t && | |
98 | k >= 0 && k < Array.length t.(0) | |
99 | ||
7c363dd8 | 100 | let neighborhood t point = |
394125ca | 101 | List.map Direction.all ~f:Direction.to_offset |
7c363dd8 SK |
102 | |> List.map ~f:(fun offset_point -> Point.(point + offset_point)) |
103 | |> List.filter ~f:(is_within_bounds t) | |
394125ca | 104 | |
7c363dd8 SK |
105 | let get_neighbors t point = |
106 | List.map (neighborhood t point) ~f:(get t) | |
4d49c95e SK |
107 | end |
108 | ||
109 | ||
a96702d3 SK |
110 | module Msg = struct |
111 | type t = string | |
112 | end | |
113 | ||
114 | ||
115 | module State = struct | |
116 | type t = string | |
117 | end | |
118 | ||
119 | ||
120 | module PhenoType = struct | |
121 | type t = string | |
122 | end | |
123 | ||
da8f1674 | 124 | |
a96702d3 SK |
125 | module Cell = struct |
126 | type t = { msg : Msg.t | |
127 | ; pheno : PhenoType.t | |
128 | ; state : State.t | |
129 | } | |
130 | end | |
0ce0e798 | 131 | |
0ce0e798 | 132 | |
a96702d3 SK |
133 | module type RULE = sig |
134 | val create : unit -> Cell.t | |
da8f1674 | 135 | |
a96702d3 | 136 | val transition : state:State.t -> inputs:Msg.t list -> Cell.t |
da8f1674 SK |
137 | end |
138 | ||
139 | ||
a96702d3 SK |
140 | module Conway : RULE = struct |
141 | type state = D | A | |
0d6f7833 | 142 | |
a96702d3 SK |
143 | let state_of_string : (string -> state) = function |
144 | | "D" -> D | |
145 | | "A" -> A | |
146 | | _ -> assert false | |
147 | ||
148 | let state_of_int : (int -> state) = function | |
0ce0e798 SK |
149 | | 0 -> D |
150 | | 1 -> A | |
151 | | _ -> assert false | |
152 | ||
a96702d3 | 153 | let int_of_state : (state -> int) = function |
0d6f7833 SK |
154 | | D -> 0 |
155 | | A -> 1 | |
156 | ||
a96702d3 SK |
157 | let string_of_state : (state -> string) = function |
158 | | D -> "D" | |
159 | | A -> "A" | |
160 | ||
161 | let msg_of_state : (state -> Msg.t) = | |
162 | string_of_state | |
163 | ||
164 | let pheno_of_state : (state -> PhenoType.t) = function | |
0ce0e798 SK |
165 | | D -> " " |
166 | | A -> "o" | |
167 | ||
a96702d3 SK |
168 | let int_of_msg msg = |
169 | msg |> state_of_string |> int_of_state | |
0ce0e798 | 170 | |
a96702d3 SK |
171 | let next state ~live_neighbors = |
172 | match state with | |
0d6f7833 SK |
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 | |
b36c0aef SK |
177 | | A -> A |
178 | | D -> D | |
a96702d3 SK |
179 | |
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 | |
184 | } | |
185 | ||
186 | let create () = | |
187 | Random.int 2 |> state_of_int |> cell_of_state | |
188 | ||
189 | let live_neighbors inputs = | |
190 | inputs |> List.map ~f:int_of_msg |> List.fold_left ~init:0 ~f:(+) | |
191 | ||
192 | let transition ~state ~inputs = | |
193 | state | |
194 | |> state_of_string | |
195 | |> next ~live_neighbors:(live_neighbors inputs) | |
196 | |> cell_of_state | |
0d6f7833 SK |
197 | end |
198 | ||
199 | ||
21c4909c | 200 | module Terminal : sig |
47964575 SK |
201 | type color = [ `green |
202 | | `red | |
203 | ] | |
204 | ||
205 | val string_with_color : string -> color -> string | |
206 | ||
21c4909c | 207 | val clear : unit -> unit |
47964575 | 208 | |
21c4909c SK |
209 | val reset : unit -> unit |
210 | end = struct | |
47964575 SK |
211 | type color = [ `green |
212 | | `red | |
213 | ] | |
214 | ||
21c4909c SK |
215 | let ansi_code_clear = "\027[2J" (* Clear screen *) |
216 | let ansi_code_reset = "\027[1;1H" (* Reset cursor position *) | |
217 | ||
47964575 SK |
218 | let string_of_color = function |
219 | | `green -> "\027[0;32m" | |
220 | | `red -> "\027[1;31m" | |
221 | ||
222 | let string_with_color s c = | |
223 | sprintf "%s%s\027[0m" (string_of_color c) s | |
224 | ||
21c4909c SK |
225 | let clear () = |
226 | print_string ansi_code_clear | |
227 | ||
228 | let reset () = | |
229 | print_string ansi_code_reset | |
230 | end | |
231 | ||
232 | ||
d9fa5d46 SK |
233 | module Automaton : sig |
234 | type t | |
aed335e3 | 235 | |
a96702d3 SK |
236 | val create : rows:int |
237 | -> columns:int | |
238 | -> interval:float | |
239 | -> rules: (module RULE) list | |
240 | -> t | |
aed335e3 | 241 | |
d9fa5d46 SK |
242 | val loop : t -> unit |
243 | end = struct | |
a96702d3 SK |
244 | type cell = { data : Cell.t |
245 | ; rule : (module RULE) | |
246 | } | |
247 | ||
248 | type t = { grid : cell Matrix.t | |
d9fa5d46 SK |
249 | ; interval : Time.Span.t |
250 | ; bar : string | |
251 | } | |
aed335e3 | 252 | |
a96702d3 SK |
253 | let create ~rows:rs ~columns:ks ~interval ~rules = |
254 | let n = List.length rules in | |
255 | let i = Random.int n in | |
256 | let init () = | |
257 | let rule = List.nth_exn rules i in | |
258 | let module Rule = (val rule : RULE) in | |
259 | { rule | |
260 | ; data = Rule.create () | |
261 | } | |
262 | in | |
21c4909c | 263 | Terminal.clear (); |
a96702d3 | 264 | { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ()) |
d9fa5d46 SK |
265 | ; interval = Time.Span.of_float interval |
266 | ; bar = String.make ks '-' | |
267 | } | |
268 | ||
a96702d3 SK |
269 | let cell_to_string cell = |
270 | cell.data.Cell.pheno | |
271 | ||
d9fa5d46 | 272 | let print t = |
21c4909c | 273 | Terminal.reset (); |
d9fa5d46 | 274 | print_endline t.bar; |
a96702d3 | 275 | Matrix.print t.grid ~to_string:cell_to_string; |
d9fa5d46 SK |
276 | print_endline t.bar |
277 | ||
278 | let next t = | |
279 | let grid = | |
280 | Matrix.mapi t.grid ~f:( | |
a96702d3 SK |
281 | fun point {rule; data} -> |
282 | let module Rule = (val rule : RULE) in | |
d9fa5d46 | 283 | let neighbors = Matrix.get_neighbors t.grid point in |
a96702d3 SK |
284 | let data = |
285 | Rule.transition | |
286 | ~state:data.Cell.state | |
287 | ~inputs:(List.map neighbors ~f:(fun cell -> cell.data.Cell.msg)) | |
288 | in | |
289 | {rule; data} | |
d9fa5d46 SK |
290 | ) |
291 | in | |
292 | {t with grid} | |
293 | ||
294 | let rec loop t = | |
295 | print t; | |
296 | Time.pause t.interval; | |
297 | loop (next t) | |
298 | end | |
7707ff62 SK |
299 | |
300 | ||
301 | let main () = | |
302 | Random.self_init (); | |
d9fa5d46 | 303 | let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in |
a96702d3 SK |
304 | let interval = 0.1 in |
305 | let rules = | |
306 | [ (module Conway : RULE) | |
307 | ] | |
308 | in | |
8526e3e1 | 309 | Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules) |
8c93b722 SK |
310 | |
311 | ||
7d89c037 SK |
312 | let spec = |
313 | let summary = "Polymorphic Cellular Automata" in | |
7707ff62 | 314 | let spec = Command.Spec.empty in |
7d89c037 SK |
315 | Command.basic ~summary spec main |
316 | ||
317 | ||
318 | let () = Command.run spec |