X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=polymorphism%2F001%2Fsrc%2Fpolymorphism.ml;h=c2f0c3e5caff035ad83cfa1c95ba8e997cffd212;hb=46aacfbc9482c1b72d6c69d6b6e323a2ea33719f;hp=cb9d6a4182dc11d5383b43ce172f86c585e84865;hpb=8bad36d8b76baf7c2202f03a09e7a1ad24d071e0;p=cellular-automata.git diff --git a/polymorphism/001/src/polymorphism.ml b/polymorphism/001/src/polymorphism.ml index cb9d6a4..c2f0c3e 100644 --- a/polymorphism/001/src/polymorphism.ml +++ b/polymorphism/001/src/polymorphism.ml @@ -51,7 +51,7 @@ sig type 'a t - val create : rs:int -> ks:int -> 'a -> 'a t + val make : rs:int -> ks:int -> 'a -> 'a t val get_neighbors : 'a t -> Point.t -> 'a list @@ -100,7 +100,7 @@ struct type 'a t = 'a array array - let create ~rs ~ks x = + let make ~rs ~ks x = Array.make_matrix ~dimx:rs ~dimy:ks x let iter t ~f = @@ -143,7 +143,7 @@ struct let neighborhood t point = List.map Direction.all ~f:Direction.to_offset - |> List.map ~f:(fun offset_point -> Point.(point + offset_point)) + |> List.map ~f:(Point.(+) point) |> List.filter ~f:(is_within_bounds t) let get_neighbors t point = @@ -155,7 +155,7 @@ module PhenoType : sig type t - val create : char -> Terminal.color option -> t + val make : char -> Terminal.color option -> t val to_string : t -> string end = @@ -164,7 +164,7 @@ struct ; character : char } - let create character color = + let make character color = {color; character} let to_string = function @@ -195,7 +195,7 @@ end module type RULE = sig - val create : unit -> Cell.t + val init : unit -> Cell.t val transition : self:Cell.State.t -> neighbors:Cell.State.t list @@ -209,29 +209,32 @@ struct sig type t = D | A - val of_int : int -> t + val random : unit -> t - val to_int : t -> int + val is_alive : t -> bool val to_cell : t -> Cell.t val of_cell_state : Cell.State.t -> t + + val next : t -> live_neighbors:int -> t end = struct type t = D | A - let of_int = function + let random () = + match Random.int 2 with | 0 -> D | 1 -> A | _ -> assert false - let to_int = function - | D -> 0 - | A -> 1 + let is_alive = function + | D -> false + | A -> true let to_pheno = function - | D -> PhenoType.create ' ' None - | A -> PhenoType.create 'o' (Some `white) + | D -> PhenoType.make ' ' None + | A -> PhenoType.make 'o' (Some `white) let of_cell_state = function | Cell.State.Dead -> D @@ -247,27 +250,28 @@ struct { Cell.state = t |> to_cell_state ; Cell.pheno = t |> to_pheno } - end - let next state ~live_neighbors = - match state with - | State.A when live_neighbors < 2 -> State.D - | State.A when live_neighbors < 4 -> State.A - | State.A when live_neighbors > 3 -> State.D - | State.D when live_neighbors = 3 -> State.A - | State.A -> State.A - | State.D -> State.D + let next t ~live_neighbors = + 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 - let create () = - Random.int 2 |> State.of_int |> State.to_cell + let init = + State.random |- State.to_cell - let live_neighbors neighbors = - neighbors |> List.map ~f:(State.of_cell_state |- State.to_int) - |> List.fold_left ~init:0 ~f:(+) + let count_of_live = + List.map ~f:State.of_cell_state + |- List.filter ~f:State.is_alive + |- List.length let transition ~self ~neighbors = self |> State.of_cell_state - |> next ~live_neighbors:(live_neighbors neighbors) + |> State.next ~live_neighbors:(count_of_live neighbors) |> State.to_cell end @@ -280,13 +284,13 @@ struct val is_burning : t -> bool - val of_int : int -> t - - val to_int : t -> int + val random : unit -> t val to_cell : t -> Cell.t val of_cell_state : Cell.State.t -> t + + val next : t -> burning_neighbors:int -> t end = struct type t = E | T | B @@ -296,21 +300,17 @@ struct | T -> false | B -> true - let of_int = function + let random () = + match Random.int 3 with | 0 -> E | 1 -> T | 2 -> B | _ -> assert false - let to_int = function - | E -> 0 - | T -> 1 - | B -> 2 - let to_pheno = function - | E -> PhenoType.create ' ' None - | T -> PhenoType.create 'T' (Some `green) - | B -> PhenoType.create '#' (Some `red) + | E -> PhenoType.make ' ' None + | T -> PhenoType.make 'T' (Some `green) + | B -> PhenoType.make '#' (Some `red) let of_cell_state = function | Cell.State.Dead -> E @@ -327,35 +327,34 @@ struct { Cell.state = t |> to_cell_state ; Cell.pheno = t |> to_pheno } - end - let create () = - Random.int 3 |> State.of_int |> State.to_cell + let f = 0.000001 (* Probability of spontaneous ignition *) + let p = 0.1 (* Probability of spontaneous growth *) - let f = 0.000001 (* Probability of spontaneous ignition *) - let p = 0.1 (* Probability of spontaneous growth *) + let is_probable p = + (Random.float 1.0) <= p - let is_probable p = - (Random.float 1.0) <= p + let next t ~burning_neighbors = + match t, burning_neighbors with + | E, _ when is_probable p -> T + | E, _ -> E + | T, 0 when is_probable f -> B + | T, _ when burning_neighbors > 0 -> B + | T, _ -> T + | B, _ -> E + end - let next state ~burning_neighbors = - match state, burning_neighbors with - | State.E, _ when is_probable p -> State.T - | State.E, _ -> State.E - | State.T, 0 when is_probable f -> State.B - | State.T, _ when burning_neighbors > 0 -> State.B - | State.T, _ -> State.T - | State.B, _ -> State.E + let init = + State.random |- State.to_cell - let burning_neighbors neighbors = - neighbors |> List.map ~f:State.of_cell_state - |> List.filter ~f:State.is_burning - |> List.map ~f:State.to_int - |> List.fold_left ~init:0 ~f:(+) + let count_of_burning = + List.map ~f:State.of_cell_state + |- List.filter ~f:State.is_burning + |- List.length let transition ~self ~neighbors = self |> State.of_cell_state - |> next ~burning_neighbors:(burning_neighbors neighbors) + |> State.next ~burning_neighbors:(count_of_burning neighbors) |> State.to_cell end @@ -364,7 +363,7 @@ module Automaton : sig type t - val create : rows:int + val make : rows:int -> columns:int -> interval:float -> rules: (module RULE) list @@ -382,17 +381,17 @@ struct ; bar : string } - let create ~rows:rs ~columns:ks ~interval ~rules = + let make ~rows:rs ~columns:ks ~interval ~rules = let n = List.length rules in let init () = let rule = List.nth_exn rules (Random.int n) in let module Rule = (val rule : RULE) in { rule - ; data = Rule.create () + ; data = Rule.init () } in Terminal.clear (); - { grid = Matrix.map ~f:init (Matrix.create ~rs ~ks ()) + { grid = Matrix.map ~f:init (Matrix.make ~rs ~ks ()) ; interval = Time.Span.of_float interval ; bar = String.make ks '-' } @@ -437,7 +436,7 @@ let main interval () = ; (module ForestFire : RULE) ] in - Automaton.loop (Automaton.create ~rows:(rows - 3) ~columns ~interval ~rules) + Automaton.loop (Automaton.make ~rows:(rows - 3) ~columns ~interval ~rules) let spec =