+++ /dev/null
-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 Msg = struct
- type t = string
-end
-
-
-module State = struct
- type t = string
-end
-
-
-module PhenoType = struct
- type t = string
-end
-
-
-module Cell = struct
- type t = { msg : Msg.t
- ; pheno : PhenoType.t
- ; state : State.t
- }
-end
-
-
-module type RULE = sig
- val create : unit -> Cell.t
-
- val transition : state:State.t -> inputs:Msg.t list -> Cell.t
-end
-
-
-module Conway : RULE = struct
- type state = D | A
-
- let state_of_string : (string -> state) = function
- | "D" -> D
- | "A" -> A
- | _ -> assert false
-
- let state_of_int : (int -> state) = function
- | 0 -> D
- | 1 -> A
- | _ -> assert false
-
- let int_of_state : (state -> int) = function
- | D -> 0
- | A -> 1
-
- let string_of_state : (state -> string) = function
- | D -> "D"
- | A -> "A"
-
- let msg_of_state : (state -> Msg.t) =
- string_of_state
-
- let pheno_of_state : (state -> PhenoType.t) = function
- | D -> " "
- | A -> "o"
-
- let int_of_msg msg =
- msg |> state_of_string |> int_of_state
-
- let next state ~live_neighbors =
- match state 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
-
- let cell_of_state s =
- { Cell.msg = s |> msg_of_state
- ; Cell.pheno = s |> pheno_of_state
- ; Cell.state = s |> string_of_state
- }
-
- let create () =
- Random.int 2 |> state_of_int |> cell_of_state
-
- let live_neighbors inputs =
- inputs |> List.map ~f:int_of_msg |> List.fold_left ~init:0 ~f:(+)
-
- let transition ~state ~inputs =
- state
- |> state_of_string
- |> next ~live_neighbors:(live_neighbors inputs)
- |> cell_of_state
-end
-
-
-module Automaton : sig
- type t
-
- val create : rows:int
- -> columns:int
- -> interval:float
- -> rules: (module RULE) list
- -> t
-
- val loop : t -> unit
-end = struct
- type cell = { data : Cell.t
- ; rule : (module RULE)
- }
-
- type t = { grid : cell Matrix.t
- ; interval : Time.Span.t
- ; bar : string
- }
-
- let create ~rows:rs ~columns:ks ~interval ~rules =
- let n = List.length rules in
- let i = Random.int n in
- let init () =
- let rule = List.nth_exn rules i in
- let module Rule = (val rule : RULE) in
- { rule
- ; data = Rule.create ()
- }
- in
- { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ())
- ; interval = Time.Span.of_float interval
- ; bar = String.make ks '-'
- }
-
- let cell_to_string cell =
- cell.data.Cell.pheno
-
- let print t =
- print_endline t.bar;
- Matrix.print t.grid ~to_string:cell_to_string;
- print_endline t.bar
-
- let next t =
- let grid =
- Matrix.mapi t.grid ~f:(
- fun point {rule; data} ->
- let module Rule = (val rule : RULE) in
- let neighbors = Matrix.get_neighbors t.grid point in
- let data =
- Rule.transition
- ~state:data.Cell.state
- ~inputs:(List.map neighbors ~f:(fun cell -> cell.data.Cell.msg))
- in
- {rule; data}
- )
- 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
- let interval = 0.1 in
- let rules =
- [ (module Conway : RULE)
- ]
- in
- Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules |> 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
home / code / cellular-automata.git / blobdiff