polymorphic-life/001/src/polymorphic_life.ml

   1 open Core.Std
   2
   3
   4 module type MATRIX = sig
   5   type 'a t
   6
   7   val create : rows:int -> cols:int -> data:'a -> 'a t
   8
   9   val get : 'a t -> row:int -> col:int -> 'a
  10
  11   val set : 'a t -> row:int -> col:int -> data:'a -> unit
  12
  13   val map : 'a t -> f:(row:int -> col:int -> data:'a -> 'b) -> 'b t
  14
  15   val iter : 'a t -> f:(row:int -> col:int -> data:'a -> unit) -> unit
  16 end
  17
  18 module Matrix : MATRIX = struct
  19   type 'a t = 'a array array
  20
  21   let create ~rows ~cols ~data =
  22     Array.make_matrix ~dimx:rows ~dimy:cols data
  23
  24   let iter t ~f =
  25     Array.iteri t ~f:(
  26       fun row cols ->
  27         Array.iteri cols ~f:(
  28           fun col data ->
  29             f ~row ~col ~data
  30         )
  31     )
  32
  33   let map t ~f =
  34     Array.mapi t ~f:(
  35       fun row cols ->
  36         Array.mapi cols ~f:(
  37           fun col data ->
  38             f ~row ~col ~data
  39         )
  40     )
  41
  42   let get t ~row ~col =
  43     t.(row).(col)
  44
  45   let set t ~row ~col ~data =
  46     t.(row).(col) <- data
  47 end
  48
  49
  50 module type CELL = sig
  51   type t
  52
  53   val state : t -> int
  54
  55   val react : t -> states:int list -> t
  56 end
  57
  58
  59 module Conway : CELL = struct
  60   type t = D | A
  61
  62   let state = function
  63     | D -> 0
  64     | A -> 1
  65
  66   let react t ~states =
  67     let live_neighbors = List.fold_left states ~init:0 ~f:(+) in
  68     match t with
  69     | A when live_neighbors < 2 -> D
  70     | A when live_neighbors < 4 -> A
  71     | A when live_neighbors > 3 -> D
  72     | D when live_neighbors = 3 -> A
  73     | t -> t
  74 end
  75
  76
  77 let main rows cols () =
  78   let pool = Matrix.create ~rows ~cols ~data:() in
  79   Matrix.iter pool ~f:(
  80     fun ~row ~col ~data:() -> printf "R: %d, K: %d\n" row col
  81   )
  82
  83
  84 let spec =
  85   let summary = "Polymorphic Cellular Automata" in
  86   let spec =
  87     let open Command.Spec in
  88     empty
  89     +> flag "-rows" (optional_with_default 5 int) ~doc:"Height"
  90     +> flag "-cols" (optional_with_default 5 int) ~doc:"Width"
  91   in
  92   Command.basic ~summary spec main
  93
  94
  95 let () = Command.run spec