Commit | Line | Data |
---|---|---|
8c93b722 SK |
1 | open Core.Std |
2 | ||
3 | ||
4d49c95e SK |
4 | module type MATRIX = sig |
5 | type 'a t | |
6 | ||
63fe855d | 7 | val create : rs:int -> ks:int -> data:'a -> 'a t |
4d49c95e | 8 | |
394125ca | 9 | val get_neighbors : 'a t -> r:int -> k:int -> 'a list |
4d49c95e | 10 | |
65dbef41 SK |
11 | val map : 'a t -> f:('a -> 'b) -> 'b t |
12 | ||
63fe855d | 13 | val mapi : 'a t -> f:(r:int -> k:int -> data:'a -> 'b) -> 'b t |
4d49c95e | 14 | |
63fe855d | 15 | val iter : 'a t -> f:(r:int -> k:int -> data:'a -> unit) -> unit |
0ce0e798 SK |
16 | |
17 | val print : 'a t -> to_string:('a -> string) -> unit | |
4d49c95e SK |
18 | end |
19 | ||
20 | module Matrix : MATRIX = struct | |
394125ca SK |
21 | module Direction = struct |
22 | type t = NW | N | NE | |
23 | | W | E | |
24 | | SW | S | SE | |
25 | ||
26 | let all = [ NW ; N ; NE | |
27 | ; W ; E | |
28 | ; SW ; S ; SE | |
29 | ] | |
30 | ||
31 | let to_offset = function | |
32 | (*| D -> r, k *) | |
33 | | NW -> -1, -1 | |
34 | | N -> -1, 0 | |
35 | | NE -> -1, 1 | |
36 | | W -> 0, -1 | |
37 | | E -> 0, 1 | |
38 | | SW -> 1, -1 | |
39 | | S -> 1, 0 | |
40 | | SE -> 1, 1 | |
41 | end | |
42 | ||
4d49c95e SK |
43 | type 'a t = 'a array array |
44 | ||
63fe855d SK |
45 | let create ~rs ~ks ~data = |
46 | Array.make_matrix ~dimx:rs ~dimy:ks data | |
4d49c95e SK |
47 | |
48 | let iter t ~f = | |
49 | Array.iteri t ~f:( | |
63fe855d SK |
50 | fun r ks -> |
51 | Array.iteri ks ~f:( | |
52 | fun k data -> | |
53 | f ~r ~k ~data | |
4d49c95e SK |
54 | ) |
55 | ) | |
56 | ||
0ce0e798 SK |
57 | let print t ~to_string = |
58 | Array.iter t ~f:( | |
63fe855d SK |
59 | fun r -> |
60 | Array.iter r ~f:(fun x -> printf "%s" (to_string x)); | |
0ce0e798 SK |
61 | print_newline () |
62 | ) | |
63 | ||
4d49c95e | 64 | let map t ~f = |
65dbef41 SK |
65 | Array.map t ~f:(Array.map ~f:(fun x -> f x)) |
66 | ||
67 | let mapi t ~f = | |
4d49c95e | 68 | Array.mapi t ~f:( |
63fe855d SK |
69 | fun r ks -> |
70 | Array.mapi ks ~f:( | |
71 | fun k data -> | |
72 | f ~r ~k ~data | |
4d49c95e SK |
73 | ) |
74 | ) | |
75 | ||
63fe855d SK |
76 | let get t ~r ~k = |
77 | t.(r).(k) | |
394125ca SK |
78 | |
79 | let is_within_bounds t ~r ~k = | |
80 | match t with | |
81 | | [||] -> assert false | |
82 | | t -> | |
83 | r >= 0 && r < Array.length t && | |
84 | k >= 0 && k < Array.length t.(0) | |
85 | ||
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) | |
90 | ||
91 | let get_neighbors t ~r ~k = | |
92 | List.map (neighborhood t ~r ~k) ~f:(fun (r, k) -> get t ~r ~k) | |
4d49c95e SK |
93 | end |
94 | ||
95 | ||
da8f1674 SK |
96 | module type CELL = sig |
97 | type t | |
98 | ||
b6599385 | 99 | val create : unit -> t |
0ce0e798 SK |
100 | |
101 | val to_string : t -> string | |
102 | ||
da8f1674 SK |
103 | val state : t -> int |
104 | ||
105 | val react : t -> states:int list -> t | |
106 | end | |
107 | ||
108 | ||
0d6f7833 SK |
109 | module Conway : CELL = struct |
110 | type t = D | A | |
111 | ||
0ce0e798 SK |
112 | let of_int = function |
113 | | 0 -> D | |
114 | | 1 -> A | |
115 | | _ -> assert false | |
116 | ||
117 | let to_int = function | |
0d6f7833 SK |
118 | | D -> 0 |
119 | | A -> 1 | |
120 | ||
0ce0e798 SK |
121 | let to_string = function |
122 | | D -> " " | |
123 | | A -> "o" | |
124 | ||
b6599385 | 125 | let create () = |
5c37daed | 126 | Random.int 2 |> of_int |
0ce0e798 SK |
127 | |
128 | let state = to_int | |
129 | ||
0d6f7833 SK |
130 | let react t ~states = |
131 | let live_neighbors = List.fold_left states ~init:0 ~f:(+) in | |
132 | match t with | |
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 | |
b36c0aef SK |
137 | | A -> A |
138 | | D -> D | |
0d6f7833 SK |
139 | end |
140 | ||
141 | ||
63fe855d | 142 | let main rs ks () = |
0ce0e798 | 143 | Random.self_init (); |
63fe855d | 144 | let grid = Matrix.create ~rs ~ks ~data:() |> Matrix.map ~f:Conway.create in |
394125ca SK |
145 | Matrix.print grid ~to_string:Conway.to_string; |
146 | print_endline (String.make 80 '-'); | |
147 | let grid = | |
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) | |
151 | ) | |
152 | in | |
0ce0e798 | 153 | Matrix.print grid ~to_string:Conway.to_string |
8c93b722 SK |
154 | |
155 | ||
7d89c037 SK |
156 | let spec = |
157 | let summary = "Polymorphic Cellular Automata" in | |
158 | let spec = | |
159 | let open Command.Spec in | |
160 | empty | |
161 | +> flag "-rows" (optional_with_default 5 int) ~doc:"Height" | |
162 | +> flag "-cols" (optional_with_default 5 int) ~doc:"Width" | |
163 | in | |
164 | Command.basic ~summary spec main | |
165 | ||
166 | ||
167 | let () = Command.run spec |