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