Monde infini *relativement* efficace

diff --git a/automata/automata.ml b/automata/automata.ml
index 8aac1c6921aa7e33cedb73723fa6387322fb0aba..95924448706efcc2ce2e5d10dbaed18ba5652669 100644 (file)
--- a/automata/automata.ml
+++ b/automata/automata.ml
@@ -39,29 +39,87 @@ module type Automaton = sig
   val color : t -> char * char * char
 end
 
-(* TODO: infinite board *)
-type 't board = 't * 't array array
+module Coord = struct
+  type t = int * int
 
-let initial (type t) (m : (module Automaton with type t = t)) =
-        let module M = (val m) in
-        (M.default, Array.make_matrix 64 64 M.default)
+  let compare = compare
+end
+
+module CoordMap = Map.Make (Coord)
+
+(* TODO: absurdly-sized neighbourhoods *)
+let chunk_size = 64
 
-let get x y (d, board) = if x < 0 || 63 < x || y < 0 || 63 < y then d else board.(x).(y)
+let euclid_div n d =
+        let q = n / d
+        and r = n mod d in
+        if r < 0 then (q - 1, r + d) else (q, r)
 
-let set x y c ((d, cells) as board) =
-        if x < 0 || 63 < x || y < 0 || 63 < y
-        then board
-        else
-          let res = Array.init 64 (fun x -> Array.init 64 (fun y -> cells.(x).(y))) in
-          res.(x).(y) <- c;
-          (d, res)
+type 't board = 't * 't array array CoordMap.t
+
+let initial (type t) (m : (module Automaton with type t = t)) =
+        let module M = (val m) in
+        (M.default, CoordMap.empty)
+
+let get x y (d, board) =
+        let cx, ix = euclid_div x chunk_size
+        and cy, iy = euclid_div y chunk_size in
+        match CoordMap.find_opt (cx, cy) board with
+        | Some cs -> cs.(ix).(iy)
+        | None -> d
+
+let set x y c (d, cells) =
+        let cx, ix = euclid_div x chunk_size
+        and cy, iy = euclid_div y chunk_size in
+        ( d,
+          CoordMap.update (cx, cy)
+            (function
+              | Some cs ->
+                      let cs = Array.map Array.copy cs in
+                      cs.(ix).(iy) <- c;
+                      Some cs
+              | None ->
+                      Some
+                        (Array.init chunk_size (fun x ->
+                             Array.init chunk_size (fun y -> if x = ix && y = iy then c else d))))
+            cells )
+
+let neighbour_chunks (x, y) =
+        [
+          (x - 1, y - 1);
+          (x - 1, y + 0);
+          (x - 1, y + 1);
+          (x + 0, y - 1);
+          (x + 0, y + 0);
+          (x + 0, y + 1);
+          (x + 1, y - 1);
+          (x + 1, y + 0);
+          (x + 1, y + 1);
+        ]
 
-let update (type t) (m : (module Automaton with type t = t)) board =
+let update (type t) (m : (module Automaton with type t = t)) (d, board) =
+        let ccoords =
+                board
+                |> CoordMap.bindings
+                |> List.map fst
+                |> List.map neighbour_chunks
+                |> List.concat
+                |> List.sort_uniq compare
+        in
         let module M = (val m) in
-        ( M.transition (M.map (Fun.const (fst board)) M.neighbours),
-          Array.init 64 (fun x ->
-              Array.init 64 (fun y -> M.transition (M.map (fun (dx, dy) -> get (x + dx) (y + dy) board) M.neighbours)))
-        )
+        ( M.transition (M.map (Fun.const d) M.neighbours),
+          List.fold_left
+            (fun b (cx, cy) ->
+              CoordMap.add (cx, cy)
+                (Array.init chunk_size (fun x ->
+                     Array.init chunk_size (fun y ->
+                         M.transition
+                           (M.map
+                              (fun (dx, dy) -> get ((cx * chunk_size) + x + dx) ((cy * chunk_size) + y + dy) (d, board))
+                              M.neighbours))))
+                b)
+            CoordMap.empty ccoords
+          |> CoordMap.filter (fun _ -> Array.exists (Array.exists (fun c -> c <> d))) )
 
 let automata =
         [