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:('a -> 'b) -> 'b t
  14
  15   val mapi : 'a t -> f:(row:int -> col:int -> data:'a -> 'b) -> 'b t
  16
  17   val iter : 'a t -> f:(row:int -> col:int -> data:'a -> unit) -> unit
  18
  19   val print : 'a t -> to_string:('a -> string) -> unit
  20 end
  21
  22 module Matrix : MATRIX = struct
  23   type 'a t = 'a array array
  24
  25   let create ~rows ~cols ~data =
  26     Array.make_matrix ~dimx:rows ~dimy:cols data
  27
  28   let iter t ~f =
  29     Array.iteri t ~f:(
  30       fun row cols ->
  31         Array.iteri cols ~f:(
  32           fun col data ->
  33             f ~row ~col ~data
  34         )
  35     )
  36
  37   let print t ~to_string =
  38     Array.iter t ~f:(
  39       fun row ->
  40         Array.iter row ~f:(fun x -> printf "%s" (to_string x));
  41         print_newline ()
  42     )
  43
  44   let map t ~f =
  45     Array.map t ~f:(Array.map ~f:(fun x -> f x))
  46
  47   let mapi t ~f =
  48     Array.mapi t ~f:(
  49       fun row cols ->
  50         Array.mapi cols ~f:(
  51           fun col data ->
  52             f ~row ~col ~data
  53         )
  54     )
  55
  56   let get t ~row ~col =
  57     t.(row).(col)
  58
  59   let set t ~row ~col ~data =
  60     t.(row).(col) <- data
  61 end
  62
  63
  64 module type CELL = sig
  65   type t
  66
  67   val init : unit -> t
  68
  69   val to_string : t -> string
  70
  71   val state : t -> int
  72
  73   val react : t -> states:int list -> t
  74 end
  75
  76
  77 module Conway : CELL = struct
  78   type t = D | A
  79
  80   let of_int = function
  81     | 0 -> D
  82     | 1 -> A
  83     | _ -> assert false
  84
  85   let to_int = function
  86     | D -> 0
  87     | A -> 1
  88
  89   let to_string = function
  90     | D -> " "
  91     | A -> "o"
  92
  93   let init () =
  94     Random.int 2 |> of_int
  95
  96   let state = to_int
  97
  98   let react t ~states =
  99     let live_neighbors = List.fold_left states ~init:0 ~f:(+) in
 100     match t with
 101     | A when live_neighbors < 2 -> D
 102     | A when live_neighbors < 4 -> A
 103     | A when live_neighbors > 3 -> D
 104     | D when live_neighbors = 3 -> A
 105     | A -> A
 106     | D -> D
 107 end
 108
 109
 110 let main rows cols () =
 111   Random.self_init ();
 112   let grid = Matrix.create ~rows ~cols ~data:() |> Matrix.map ~f:Conway.init in
 113   Matrix.print grid ~to_string:Conway.to_string
 114
 115
 116 let spec =
 117   let summary = "Polymorphic Cellular Automata" in
 118   let spec =
 119     let open Command.Spec in
 120     empty
 121     +> flag "-rows" (optional_with_default 5 int) ~doc:"Height"
 122     +> flag "-cols" (optional_with_default 5 int) ~doc:"Width"
 123   in
 124   Command.basic ~summary spec main
 125
 126
 127 let () = Command.run spec