diff --git a/Automaton.elm b/Automaton.elm new file mode 100644 index 0000000..0cad912 --- /dev/null +++ b/Automaton.elm @@ -0,0 +1,48 @@ +module Automaton exposing (..) + +import Random + +-- MODEL + +type alias Automaton s i = List ((s, i), s) + +zip : List a -> List b -> List (a, b) +zip = List.map2 (,) + +cart : List a -> List b -> List (a, b) +cart l1 l2 = List.concat <| List.map (\x -> List.map (\y -> (x, y)) l2) l1 + +genAut : Int -> Int -> Random.Generator (Automaton Int Int) +genAut n k = let + allSI = cart [1..n] [1..k] + in Random.map (zip allSI) (Random.list (n*k) <| Random.int 1 n) + +step : Automaton s i -> Maybe s -> i -> Maybe s +step ls s0 i = case s0 of + Nothing -> Nothing + Just s -> List.filter (\((t, j), b) -> t == s && i == j) ls |> List.head |> Maybe.map snd + +--(=>) = (,) + +--state2Color : State -> Color +--state2Color s = case s of +-- Nothing -> Color.black +-- Just n -> hsl (degrees (toFloat n)*77) 1.0 (0.8 - 0.6 * (toFloat n)/size) + +--color2String : Color -> String +--color2String c = let rgb = toRgb c in "rgb(" ++ toString rgb.red ++ ", " ++ toString rgb.green ++ ", " ++ toString rgb.blue ++ ")" + +--block : Color -> Html msg +--block c = div [style ["background-color" => color2String c, "width" => "100px", "height" => "100px", "display" => "inline-block"]] [] + +--view : Model -> Html Msg +--view model = +-- div [] +-- ( button [ onClick Regen ] [ text "Regenerate" ] +-- :: button [ onClick Sort ] [ text "Sort" ] +-- :: br [] [] +-- :: List.map (block << state2Color) model.states +-- ) + + + diff --git a/Grid.elm b/Grid.elm index 2d42ef2..4f76639 100644 --- a/Grid.elm +++ b/Grid.elm @@ -60,3 +60,11 @@ transpose grid = let nf = newFocus grid na = List.map newFocus <| RingList.iterate1N (List.length grid.focus.after) shiftLeft grid in RingList nb nf na + +getNeighbours : Grid a -> List a +getNeighbours grid = + [ grid |> shiftLeft |> extract + , grid |> shiftUp |> extract + , grid |> shiftRight |> extract + , grid |> shiftDown |> extract + ] diff --git a/Main.elm b/Main.elm index 3930ee0..5b1a03b 100644 --- a/Main.elm +++ b/Main.elm @@ -1,5 +1,6 @@ import Grid exposing (..) import RingList exposing (..) +import Automaton exposing (..) import Html exposing (..) import Html.Attributes exposing (..) @@ -18,50 +19,93 @@ main = , subscriptions = subscriptions } -width = 21 -height = 16 +width = 62 +height = 33 +states = 3 +inputs = 2 +outputs = 3 +visSize = "20px" +freq = 0.3 * second -- MODEL -type alias World = Grid (Int, Float) +type alias World = Grid (Maybe Int) +type alias AutomatonT = Automaton Int Int type alias Model = { grid : World - , history : List (Int, Float) + , system : AutomatonT + , neighbours : List (Maybe Int) } init : (Model, Cmd Msg) -init = (Model (Grid.generate width height (\x y -> (x, toFloat y))) [], Cmd.none) +init = + ( { grid = Grid.generate width height initCell + , system = [] + , neighbours = [] + }, Random.generate NewRandomAut (genAut states inputs) ) +initCell x y = case (x > 5, y > 5) of + (True, _) -> Just 1 + (_, True) -> Just 1 + _ -> Just (1 + (x + y * width) % states) + -- UPDATE type Msg = Update World + | NewRandomAut AutomatonT + | Regen + | BigStep + +output m = case m of + Nothing -> 1 + Just s -> 1 + s % outputs + +getNBOutputs grid = let + ret = grid |> Grid.getNeighbours |> List.map output |> List.sum + in 1 + ret % inputs -succ (n, m) = (n + 1, m * 2) +cellStep : AutomatonT -> World -> Maybe Int +cellStep aut grid = let + i = getNBOutputs grid + s = grid |> Grid.extract + t = Automaton.step aut s i + in t update : Msg -> Model -> (Model, Cmd Msg) update msg model = case msg of - Update grid -> (Model grid (Grid.extract grid :: model.history), Cmd.none) + 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 = Grid.extend (cellStep model.system) model.grid }, Cmd.none) -- SUBSCRIPTIONS subscriptions : Model -> Sub Msg -subscriptions model = Sub.none +subscriptions model = Time.every freq (\a -> BigStep) -- VIEW -butt : World -> Html Msg ---butt rl = button [ onClick (Update (RingList.edit succ rl)) ] [ RingList.extract rl |> toString |> text ] -butt grid = button [ onClick (Update (Grid.edit succ grid)) ] [ Grid.extract grid |> toString |> text ] +(=>) = (,) + +output2Color : Int -> Color +output2Color n = hsl (degrees (toFloat n)*77) 1.0 (0.8 - 0.6 * (toFloat n + 0.5)/outputs) + +color2String : Color -> String +color2String c = let rgb = toRgb c in "rgb(" ++ toString rgb.red ++ ", " ++ toString rgb.green ++ ", " ++ toString rgb.blue ++ ")" + +block aut grid = let + col = output2Color <| output <| Grid.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 -> Html Msg view model = let dupmodel = Grid.duplicate model.grid - butts = Grid.map butt dupmodel + butts = Grid.map (block model.system) dupmodel listm = Grid.toList butts - viewm = List.map (\row -> div [] (br [] [] :: row)) listm - in div [] <| viewm ++ [div [] [model.history |> toString |> text]] + viewm = List.map (\row -> div [style ["height" => visSize]] row) listm + in div [] <| viewm ++ [button [onClick BigStep] [text "big step"], button [onClick Regen] [text "regenerate"]]