Skip to content

P
purescript-gargantext
Commit 419aa14f authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FEAT][CHART] TreeMap.

parent 0529a6b5
Hide whitespace changes
Inline Side-by-side
Showing with 85 additions and 105 deletions
src/Gargantext/Components/Charts/Options/Series.purs
View file @ 419aa14f
module Gargantext.Components.Charts.Options.Series where module Gargantext.Components.Charts.Options.Series where
import Data.Maybe
import Data.Array (foldl)
import Record.Unsafe (unsafeSet) import Record.Unsafe (unsafeSet)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Gargantext.Types (class Optional) import Gargantext.Types (class Optional)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip) import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2) import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
...@@ -143,7 +146,7 @@ instance showTrees :: Show Trees where ...@@ -143,7 +146,7 @@ instance showTrees :: Show Trees where
type RequiredTree o = type RequiredTree o =
{ "type" :: SeriesType { "type" :: SeriesType
, "data" :: Array TreeData , "data" :: Array TreeNode
| o | o
} }
...@@ -154,9 +157,9 @@ type OptionalTree = ...@@ -154,9 +157,9 @@ type OptionalTree =
seriesTree :: forall o. Optional o OptionalTree => RequiredTree o -> Series seriesTree :: forall o. Optional o OptionalTree => RequiredTree o -> Series
seriesTree = unsafeSeries seriesTree = unsafeSeries
mkTree :: Trees -> Array TreeData -> Series mkTree :: Trees -> Array TreeNode -> Series
mkTree t ts = seriesTree { "type" : SeriesType (show t) mkTree t ts = seriesTree { "type" : SeriesType (show t)
, "data" : map toJsTree ts , "data" : map (toJsTree Nothing) ts
, layout : layout , layout : layout
} }
where where
...@@ -165,30 +168,42 @@ mkTree t ts = seriesTree { "type" : SeriesType (show t) ...@@ -165,30 +168,42 @@ mkTree t ts = seriesTree { "type" : SeriesType (show t)
_ -> "none" _ -> "none"
-- ** Data Structure of the Trees -- ** Data Structure of the Trees
data TreeData = TreeLeaf TreeLeaf data TreeData = Array TreeNode
| TreeNode TreeNode
toJsTree :: TreeData -> TreeData treeValue :: TreeNode -> Int
toJsTree (TreeLeaf x) = unsafeCoerce x treeValue (TreeNode x) = foldl (+) 0 $ [x.value] <> map treeValue x.children
toJsTree (TreeNode x) = unsafeCoerce { name : x.name
, value : x.value toJsTree :: Maybe String -> TreeNode -> TreeNode
, children : (map toJsTree x.children) toJsTree maybeSurname (TreeNode x) =
} unsafeCoerce { name : name
, value : foldl (+) 0 $ [x.value] <> map treeValue x.children
type TreeNode = { name :: String , children : (map (toJsTree (Just name)) x.children)
, value :: Number }
, children :: Array TreeData where
name = maybe "" (\x -> x <> ">") maybeSurname <> x.name
data TreeNode = TreeNode { name :: String
, value :: Int
, children :: Array TreeNode
} }
type TreeLeaf = { name :: String
, value :: Number
}
treeNode :: String -> Number -> Array TreeData -> TreeData instance decodeTreeNode :: DecodeJson TreeNode where
decodeJson json = do
obj <- decodeJson json
name <- obj .? "label"
value <- obj .? "value"
children <- obj .? "children"
pure $ TreeNode {name, value, children}
treeNode :: String -> Int -> Array TreeNode -> TreeNode
treeNode n v ts = TreeNode {name : n, value:v, children:ts} treeNode n v ts = TreeNode {name : n, value:v, children:ts}
treeLeaf :: String -> Number -> TreeData treeLeaf :: String -> Int -> TreeNode
treeLeaf n v = TreeLeaf { name : n, value : v} treeLeaf n v = TreeNode { name : n, value : v, children : []}
-- | TODO -- | TODO
......
src/Gargantext/Config.purs
View file @ 419aa14f
...@@ -173,7 +173,7 @@ pathUrl c (CorpusMetrics {tabType, listId, limit}) i = ...@@ -173,7 +173,7 @@ pathUrl c (CorpusMetrics {tabType, listId, limit}) i =
pathUrl c (Chart {chartType, tabType}) i = pathUrl c (Chart {chartType, tabType}) i =
pathUrl c (NodeAPI Corpus) i <> "/" <> show chartType pathUrl c (NodeAPI Corpus) i <> "/" <> show chartType
<> "?ngramsType=" <> showTabType' tabType <> "?ngramsType=" <> showTabType' tabType
-- <> "?list=1" -- <> show listId <> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit -- <> maybe "" (\x -> "&limit=" <> show x) limit
...@@ -263,13 +263,14 @@ data Path ...@@ -263,13 +263,14 @@ data Path
-- , limit :: Maybe Limit -- , limit :: Maybe Limit
} }
data ChartType = Histo | Scatter | ChartPie data ChartType = Histo | Scatter | ChartPie | ChartTree
instance showChartType :: Show ChartType instance showChartType :: Show ChartType
where where
show Histo = "chart" show Histo = "chart"
show Scatter = "scatter" show Scatter = "scatter"
show ChartPie = "pie" show ChartPie = "pie"
show ChartTree = "tree"
data End = Back | Front data End = Back | Front
type Id = Int type Id = Int
......
src/Gargantext/Pages/Corpus/Chart/Tree.purs
View file @ 419aa14f
...@@ -31,24 +31,9 @@ type Path = ...@@ -31,24 +31,9 @@ type Path =
, limit :: Maybe Int , limit :: Maybe Int
} }
newtype Metric = Metric
{ label :: String
, x :: Number
, y :: Number
, cat :: TermList
}
instance decodeMetric :: DecodeJson Metric where
decodeJson json = do
obj <- decodeJson json
label <- obj .? "label"
x <- obj .? "x"
y <- obj .? "y"
cat <- obj .? "cat"
pure $ Metric { label, x, y, cat }
newtype Metrics = Metrics newtype Metrics = Metrics
{ "data" :: Array Metric { "data" :: Array TreeNode
} }
instance decodeMetrics :: DecodeJson Metrics where instance decodeMetrics :: DecodeJson Metrics where
...@@ -57,52 +42,31 @@ instance decodeMetrics :: DecodeJson Metrics where ...@@ -57,52 +42,31 @@ instance decodeMetrics :: DecodeJson Metrics where
d <- obj .? "data" d <- obj .? "data"
pure $ Metrics { "data": d } pure $ Metrics { "data": d }
type Loaded = Array Metric type Loaded = Array TreeNode
loadedMetricsSpec :: Spec {} (Loader.InnerProps Path Loaded ()) Void loadedMetricsSpec :: Spec {} (Loader.InnerProps Path Loaded ()) Void
loadedMetricsSpec = simpleSpec defaultPerformAction render loadedMetricsSpec = simpleSpec defaultPerformAction render
where where
render :: Render {} (Loader.InnerProps Path Loaded ()) Void render :: Render {} (Loader.InnerProps Path Loaded ()) Void
render dispatch {loaded} {} _ = [chart treeMapEx] render dispatch {loaded} {} _ = [chart (scatterOptions loaded)]
--render dispatch {loaded} {} _ = [chart (scatterOptions loaded)]
scatterOptions :: Array TreeNode -> Options
scatterOptions :: Array Metric -> Options scatterOptions nodes = Options
scatterOptions metrics = Options { mainTitle : "Tree"
{ mainTitle : "Ngrams Selection Metrics" , subTitle : "Tree Sub Title"
, subTitle : "Local metrics (Inc/Exc, Spe/Gen), Global metrics (TFICF maillage)" , xAxis : xAxis' []
, xAxis : xAxis { min: 0 } , yAxis : yAxis' { position : "", show: false }
, yAxis : yAxis' { position : "", show: true } , series : [ mkTree TreeMap nodes]
, series : map2series $ metric2map metrics
, addZoom : false , addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" } , tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
} -- TODO improve the formatter:
where -- https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-obama
metric2map :: Array Metric -> Map TermList (Array Metric)
metric2map ds = Map.fromFoldableWith (<>) $ (\(Metric m) -> Tuple m.cat [Metric m]) <$> ds
--{- }
map2series :: Map TermList (Array Metric) -> Array Series
map2series ms = toSeries <$> Map.toUnfoldable ms
where
-- TODO colors are not respected yet
toSeries (Tuple k ms) =
seriesScatterD2 {symbolSize: 5.0} (toSerie color <$> ms)
where
color =
case k of
StopTerm -> red
GraphTerm -> green
CandidateTerm -> grey
toSerie color (Metric {label,x,y}) =
dataSerie { name: label, itemStyle: itemStyle {color}
-- , label: {show: true}
, value: [x,y]
}
--}
getMetrics :: Path -> Aff Loaded getMetrics :: Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do getMetrics {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ toUrl Back (CorpusMetrics {listId, tabType, limit}) $ Just corpusId Metrics ms <- get $ toUrl Back (Chart {chartType : ChartTree, tabType: tabType}) $ Just corpusId
pure ms."data" pure ms."data"
metricsLoaderClass :: ReactClass (Loader.Props Path Loaded) metricsLoaderClass :: ReactClass (Loader.Props Path Loaded)
......
src/Gargantext/Pages/Corpus/Dashboard.purs
View file @ 419aa14f
...@@ -143,46 +143,46 @@ sankeyEx = Options ...@@ -143,46 +143,46 @@ sankeyEx = Options
, addZoom : false , addZoom : false
} }
treeData :: Array TreeData treeData :: Array TreeNode
treeData = [ treeNode "nodeA" 10.0 [ treeLeaf "nodeAa" 4.0 treeData = [ treeNode "nodeA" 10 [ treeNode "nodeAa" 4 []
, treeLeaf "nodeAb" 5.0 , treeNode "nodeAb" 5 []
, treeNode "nodeAc" 1.0 [ treeLeaf "nodeAca" 0.5 , treeNode "nodeAc" 1 [ treeNode "nodeAca" 5 []
, treeLeaf "nodeAcb" 0.5 , treeNode "nodeAcb" 5 []
] ]
] ]
, treeNode "nodeB" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeNode "nodeBa1" 20 [] ]]
, treeNode "nodeC" 20.0 [ treeNode "nodeCa" 20.0 [ treeLeaf "nodeCa1" 10.0 , treeNode "nodeC" 20 [ treeNode "nodeCa" 20 [ treeNode "nodeCa1" 10 []
, treeLeaf "nodeCa2" 10.0 , treeNode "nodeCa2" 10 []
] ]
] ]
, treeNode "nodeD" 20.0 [ treeNode "nodeDa" 20.0 [ treeLeaf "nodeDa1" 2.0 , treeNode "nodeD" 20 [ treeNode "nodeDa" 20 [ treeNode "nodeDa1" 2 []
, treeLeaf "nodeDa2" 2.0 , treeNode "nodeDa2" 2 []
, treeLeaf "nodeDa3" 2.0 , treeNode "nodeDa3" 2 []
, treeLeaf "nodeDa4" 2.0 , treeNode "nodeDa4" 2 []
, treeLeaf "nodeDa5" 2.0 , treeNode "nodeDa5" 2 []
, treeLeaf "nodeDa6" 2.0 , treeNode "nodeDa6" 2 []
, treeLeaf "nodeDa7" 2.0 , treeNode "nodeDa7" 2 []
, treeLeaf "nodeDa8" 2.0 , treeNode "nodeDa8" 2 []
, treeLeaf "nodeDa9" 2.0 , treeNode "nodeDa9" 2 []
, treeLeaf "nodeDa10" 2.0 , treeNode "nodeDa10" 2 []
] ]
] ]
] ]
treeData' :: Array TreeData treeData' :: Array TreeNode
treeData' = [ treeNode "nodeA" 10.0 [ treeLeaf "nodeAa" 4.0 treeData' = [ treeNode "nodeA" 10 [ treeLeaf "nodeAa" 4
, treeLeaf "nodeAb" 5.0 , treeLeaf "nodeAb" 5
, treeNode "nodeAc" 1.0 [ treeLeaf "nodeAca" 0.5 , treeNode "nodeAc" 1 [ treeLeaf "nodeAca" 5
, treeLeaf "nodeAcb" 0.5 , treeLeaf "nodeAcb" 5
] ]
, treeNode "nodeB" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeC" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeC" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeD" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeD" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeE" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeE" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeF" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeF" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeG" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeG" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
, treeNode "nodeH" 20.0 [ treeNode "nodeBa" 20.0 [ treeLeaf "nodeBa1" 20.0]] , treeNode "nodeH" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
] ]
] ]
......
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