From f55606761961391d0e57b7ad4fb1af3aef419fbf Mon Sep 17 00:00:00 2001 From: Dimitri Belopopsky Date: Tue, 2 Nov 2021 21:03:46 +0100 Subject: [PATCH 1/3] Add devcontainer setup for Elm --- .devcontainer/Dockerfile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile index aec4ab153..11514b88b 100644 --- a/.devcontainer/Dockerfile +++ b/.devcontainer/Dockerfile @@ -92,7 +92,9 @@ ENV PATH=$PATH:~/swift/usr/bin # Setup V ## https://github.com/vlang/v/blob/master/doc/docs.md - +RUN mkdir -p ~/elm && curl -L -o ~/elm/elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz && \ + gunzip ~/elm/elm.gz && chmod +x ~/elm/elm +ENV PATH=$PATH:~/elm # Install the packages that needed extra help RUN apt-get update && export DEBIAN_FRONTEND=noninteractive \ From c3b63c06cec0a02dc4f0954d7e62e5a775e8f6b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Gillet?= Date: Thu, 4 Nov 2021 23:57:14 +0900 Subject: [PATCH 2/3] Update to Elm 0.19.1 --- .../code/elm/elm-package.json | 20 - .../forward_euler_method/code/elm/elm.json | 28 ++ .../forward_euler_method/code/elm/euler.elm | 332 --------------- .../code/elm/src/Euler.elm | 386 ++++++++++++++++++ .../forward_euler_method.md | 6 +- 5 files changed, 417 insertions(+), 355 deletions(-) delete mode 100644 contents/forward_euler_method/code/elm/elm-package.json create mode 100644 contents/forward_euler_method/code/elm/elm.json delete mode 100644 contents/forward_euler_method/code/elm/euler.elm create mode 100644 contents/forward_euler_method/code/elm/src/Euler.elm diff --git a/contents/forward_euler_method/code/elm/elm-package.json b/contents/forward_euler_method/code/elm/elm-package.json deleted file mode 100644 index fccb4595b..000000000 --- a/contents/forward_euler_method/code/elm/elm-package.json +++ /dev/null @@ -1,20 +0,0 @@ -{ - "version": "1.0.0", - "summary": "helpful summary of your project, less than 80 characters", - "repository": "https://github.com/user/project.git", - "license": "BSD3", - "source-directories": [ - "." - ], - "exposed-modules": [], - "dependencies": { - "CallumJHays/elm-sliders": "1.0.1 <= v < 2.0.0", - "elm-lang/core": "5.1.1 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0", - "elm-lang/mouse": "1.0.1 <= v < 2.0.0", - "elm-lang/svg": "2.0.0 <= v < 3.0.0", - "elm-lang/window": "1.0.1 <= v < 2.0.0", - "rtfeldman/hex": "1.0.0 <= v < 2.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -} diff --git a/contents/forward_euler_method/code/elm/elm.json b/contents/forward_euler_method/code/elm/elm.json new file mode 100644 index 000000000..5eac761dd --- /dev/null +++ b/contents/forward_euler_method/code/elm/elm.json @@ -0,0 +1,28 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "bemyak/elm-slider": "1.0.0", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "elm/svg": "1.0.1", + "elm/time": "1.0.0", + "rtfeldman/elm-hex": "1.0.0" + }, + "indirect": { + "debois/elm-dom": "1.3.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/contents/forward_euler_method/code/elm/euler.elm b/contents/forward_euler_method/code/elm/euler.elm deleted file mode 100644 index a8d8d3c89..000000000 --- a/contents/forward_euler_method/code/elm/euler.elm +++ /dev/null @@ -1,332 +0,0 @@ -module Euler exposing (..) - -import Html exposing (Html, div, button, text, h3) -import Html.Attributes exposing (style) -import Html.Events exposing (onClick, on) -import Time exposing (Time, second) -import Maybe exposing (withDefault) -import Window exposing (Size, size) -import Svg exposing (svg, circle, line, polyline) -import Svg.Attributes exposing (width, height, stroke, x1, x2, y1, y2, cx, cy, r, points, fill) -import Task exposing (perform) -import Slider exposing (..) -import Mouse -import Json.Decode as Decode -import Hex - - -main = - Html.program - { init = init - , view = view - , update = update - , subscriptions = subscriptions - } - - - --- MODEL - - -type alias Model = - { part : Particle - , dt : Time - , dt0 : Time - , t : Time - , status : Status - , wWidth : Int - , wHeight : Int - , history : List ( Time, Time, Particle ) - , drag : Maybe Drag - } - - -type alias Position = - Float - - -type alias Velocity = - Float - - -type alias Particle = - { pos : List Position, vel : List Velocity } - - -type Status - = Idle - | Running - - -type alias Drag = - { start : Position - , current : Position - } - - -getX : Particle -> Position -getX p = - withDefault 0 <| List.head <| .pos p - - -getV : Particle -> Velocity -getV p = - withDefault 0 <| List.head <| .vel p - - -getX0 : Model -> Position -getX0 m = - let - scale x = - 3 - 6 * x / (toFloat m.wHeight) - in - case m.drag of - Nothing -> - getX m.part - - Just { start, current } -> - getX m.part + scale current - scale start - - - --- INIT - - -init : ( Model, Cmd Msg ) -init = - ( Model (Particle [ x0 ] [ 0 ]) 0.5 0.5 0 Idle 0 0 [] Nothing, perform GetSize size ) - - -x0 : Position -x0 = - 2.5 - - - --- UPDATE - - -type Msg - = Start - | Stop - | Tick Time - | GetSize Size - | SliderUpdate Float - | DragStart Mouse.Position - | DragAt Mouse.Position - | DragEnd Mouse.Position - - -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case msg of - Start -> - ( { model - | status = Running - , t = 0 - , dt = model.dt0 - , drag = Nothing - } - , Cmd.none - ) - - Stop -> - ( { model - | status = Idle - , part = Particle [ x0 ] [ 0 ] - , t = 0 - } - , Cmd.none - ) - - Tick _ -> - case model.status of - Idle -> - ( model, Cmd.none ) - - Running -> - if model.t > 5 + model.dt then - ( { model - | status = Idle - , part = Particle [ x0 ] [ 0 ] - , history = ( model.dt, model.t, model.part ) :: model.history - , t = 0 - } - , Cmd.none - ) - else - ( { model - | part = evolve model.part model.t model.dt - , t = model.t + model.dt - } - , perform GetSize size - ) - - GetSize s -> - ( { model | wWidth = s.width, wHeight = s.height * 8 // 10 }, Cmd.none ) - - SliderUpdate dt -> - ( { model | dt0 = dt }, Cmd.none ) - - DragStart { x, y } -> - case model.status of - Idle -> - ( { model | drag = Just (Drag (toFloat y) (toFloat y)) }, Cmd.none ) - - Running -> - ( model, Cmd.none ) - - DragAt { x, y } -> - ( { model | drag = Maybe.map (\{ start } -> Drag start (toFloat y)) model.drag } - , Cmd.none - ) - - DragEnd _ -> - ( { model - | drag = Nothing - , part = Particle [ getX0 model ] [ k * getX0 model ] - } - , Cmd.none - ) - - -k : Float -k = - -2 - - -diffEq : Position -> Velocity -> Time -> Time -> ( Position, Velocity ) -diffEq x v t dt = - ( x + (k * x) * dt, k * (x + (k * x) * dt) ) - - -evolve : Particle -> Time -> Time -> Particle -evolve p t dt = - let - ( x, v ) = - diffEq (getX p) (getV p) t dt - in - { p | pos = x :: p.pos, vel = v :: p.vel } - - - --- SUBSCRIPTIONS - - -subscriptions : Model -> Sub Msg -subscriptions model = - case model.drag of - Nothing -> - Time.every (model.dt * second) Tick - - Just _ -> - Sub.batch [ Mouse.moves DragAt, Mouse.ups DragEnd ] - - - --- VIEW - - -view : Model -> Html Msg -view model = - div [] - [ h3 [] [ text "Drag the ball up or down, pick a dt and click Start" ] - , h3 [ style [ ( "color", gradient model.dt0 ) ] ] - [ viewSlider - , text ("dt = " ++ toString model.dt0) - , button [ onClick Start ] [ text "Start" ] - , button [ onClick Stop ] [ text "Stop" ] - ] - , svg - [ width (toString model.wWidth) - , height (toString model.wHeight) - , stroke "black" - ] - ([ line - [ x1 "0" - , x2 (toString model.wWidth) - , y1 (toString (model.wHeight // 2)) - , y2 (toString (model.wHeight // 2)) - ] - [] - , line - [ x1 (toString (model.wWidth // 20)) - , x2 (toString (model.wWidth // 20)) - , y1 "0" - , y2 (toString model.wHeight) - ] - [] - , viewCircle model - ] - ++ (plotHistory model) - ) - ] - - -viewSlider : Html Msg -viewSlider = - props2view [ MinVal 0, MaxVal 1, Step 0.01, onChange SliderUpdate ] - - -scaleX : Int -> Position -> String -scaleX h x = - toString (toFloat h / 2 * (1 - x / 3)) - - -scaleT : Int -> Time -> String -scaleT w t = - toString (toFloat w * (0.05 + t / 5)) - - -viewCircle : Model -> Html Msg -viewCircle m = - circle - [ cy (scaleX m.wHeight (getX0 m)) - , cx (scaleT m.wWidth m.t) - , r "10" - , on "mousedown" (Decode.map DragStart Mouse.position) - ] - [] - - -plotPath : Int -> Int -> ( Time, Time, Particle ) -> String -plotPath w h ( dt, tf, particle ) = - let - comb x ( t, s ) = - ( t - dt, s ++ (scaleT w t) ++ "," ++ (scaleX h x) ++ " " ) - in - Tuple.second <| List.foldl comb ( tf, "" ) particle.pos - - -plotHistory : Model -> List (Html Msg) -plotHistory m = - let - ( w, h ) = - ( m.wWidth, m.wHeight ) - in - List.map - (\( dt, t, p ) -> - polyline - [ stroke "black" - , fill "none" - , stroke (gradient dt) - , points (plotPath w h ( dt, t, p )) - ] - [] - ) - (( m.dt, m.t, m.part ) :: m.history) - - -gradient : Time -> String -gradient dt = - let - ( r, g, b ) = - ( round (255 * dt), 0, round (255 * (1 - dt)) ) - - col = - Hex.toString (256 * (256 * r + g) + b) - in - if String.length col < 6 then - "#" ++ String.repeat (6 - String.length col) "0" ++ col - else - "#" ++ col diff --git a/contents/forward_euler_method/code/elm/src/Euler.elm b/contents/forward_euler_method/code/elm/src/Euler.elm new file mode 100644 index 000000000..d77dea9fc --- /dev/null +++ b/contents/forward_euler_method/code/elm/src/Euler.elm @@ -0,0 +1,386 @@ +module Euler exposing (..) + +import Browser +import Browser.Dom exposing (Viewport) +import Browser.Events as Events +import Hex +import Html exposing (Html, button, div, h3, text) +import Html.Attributes exposing (style) +import Html.Events exposing (on, onClick) +import Json.Decode as Decode exposing (Decoder) +import Maybe +import SingleSlider as Slider +import Svg exposing (circle, line, polyline, svg) +import Svg.Attributes exposing (cx, cy, fill, height, points, r, stroke, width, x1, x2, y1, y2) +import Task +import Time exposing (Posix) + + +main : Platform.Program () Model Msg +main = + Browser.element + { init = \() -> init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { part : Particle + , dt : Time + , dt0 : Time + , t : Time + , status : Status + , wWidth : Float + , wHeight : Float + , history : List ( Time, Time, Particle ) + , drag : Maybe Drag + , slider : Slider.Model + } + + +x0 : Position +x0 = + 2.5 + + +init : ( Model, Cmd Msg ) +init = + ( { part = Particle [ x0 ] [ 0 ] + , dt = 0.5 + , dt0 = 0.5 + , t = 0 + , status = Idle + , wWidth = 0 + , wHeight = 0 + , history = [] + , drag = Nothing + , slider = + { min = 0 + , max = 1 + , step = 0.01 + , value = 0.5 + , minFormatter = \_ -> "" + , maxFormatter = \_ -> "" + , currentValueFormatter = \_ _ -> "" + , disabled = False + } + } + , Task.perform GetViewPort Browser.Dom.getViewport + ) + + +type alias Time = + Float + + +type alias Position = + Float + + +type alias Velocity = + Float + + +type alias Particle = + { pos : List Position, vel : List Velocity } + + +type Status + = Idle + | Running + + +type alias Drag = + { start : Float + , current : Float + } + + +getX : Particle -> Position +getX p = + Maybe.withDefault 0 <| List.head <| .pos p + + +getV : Particle -> Velocity +getV p = + Maybe.withDefault 0 <| List.head <| .vel p + + +getX0 : Model -> Position +getX0 m = + let + scale x = + 3 - 6 * x / m.wHeight + in + case m.drag of + Nothing -> + getX m.part + + Just { start, current } -> + getX m.part + scale current - scale start + + + +-- UPDATE + + +type Msg + = Start + | Stop + | Tick Posix + | GetViewPort Viewport + | SliderUpdate Float + | SliderMsg Slider.Msg + | DragStart Float + | DragAt Float + | DragEnd Float + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Start -> + ( { model + | status = Running + , t = 0 + , dt = model.dt0 + , drag = Nothing + } + , Cmd.none + ) + + Stop -> + ( { model + | status = Idle + , part = Particle [ x0 ] [ 0 ] + , t = 0 + } + , Cmd.none + ) + + Tick _ -> + case model.status of + Idle -> + ( model, Cmd.none ) + + Running -> + if model.t > 5 + model.dt then + ( { model + | status = Idle + , part = Particle [ x0 ] [ 0 ] + , history = ( model.dt, model.t, model.part ) :: model.history + , t = 0 + } + , Cmd.none + ) + + else + ( { model + | part = evolve model.part model.t model.dt + , t = model.t + model.dt + } + , Task.perform GetViewPort Browser.Dom.getViewport + ) + + GetViewPort { viewport } -> + ( { model | wWidth = viewport.width, wHeight = viewport.height * 8 / 10 }, Cmd.none ) + + SliderUpdate dt -> + ( { model | dt0 = dt }, Cmd.none ) + + SliderMsg sliderMsg -> + let + ( newSlider, cmd, updateResults ) = + Slider.update sliderMsg model.slider + + newModel = + { model | slider = newSlider, dt0 = newSlider.value } + + newCmd = + if updateResults then + Cmd.batch [ Cmd.map SliderMsg cmd, Cmd.none ] + + else + Cmd.none + in + ( newModel, newCmd ) + + DragStart y -> + case model.status of + Idle -> + ( { model | drag = Just (Drag y y) }, Cmd.none ) + + Running -> + ( model, Cmd.none ) + + DragAt y -> + ( { model | drag = Maybe.map (\{ start } -> Drag start y) model.drag } + , Cmd.none + ) + + DragEnd _ -> + ( { model + | drag = Nothing + , part = Particle [ getX0 model ] [ k * getX0 model ] + } + , Cmd.none + ) + + +k : Float +k = + -2 + + +diffEq : Position -> Velocity -> Time -> Time -> ( Position, Velocity ) +diffEq x _ _ dt = + ( x + (k * x) * dt, k * (x + (k * x) * dt) ) + + +evolve : Particle -> Time -> Time -> Particle +evolve p t dt = + let + ( x, v ) = + diffEq (getX p) (getV p) t dt + in + { p | pos = x :: p.pos, vel = v :: p.vel } + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + (Slider.subscriptions model.slider |> Sub.map SliderMsg) + :: (case model.drag of + Nothing -> + [ Time.every (model.dt * 1000) Tick ] + + Just _ -> + [ Events.onMouseMove (Decode.map DragAt decodeMouseHeight) + , Events.onMouseUp (Decode.map DragEnd decodeMouseHeight) + ] + ) + |> Sub.batch + + +decodeMouseHeight : Decoder Float +decodeMouseHeight = + Decode.field "pageY" Decode.float + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div [] + [ h3 [] [ text "Drag the ball up or down, pick a dt and click Start" ] + , h3 [ style "color" (gradient model.dt0) ] + [ viewSlider model.slider + , button [ onClick Start ] [ text "Start" ] + , button [ onClick Stop ] [ text "Stop" ] + , text ("dt = " ++ String.fromFloat model.dt0) + ] + , svg + [ width (String.fromFloat model.wWidth) + , height (String.fromFloat model.wHeight) + , stroke "black" + ] + ([ line + [ x1 "0" + , x2 (String.fromFloat model.wWidth) + , y1 (String.fromFloat (model.wHeight / 2)) + , y2 (String.fromFloat (model.wHeight / 2)) + ] + [] + , line + [ x1 (String.fromFloat (model.wWidth / 20)) + , x2 (String.fromFloat (model.wWidth / 20)) + , y1 "0" + , y2 (String.fromFloat model.wHeight) + ] + [] + , viewCircle model + ] + ++ plotHistory model + ) + ] + + +viewSlider : Slider.Model -> Html Msg +viewSlider slider = + Slider.view slider |> Html.map SliderMsg + + +scaleX : Float -> Position -> String +scaleX h x = + String.fromFloat (h / 2 * (1 - x / 3)) + + +scaleT : Float -> Time -> String +scaleT w t = + String.fromFloat (w * (0.05 + t / 5)) + + +viewCircle : Model -> Html Msg +viewCircle m = + circle + [ cy (scaleX m.wHeight (getX0 m)) + , cx (scaleT m.wWidth m.t) + , r "10" + , on "mousedown" (Decode.map DragStart decodeMouseHeight) + ] + [] + + +plotPath : Float -> Float -> ( Time, Time, Particle ) -> String +plotPath w h ( dt, tf, particle ) = + let + comb x ( t, s ) = + ( t - dt, s ++ scaleT w t ++ "," ++ scaleX h x ++ " " ) + in + Tuple.second <| List.foldl comb ( tf, "" ) particle.pos + + +plotHistory : Model -> List (Html Msg) +plotHistory m = + let + ( w, h ) = + ( m.wWidth, m.wHeight ) + in + List.map + (\( dt, t, p ) -> + polyline + [ stroke "black" + , fill "none" + , stroke (gradient dt) + , points (plotPath w h ( dt, t, p )) + ] + [] + ) + (( m.dt, m.t, m.part ) :: m.history) + + +gradient : Time -> String +gradient dt = + let + ( r, g, b ) = + ( round (255 * dt), 0, round (255 * (1 - dt)) ) + + col = + Hex.toString (256 * (256 * r + g) + b) + in + if String.length col < 6 then + "#" ++ String.repeat (6 - String.length col) "0" ++ col + + else + "#" ++ col diff --git a/contents/forward_euler_method/forward_euler_method.md b/contents/forward_euler_method/forward_euler_method.md index 175ef1337..d4aa7375c 100644 --- a/contents/forward_euler_method/forward_euler_method.md +++ b/contents/forward_euler_method/forward_euler_method.md @@ -116,11 +116,11 @@ Note that in this case, the velocity is directly given by the ODE and the accele {% sample lang="rs" %} [import, lang:"rust"](code/rust/euler.rs) {% sample lang="elm" %} -[import:44-54, lang:"elm"](code/elm/euler.elm) -[import:193-210, lang:"elm"](code/elm/euler.elm) +[import:78-91, lang:"elm"](code/elm/src/Euler.elm) +[import:236-252, lang:"elm"](code/elm/src/Euler.elm) Full code for the visualization follows: -[import, lang:"elm"](code/elm/euler.elm) +[import, lang:"elm"](code/elm/src/Euler.elm) {% sample lang="py" %} [import, lang:"python"](code/python/euler.py) From aa9a674f524e6f24e87ae9772212b743cdedd386 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Gillet?= Date: Sat, 6 Nov 2021 13:41:13 +0900 Subject: [PATCH 3/3] Reset particle on start or stop --- .../code/elm/src/Euler.elm | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/contents/forward_euler_method/code/elm/src/Euler.elm b/contents/forward_euler_method/code/elm/src/Euler.elm index d77dea9fc..c9207d2de 100644 --- a/contents/forward_euler_method/code/elm/src/Euler.elm +++ b/contents/forward_euler_method/code/elm/src/Euler.elm @@ -52,8 +52,8 @@ x0 = init : ( Model, Cmd Msg ) init = ( { part = Particle [ x0 ] [ 0 ] - , dt = 0.5 - , dt0 = 0.5 + , dt = 0.25 + , dt0 = 0.25 , t = 0 , status = Idle , wWidth = 0 @@ -64,7 +64,7 @@ init = { min = 0 , max = 1 , step = 0.01 - , value = 0.5 + , value = 0.25 , minFormatter = \_ -> "" , maxFormatter = \_ -> "" , currentValueFormatter = \_ _ -> "" @@ -126,6 +126,16 @@ getX0 m = getX m.part + scale current - scale start +resetParticle : Particle -> Particle +resetParticle { pos, vel } = + case ( List.reverse pos, List.reverse vel ) of + ( x :: _, v :: _ ) -> + Particle [ x ] [ v ] + + _ -> + Particle [ x0 ] [ 0 ] + + -- UPDATE @@ -151,6 +161,7 @@ update msg model = , t = 0 , dt = model.dt0 , drag = Nothing + , part = resetParticle model.part } , Cmd.none ) @@ -158,7 +169,7 @@ update msg model = Stop -> ( { model | status = Idle - , part = Particle [ x0 ] [ 0 ] + , part = resetParticle model.part , t = 0 } , Cmd.none