Commit 3b832734 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/689-dev-dynamic-legend' into dev

parents 60edf362 b09e3070
......@@ -120,7 +120,7 @@ sideTabLegend :: R2.Leaf Props
sideTabLegend = R2.leaf sideTabLegendCpt
sideTabLegendCpt :: R.Component Props
sideTabLegendCpt = here.component "sideTabLegend" cpt where
cpt { metaData: GET.MetaData { legend }, session, graphId } _ = do
cpt { metaData: GET.MetaData { legend }, session, graphId } _ = do
-- | States
-- |
store <- GraphStore.use
......@@ -128,8 +128,6 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt where
hyperdataGraph
<- R2.useLive' store.hyperdataGraph
legend' /\ legendBox <- R2.useBox' legend
-- | Hooks
-- |
......@@ -158,13 +156,12 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt where
{ className: "graph-sidebar__legend-tab" }
[
Legend.legend
{ legendSeq: Seq.fromFoldable legend'
{ legendSeq: Seq.fromFoldable legend
, extractedNodeList
, nodeCountList
, selectedNodeIds: store.selectedNodeIds
, session
, graphId
, legendBox
}
]
......
......@@ -36,7 +36,6 @@ type Props =
, selectedNodeIds :: T.Box ST.NodeIds
, session :: Session
, graphId :: GET.GraphId
, legendBox :: T.Box (Array GET.Legend)
)
legend :: R2.Leaf Props
......
......@@ -185,6 +185,8 @@ type LouvainButtonProps =
, sigmaRef :: R.Ref Sigmax.Sigma
, transformedGraph :: T.Box SigmaxTypes.SGraph
, title :: String
, mMetaData :: T.Box (Maybe GET.MetaData)
, hyperdataGraph :: T.Box GET.HyperdataGraph
)
louvainButton :: R2.Leaf LouvainButtonProps
......@@ -192,9 +194,10 @@ louvainButton = R2.leaf louvainButtonCpt
louvainButtonCpt :: R.Component LouvainButtonProps
louvainButtonCpt = here.component "louvainButton" cpt
where
cpt { forceAtlasState, graph, sigmaRef, transformedGraph, title } _ = do
cpt { forceAtlasState, graph, sigmaRef, transformedGraph, title, mMetaData, hyperdataGraph} _ = do
graph' <- R2.useLive' graph
forceAtlasState' <- R2.useLive' forceAtlasState
mMetaData' <- R2.useLive' mMetaData
pure $
B.button
......@@ -208,6 +211,19 @@ louvainButtonCpt = here.component "louvainButton" cpt
(Map.fromFoldable $ (\{ id, color } -> Tuple id color) <$> SigmaxTypes.graphNodes
lgraph))
graph
hyperdataGraph' <- T.modify (GEU.updateHyperdataClusters cluster) hyperdataGraph
let legend' = GEU.generateLegend hyperdataGraph'
let mMetaData'' = case mMetaData' of
Just (GET.MetaData m) -> Just $ GET.MetaData $ m { legend = legend' }
Nothing -> Just $ GET.MetaData {
corpusId : []
, legend : legend'
, list: { listId : 0, version : 0 }
, metric: "Order1"
, startForceAtlas: true
, title : ""
}
T.write_ mMetaData'' mMetaData
T.write_ lgraph transformedGraph
pure unit
......
......@@ -63,6 +63,7 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
, hyperdataGraph
, labelRenderedSizeThreshold
, labelSize
, mMetaData
, mouseSelectorSize
, multiSelectEnabled
, nodeSize
......@@ -294,7 +295,9 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
, graph
, sigmaRef
, transformedGraph
, title: "" }
, title: ""
, mMetaData
, hyperdataGraph }
]
,
-- Selection Settings
......
......@@ -4,19 +4,24 @@ module Gargantext.Components.GraphExplorer.Utils
, normalizeNodeSizeDefault
, normalizeNodeSize
, takeGreatestNodeByCluster, countNodeByCluster
, generateLegend
, updateHyperdataClusters
) where
import Gargantext.Prelude
import Data.Array as A
import Data.Foldable (maximum, minimum)
import Data.Lens (Lens', lens, over, traversed, (^.))
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (wrap)
import Data.Number as DN
import Data.Traversable (class Traversable)
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Prelude
import Gargantext.Utils (getter)
import Gargantext.Utils.Lens as GUL
......@@ -108,3 +113,18 @@ countNodeByCluster graphData clusterId
, count: _
}
>>> wrap
generateLegend :: GET.HyperdataGraph -> Array GET.Legend
generateLegend (GET.HyperdataGraph { graph: (GET.GraphData { nodes })}) = A.sort $ A.foldl f [] $ A.fromFoldable nodes
where
f :: Array GET.Legend -> GEGT.Node -> Array GET.Legend
f acc (GEGT.Node {attributes: (GEGT.Cluster {clustDefault: i})}) = case A.find (\(GET.Legend {id_}) -> id_ == i) acc of
Just _ -> acc
Nothing -> acc <> [GET.Legend { id_: i, color: "#FFF", label: "Cluster" <> show i }]
updateHyperdataClusters :: Louvain.LouvainCluster -> GET.HyperdataGraph -> GET.HyperdataGraph
updateHyperdataClusters cluster (GET.HyperdataGraph gd) = GET.HyperdataGraph $ gd { graph = newGraph gd.graph }
where
newGraph (GET.GraphData d ) = GET.GraphData $ d { nodes = map f $ d.nodes }
f :: GEGT.Node -> GEGT.Node
f (GEGT.Node n) = GEGT.Node $ n { attributes = GEGT.Cluster { clustDefault: fromMaybe 0 $ Map.lookup n.id_ cluster } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment