Organize transition mechanism into Automaton module

[cellular-automata.git] / polymorphic-life / 001 / src / polymorphic_life.ml

open Core.Std


module type MATRIX = sig
  module Point : sig
    type t = {r : int; k : int}
  end

  type 'a t

  val create : rs:int -> ks:int -> 'a -> 'a t

  val get_neighbors : 'a t -> Point.t -> 'a list

  val map : 'a t -> f:('a -> 'b) -> 'b t

  val mapi : 'a t -> f:(Point.t -> 'a -> 'b) -> 'b t

  val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit

  val print : 'a t -> to_string:('a -> string) -> unit
end

module Matrix : MATRIX = struct
  module Point = struct
    type t = {r : int; k : int}

    let (+) p p' =
      { r = p.r + p'.r
      ; k = p.k + p'.k
      }
  end

  module Direction = struct
    type t = NW | N | NE
           | W  |     E
           | SW | S | SE

    let all = [ NW ; N ; NE
              ; W  ;     E
              ; SW ; S ; SE
              ]

    let to_offset =
      let open Point in
      function
      | NW -> {r = -1; k = -1}
      | N  -> {r = -1; k =  0}
      | NE -> {r = -1; k =  1}
      | W  -> {r =  0; k = -1}
      | E  -> {r =  0; k =  1}
      | SW -> {r =  1; k = -1}
      | S  -> {r =  1; k =  0}
      | SE -> {r =  1; k =  1}
  end

  type 'a t = 'a array array

  let create ~rs ~ks x =
    Array.make_matrix ~dimx:rs ~dimy:ks x

  let iter t ~f =
    Array.iteri t ~f:(
      fun r ks ->
        Array.iteri ks ~f:(
          fun k x ->
            f {Point.r; Point.k} x
        )
    )

  let print t ~to_string =
    Array.iter t ~f:(
      fun r ->
        Array.iter r ~f:(fun x -> printf "%s" (to_string x));
        print_newline ()
    )

  let map t ~f =
    Array.map t ~f:(Array.map ~f:(fun x -> f x))

  let mapi t ~f =
    Array.mapi t ~f:(
      fun r ks ->
        Array.mapi ks ~f:(
          fun k x ->
            f {Point.r; Point.k} x
        )
    )

  let get t {Point.r; Point.k} =
    t.(r).(k)

  let is_within_bounds t {Point.r; Point.k} =
    match t with
    | [||] -> assert false
    | t ->
      r >= 0 && r < Array.length t &&
      k >= 0 && k < Array.length t.(0)

  let neighborhood t point =
    List.map Direction.all ~f:Direction.to_offset
    |> List.map ~f:(fun offset_point -> Point.(point + offset_point))
    |> List.filter ~f:(is_within_bounds t)

  let get_neighbors t point =
    List.map (neighborhood t point) ~f:(get t)
end


module type CELL = sig
  type t

  val create : unit -> t

  val to_string : t -> string

  val state : t -> int

  val react : t -> states:int list -> t
end


module Conway : CELL = struct
  type t = D | A

  let of_int = function
    | 0 -> D
    | 1 -> A
    | _ -> assert false

  let to_int = function
    | D -> 0
    | A -> 1

  let to_string = function
    | D -> " "
    | A -> "o"

  let create () =
    Random.int 2 |> of_int

  let state = to_int

  let react t ~states =
    let live_neighbors = List.fold_left states ~init:0 ~f:(+) in
    match t with
    | A when live_neighbors < 2 -> D
    | A when live_neighbors < 4 -> A
    | A when live_neighbors > 3 -> D
    | D when live_neighbors = 3 -> A
    | A -> A
    | D -> D
end


module Automaton : sig
  type t

  val create : rows:int -> columns:int -> interval:float -> t

  val loop : t -> unit
end = struct
  type t = { grid     : Conway.t Matrix.t
           ; interval : Time.Span.t
           ; bar      : string
           }

  let create ~rows:rs ~columns:ks ~interval =
    { grid     = Matrix.map ~f:Conway.create (Matrix.create ~rs ~ks ())
    ; interval = Time.Span.of_float interval
    ; bar      = String.make ks '-'
    }

  let print t =
    print_endline t.bar;
    Matrix.print t.grid ~to_string:Conway.to_string;
    print_endline t.bar

  let next t =
    let grid =
      Matrix.mapi t.grid ~f:(
        fun point cell ->
          let neighbors = Matrix.get_neighbors t.grid point in
          Conway.react cell ~states:(List.map neighbors ~f:Conway.state)
      )
    in
    {t with grid}

  let rec loop t =
    print t;
    Time.pause t.interval;
    loop (next t)
end


let main () =
  Random.self_init ();
  let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
  Automaton.create ~rows:(rows - 3) ~columns ~interval:0.1 |> Automaton.loop


let spec =
  let summary = "Polymorphic Cellular Automata" in
  let spec = Command.Spec.empty in
  Command.basic ~summary spec main


let () = Command.run spec