Cellular automata in Elm
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

140 lines
3.6 KiB

import Automaton exposing (..)
import Grid exposing (..)
import Lazy.Zipper
import Color exposing (Color)
import Dict exposing (Dict)
import Html exposing (..)
import Html.App as App
import Html.Attributes exposing (style)
import Html.Events exposing (onClick)
import Random
import Time
main =
App.program
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
width = 34
height = 31
states = 10
inputs = 3
outputs = 3
visSize = "20px"
freq = 0.3 * Time.second
-- MODEL
type alias World = Grid (Maybe Int)
type alias AutomatonT = Automaton Int Int
type alias Model =
{ grid : World
, system : AutomatonT
, neighbours : List (Maybe Int)
}
init : (Model, Cmd Msg)
init =
( { grid = generate width height initCell
, system = []
, neighbours = []
}, Random.generate NewRandomAut (genAut states inputs) )
initCell x y = case (x, y) of
(18, 16) -> Just 3
(17, 16) -> Just 1
_ -> Just 2
-- UPDATE
type Msg
= Update World
| NewRandomAut AutomatonT
| Regen
| Init
| BigStep
output m = case m of
Nothing -> 1
Just s -> 1 + s % outputs
counts : List Int -> Dict Int Int
counts ls = let
succ n = case n of
Just m -> Just (m + 1)
Nothing -> Just 1
in List.foldr (\x m -> Dict.update x succ m) Dict.empty ls
uniqSingleton : List Int -> Maybe Int
uniqSingleton ls = let cs = counts ls
in case Dict.toList cs of
[(n, 1), (m, 3)] -> Just n
[(n, 3), (m, 1)] -> Just m
[(1, 2), (2, 2)] -> Just 3
[(1, 2), (3, 2)] -> Just 2
[(2, 2), (3, 2)] -> Just 1
_ -> Nothing
getNBOutputs : World -> Maybe Int
getNBOutputs grid = grid
|> getNeighbours
|> List.filterMap identity
|> uniqSingleton
--|> List.map output
--|> List.map2 (\x y -> x * y) [2,2,1,0]
--|> List.sum
--|> \x -> 1 + x % inputs
step2 : AutomatonT -> Maybe Int -> Maybe Int -> Maybe Int
step2 aut s i = case i of
Nothing -> s
Just i2 -> Automaton.step aut s i2
cellStep : AutomatonT -> World -> Maybe Int
cellStep aut grid = let
i = getNBOutputs grid
s = extract grid
t = step2 aut s i
in t
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
case msg of
Update grid -> ({ model | grid = grid }, Cmd.none)
NewRandomAut aut -> ({ model | system = aut }, Cmd.none)
Regen -> (model, Random.generate NewRandomAut (genAut states inputs))
BigStep -> ({ model | grid = model.grid =>> cellStep model.system }, Cmd.none)
Init -> ({ model | grid = generate width height initCell }, Cmd.none)
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model = Time.every freq (\a -> BigStep)
-- VIEW
(=>) = (,)
output2Color : Int -> Color
output2Color n = Color.hsl (degrees (toFloat n)*77) 1.0 (0.8 - 0.6 * (toFloat n + 0.5)/outputs)
color2String : Color -> String
color2String c = let rgb = Color.toRgb c in "rgb(" ++ toString rgb.red ++ ", " ++ toString rgb.green ++ ", " ++ toString rgb.blue ++ ")"
block aut grid = let
col = output2Color <| output <| extract grid
but = text "" -- button [ onClick (Update (Grid.edit (\_ -> cellStep aut grid) grid)) ] [ text "." ]
in div [style ["background-color" => color2String col, "width" => visSize, "height" => visSize, "display" => "inline-block"]] [ but ]
view model = let
butts = model.grid =>> block model.system
listm = Grid.toList butts
viewm = List.map (\row -> div [style ["height" => visSize]] row) listm
in div [] <| viewm ++ [button [onClick BigStep] [text "big step"], button [onClick Regen] [text "regenerate"], button [onClick Init] [text "restart"]]