X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=polymorphic-life%2F001%2Fsrc%2Fpolymorphic_life.ml;fp=polymorphic-life%2F001%2Fsrc%2Fpolymorphic_life.ml;h=0000000000000000000000000000000000000000;hb=be61d5b0325bf4e8346159d94d13d0d1866115e9;hp=1c47e0b6654e5d80052f4ae994a180817fc8b67a;hpb=a96702d3b6357a8df2eb04b754215df29cfd6ce2;p=cellular-automata.git diff --git a/polymorphic-life/001/src/polymorphic_life.ml b/polymorphic-life/001/src/polymorphic_life.ml deleted file mode 100644 index 1c47e0b..0000000 --- a/polymorphic-life/001/src/polymorphic_life.ml +++ /dev/null @@ -1,283 +0,0 @@ -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