Skip to content
Snippets Groups Projects
Commit 254e99c1 authored by Aamon Paul Hoffmann's avatar Aamon Paul Hoffmann
Browse files

Added Loading... to Force Directed Graph

parent 952c8fab
No related branches found
No related tags found
No related merge requests found
module Config.ForceDirectedGraph exposing (Entity, Model, Msg(..))
module Config.ForceDirectedGraph exposing (Entity, Model, Msg(..), TaskError(..))
import Force
import Graph exposing (Graph, NodeId)
......@@ -9,6 +9,13 @@ type Msg
= RecalcStart
| Highlight String
| ChangeYear Int
| ChangeForces Int
| RecalcEnd (Result TaskError Model)
| SetLoading Bool
type TaskError
= TaskFailed
type alias Model =
......
......@@ -85,14 +85,19 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update msg ( global, local ) =
case msg of
ViewChange newView ->
( ( { global | view = newView }, local ), Cmd.none )
case newView of
ForceDirectedGraph ->
( ( { global | view = newView }, local ), ForceDirectedGraphView.calculateModel global.data 0 |> Cmd.map ForceDirectedGraphView.propagate )
_ ->
( ( { global | view = newView }, local ), Cmd.none )
DataReceived (Ok rawData) ->
case decode rawData of
-- Pull the map data ONLY AFTER the Visa data was received.
Ok data ->
( ( { global | progress = Success, data = data }
, { local | forcedirectedgraph = ForceDirectedGraphView.postInit data 0 }
, { local | forcedirectedgraph = ForceDirectedGraphView.firstInit }
)
, MapView.getMapData |> Cmd.map GotMap
)
......
......@@ -17,11 +17,13 @@ import List.Extra
import List.Statistics
import Model exposing (Global, Model)
import Msg exposing (Msg)
import Process exposing (sleep)
import Task
import TypedSvg exposing (circle, g, line, svg, text_, title)
import TypedSvg.Attributes exposing (alignmentBaseline, class, fill, shapeRendering, stroke, textRendering, viewBox)
import TypedSvg.Attributes exposing (alignmentBaseline, class, fill, shapeRendering, stroke, textAnchor, textRendering, viewBox)
import TypedSvg.Attributes.InPx exposing (cx, cy, fontSize, r, strokeWidth, x, x1, x2, y, y1, y2)
import TypedSvg.Core exposing (Attribute, Svg, text)
import TypedSvg.Types exposing (AlignmentBaseline(..), Paint(..), ShapeRendering(..), TextRendering(..), px)
import TypedSvg.Types exposing (AlignmentBaseline(..), AnchorAlignment(..), Paint(..), ShapeRendering(..), TextRendering(..), px)
import Utils exposing (flag)
......@@ -39,8 +41,16 @@ view : Global -> Local.Model -> Html Msg
view global local =
Html.div [ style "width" "100%" ]
[ Html.div [ style "display" "flex", style "flex-direction" "row", style "align-items" "center" ]
[ Html.h2 [ style "margin" "0" ]
[ Html.text "Force directed Graph" ]
[ Html.div []
[ Html.h2 [ style "margin-top" "0" ]
[ Html.text "Force directed Graph" ]
, Html.button [ Local.ChangeForces 0 |> propagate |> onClick ]
[ Html.i [ Html.Attributes.class "fa-solid fa-repeat fa-xl" ] [] ]
, Html.button [ Local.ChangeForces 1 |> propagate |> onClick ]
[ Html.i [ Html.Attributes.class "fa-solid fa-repeat fa-xl" ] [] ]
, Html.button [ Local.ChangeForces 2 |> propagate |> onClick ]
[ Html.i [ Html.Attributes.class "fa-solid fa-repeat fa-xl" ] [] ]
]
, Html.button [ Local.RecalcStart |> propagate |> onClick, style "margin-left" "auto" ]
[ Html.i [ Html.Attributes.class "fa-solid fa-repeat fa-xl" ] [] ]
, Html.div [ style "margin-left" "auto" ]
......@@ -62,17 +72,19 @@ view global local =
]
, Html.div [ style "display" "flex", style "flex-direction" "row" ]
[ if local.loading then
Html.div [] [ Html.text "Loading..." ]
Html.div [ style "flex-grow" "1" ] [ Html.text "Loading..." ]
else
svg
[ viewBox 0 0 w h, style "flex-grow" "1" ]
[ Graph.edges local.graph
|> List.map (linkElement local.graph local.highlight)
|> g [ class [ "links" ] ]
, Graph.nodes local.graph
|> List.map (nodeElement local.highlight)
|> g [ class [ "nodes" ] ]
Html.div [ style "flex-grow" "1", style "position" "relative" ]
[ svg
[ viewBox 0 0 w h, style "position" "absolute", style "width" "100%", style "height" "100%" ]
[ Graph.edges local.graph
|> List.map (linkElement local.graph local.highlight)
|> g [ class [ "links" ] ]
, Graph.nodes local.graph
|> List.map (nodeElement local global.data)
|> g [ class [ "nodes" ] ]
]
]
, Html.div [ Html.Attributes.class "legend", style "width" "19%" ]
[ Html.div [ style "display" "flex" ]
......@@ -138,7 +150,7 @@ initializeNode ctx =
firstInit : Local.Model
firstInit =
Local.Model Graph.empty (Force.simulation []) 0 False "" 0
Local.Model Graph.empty (Force.simulation []) 0 True "" 0
makeGraph : List Entry -> Int -> Graph String ()
......@@ -173,7 +185,7 @@ makeGraph data year =
Graph.fromNodeLabelsAndEdgePairs allCountries edges
postInit : List Entry -> Int -> Local.Model
postInit : List Entry -> Int -> Task.Task Never (Result Local.TaskError Local.Model)
postInit data year =
let
filteredData =
......@@ -224,9 +236,6 @@ postInit data year =
|> List.Statistics.mean
|> Maybe.withDefault 1
)
_ =
Debug.log "DEBUG" <| "cc " ++ Debug.toString cc ++ " aR: " ++ Debug.toString acceptedRatio
in
( n.id, 0.5 * acceptedRatio )
)
......@@ -341,7 +350,14 @@ postInit data year =
list =
Force.computeSimulation (Force.simulation forces) <| List.map .label <| Graph.nodes graph
in
Local.Model (updateGraphWithList graph list) (Force.simulation forces) 0 False "" 0
Task.succeed (Ok { firstInit | loading = True })
|> Task.andThen
(\_ ->
Task.succeed
(Ok
(Local.Model (updateGraphWithList graph list) (Force.simulation forces) 0 False "" 0)
)
)
isSchengen : Graph.Node Local.Entity -> List Entry -> Bool
......@@ -386,26 +402,36 @@ updateGraphWithList =
List.foldr (\node graph -> Graph.update node.id (graphUpdater node) graph)
calculateModel : Global -> Int -> Local.Model
calculateModel glob year =
postInit glob.data year
calculateModel : List Entry -> Int -> Cmd Local.Msg
calculateModel data year =
Task.perform Local.RecalcEnd (Process.sleep 0 |> Task.andThen (\_ -> postInit data year))
update : Local.Msg -> Global -> Local.Model -> ( Global, Local.Model, Cmd Msg )
update msg glob { graph, simulation, tickCount, loading, highlight, year } =
case msg of
Local.RecalcStart ->
( glob, postInit glob.data year, Cmd.none )
( glob, Local.Model graph simulation tickCount True highlight year, calculateModel glob.data year |> Cmd.map propagate )
Local.Highlight hl ->
( glob, Local.Model graph simulation tickCount loading hl year, Cmd.none )
Local.ChangeYear y ->
let
newModel =
postInit glob.data y
in
( glob, { newModel | highlight = highlight }, Cmd.none )
( glob, Local.Model graph simulation tickCount True highlight year, calculateModel glob.data y |> Cmd.map propagate )
Local.ChangeForces f ->
( glob, Local.Model graph simulation tickCount loading highlight year, Cmd.none )
Local.SetLoading b ->
( glob, Local.Model graph simulation tickCount b highlight year, Cmd.none )
Local.RecalcEnd res ->
case res of
Ok newModel ->
( glob, { newModel | loading = False }, Cmd.none )
Err _ ->
( glob, Local.Model graph simulation tickCount False highlight year, Cmd.none )
propagate : Local.Msg -> Msg
......@@ -447,14 +473,58 @@ linkElement graph hl edge =
[]
nodeElement : String -> { a | id : NodeId, label : { b | x : Float, y : Float, value : String } } -> Svg Msg
nodeElement hl node =
nodeElement : Local.Model -> List Entry -> { a | id : NodeId, label : { b | x : Float, y : Float, value : String } } -> Svg Msg
nodeElement local dat node =
let
filteredData =
filterForYears dat local.year
countryNames =
List.map (\ent -> String.toUpper ent.state) filteredData
consulateCountries =
List.map (\ent -> String.toUpper ent.consulateCountry) filteredData
allCountries =
List.Extra.unique <| List.concat [ countryNames, consulateCountries ]
findPos : String -> Int
findPos s =
Maybe.withDefault -1 <| List.Extra.findIndex (\it -> it == s) allCountries
findName : Int -> String
findName i =
Maybe.withDefault "???" <| List.Extra.getAt i allCountries
cc =
List.Extra.getAt (findName node.id |> findPos) allCountries
|> Maybe.withDefault "??"
rows =
List.filter (\e -> e.state == cc) filteredData
visasApplied =
rows
|> List.map (\e -> Maybe.withDefault 1 <| e.totalVisasApplied)
|> List.sum
baseFontSize =
15 + visasApplied / 1000000
highlightFontSize =
if local.highlight == node.label.value then
2 * baseFontSize
else
baseFontSize
in
g []
[ text_
[ x <| node.label.x - 8.0
, y node.label.y
, fontSize 15.0
, fontSize highlightFontSize
, alignmentBaseline AlignmentMiddle
, textAnchor AnchorMiddle
, class
[ node.label.value
]
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment