diff --git a/src/Config/ForceDirectedGraph.elm b/src/Config/ForceDirectedGraph.elm
index e6faaf5453c18c71991f6d8d65c422b76e7263d6..7d2292c47952436483fcedd406e358fded0252c8 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 33f47a45fea0b8bc802f2a80af85f4233e87adbc..3a575182f657811160032ce507a7355a43f38069 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 8d14fab03ac0e91356c34f34403a5f6dd38e69ee..4c5bb4997a2806fbca715b3f162f4ba8e902fda7 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
]