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 | ||
63fe855d | 11 | val create : rs:int -> ks:int -> data:'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 | ||
7c363dd8 | 17 | val mapi : 'a t -> f:(Point.t -> data:'a -> 'b) -> 'b t |
4d49c95e | 18 | |
7c363dd8 | 19 | val iter : 'a t -> f:(Point.t -> data:'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 | ||
63fe855d SK |
59 | let create ~rs ~ks ~data = |
60 | Array.make_matrix ~dimx:rs ~dimy:ks data | |
4d49c95e SK |
61 | |
62 | let iter t ~f = | |
63 | Array.iteri t ~f:( | |
63fe855d SK |
64 | fun r ks -> |
65 | Array.iteri ks ~f:( | |
66 | fun k data -> | |
7c363dd8 | 67 | f {Point.r; Point.k} ~data |
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:( | |
85 | fun k data -> | |
7c363dd8 | 86 | f {Point.r; Point.k} ~data |
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 | ||
da8f1674 SK |
110 | module type CELL = sig |
111 | type t | |
112 | ||
b6599385 | 113 | val create : unit -> t |
0ce0e798 SK |
114 | |
115 | val to_string : t -> string | |
116 | ||
da8f1674 SK |
117 | val state : t -> int |
118 | ||
119 | val react : t -> states:int list -> t | |
120 | end | |
121 | ||
122 | ||
0d6f7833 SK |
123 | module Conway : CELL = struct |
124 | type t = D | A | |
125 | ||
0ce0e798 SK |
126 | let of_int = function |
127 | | 0 -> D | |
128 | | 1 -> A | |
129 | | _ -> assert false | |
130 | ||
131 | let to_int = function | |
0d6f7833 SK |
132 | | D -> 0 |
133 | | A -> 1 | |
134 | ||
0ce0e798 SK |
135 | let to_string = function |
136 | | D -> " " | |
137 | | A -> "o" | |
138 | ||
b6599385 | 139 | let create () = |
5c37daed | 140 | Random.int 2 |> of_int |
0ce0e798 SK |
141 | |
142 | let state = to_int | |
143 | ||
0d6f7833 SK |
144 | let react t ~states = |
145 | let live_neighbors = List.fold_left states ~init:0 ~f:(+) in | |
146 | match t with | |
147 | | A when live_neighbors < 2 -> D | |
148 | | A when live_neighbors < 4 -> A | |
149 | | A when live_neighbors > 3 -> D | |
150 | | D when live_neighbors = 3 -> A | |
b36c0aef SK |
151 | | A -> A |
152 | | D -> D | |
0d6f7833 SK |
153 | end |
154 | ||
155 | ||
aed335e3 SK |
156 | type opt = { interval : Time.Span.t |
157 | ; bar : string | |
158 | } | |
159 | ||
160 | ||
161 | let rec loop opt grid = | |
162 | print_endline opt.bar; | |
394125ca | 163 | Matrix.print grid ~to_string:Conway.to_string; |
aed335e3 SK |
164 | print_endline opt.bar; |
165 | ||
394125ca | 166 | let grid = |
7c363dd8 SK |
167 | Matrix.mapi grid ~f:(fun point ~data:cell -> |
168 | let neighbors = Matrix.get_neighbors grid point in | |
394125ca SK |
169 | Conway.react cell ~states:(List.map neighbors ~f:Conway.state) |
170 | ) | |
171 | in | |
aed335e3 SK |
172 | Time.pause opt.interval; |
173 | loop opt grid | |
7707ff62 SK |
174 | |
175 | ||
176 | let main () = | |
177 | Random.self_init (); | |
178 | let rs, ks = Or_error.ok_exn Linux_ext.get_terminal_size () in | |
179 | Matrix.create ~rs:(rs - 3) ~ks ~data:() | |
180 | |> Matrix.map ~f:Conway.create | |
aed335e3 SK |
181 | |> loop { interval = Time.Span.of_float 0.1 |
182 | ; bar = String.make ks '-' | |
183 | } | |
8c93b722 SK |
184 | |
185 | ||
7d89c037 SK |
186 | let spec = |
187 | let summary = "Polymorphic Cellular Automata" in | |
7707ff62 | 188 | let spec = Command.Spec.empty in |
7d89c037 SK |
189 | Command.basic ~summary spec main |
190 | ||
191 | ||
192 | let () = Command.run spec |