From 254e99c1aa7144e729968102ede24130064a7f83 Mon Sep 17 00:00:00 2001
From: "Aamon P. Hoffmann" <aamon.hoffmann@student.uni-halle.de>
Date: Sat, 4 Jan 2025 23:31:42 +0100
Subject: [PATCH] Added Loading... to Force Directed Graph
---
src/Config/ForceDirectedGraph.elm | 9 +-
src/Main.elm | 9 +-
src/Views/ForceDirectedGraph.elm | 132 +++++++++++++++++++++++-------
3 files changed, 116 insertions(+), 34 deletions(-)
diff --git a/src/Config/ForceDirectedGraph.elm b/src/Config/ForceDirectedGraph.elm
index e6faaf5..7d2292c 100644
--- a/src/Config/ForceDirectedGraph.elm
+++ b/src/Config/ForceDirectedGraph.elm
@@ -1,4 +1,4 @@
-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 =
diff --git a/src/Main.elm b/src/Main.elm
index 33f47a4..3a57518 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -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
)
diff --git a/src/Views/ForceDirectedGraph.elm b/src/Views/ForceDirectedGraph.elm
index 8d14fab..4c5bb49 100644
--- a/src/Views/ForceDirectedGraph.elm
+++ b/src/Views/ForceDirectedGraph.elm
@@ -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
]
--
GitLab