Unverified Commit 7bd822ea authored by Nicolas Pouillard's avatar Nicolas Pouillard

Merge branch 'dev-selector' of...

Merge branch 'dev-selector' of https://gitlab.iscpif.fr/gargantext/purescript-gargantext into dev-selector
parents 64b242fc 98537466
......@@ -33,7 +33,8 @@ red :: Color
red = stringColor "red"
blue :: Color
blue = stringColor "blue"
blue = cssColor $ rgba 100 150 200 0.0
-- stringColor "blue"
magenta :: Color
magenta = stringColor "magenta"
......
......@@ -63,7 +63,7 @@ title mainTitle subTitle =
,itemGap: 0.0
,zlevel: 2.0
,z: 2.0
,left: relativePosition (Relative LeftPos)
,left: relativePosition (Relative RightPos)
,top: relativePosition (Relative Top)
,right: numberPosition 60.0
,bottom: percentPosition 40.0
......@@ -115,7 +115,6 @@ data3 :: DataLegend
data3 = {name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle'}
yAxisVoid :: YAxis
yAxisVoid = yAxis
{ "type": ""
......@@ -126,27 +125,17 @@ yAxisVoid = yAxis
, show: false
}
yAxis1 :: YAxis
yAxis1 = yAxis
{ "type": "value"
, name: "data"
, min: 0
, position: "left"
, axisLabel: {formatter: "{value}"}
, show: true
}
xAxis' :: Array String -> XAxis
xAxis' [] = unsafeCoerce {}
xAxis' xs = xAxis
{ "data": xData xs
, "type": "category"
, axisTick: {alignWithLabel: true}
, show: length xs /= 0
, show: true
}
where
xData :: Array String -> Array DataAxis
xData = map (\x -> {value : x, textStyle : textStyle'})
xData = map (\x -> {value : x, textStyle : textStyle})
-- TODO try to use Optional
yAxis' :: { position :: String
......@@ -228,7 +217,7 @@ textStyle2 =
,fontStyle: chartFontStyle italic
,fontWeight: chartFontWeight normal
,fontFamily: "sans-serif"
,fontSize: 12
,fontSize: 11
,align: relativePosition $ Relative RightPos
,verticalAlign: relativePosition $ Relative Bottom
,lineHeight: percentPosition 0.0
......@@ -270,14 +259,14 @@ textStyle =
,fontStyle: chartFontStyle normal
,fontWeight: chartFontWeight normal
,fontFamily: "sans-serif"
,fontSize: 20
,fontSize: 15
,align: relativePosition $ Relative LeftPos
,verticalAlign: relativePosition $ Relative Top
,lineHeight: percentPosition 0.0
,width: percentPosition 100.0
,height: percentPosition 100.0
,textBorderColor: black
,textBorderWidth: 1.0
,textBorderWidth: 0.0
,textShadowColor: black
,textShadowBlur: black
,textShadowOffsetX: 0.0
......
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)
}
data TreeData = Array TreeNode
type TreeNode = { name :: String
, value :: Number
, children :: Array TreeData
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
type TreeLeaf = { name :: String
, value :: Number
data TreeNode = TreeNode { name :: String
, value :: Int
, children :: Array TreeNode
}
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
......
......@@ -19,6 +19,7 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Set as Set
import Data.Int (fromString)
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
......@@ -81,7 +82,7 @@ newtype DocumentsView
= DocumentsView
{ _id :: Int
, url :: String
, date :: String
, date :: Int
, title :: String
, source :: String
, fav :: Boolean
......@@ -98,7 +99,6 @@ instance showDocumentsView :: Show DocumentsView where
newtype Response = Response
{ cid :: Int
, created :: String
, hyperdata :: Hyperdata
, favorite :: Boolean
, ngramCount :: Int
......@@ -108,6 +108,7 @@ newtype Response = Response
newtype Hyperdata = Hyperdata
{ title :: String
, source :: String
, pub_year :: Int
}
--instance decodeHyperdata :: DecodeJson Hyperdata where
......@@ -130,20 +131,19 @@ newtype Hyperdata = Hyperdata
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
title <- obj .| "title"
source <- obj .| "source"
pure $ Hyperdata { title,source }
title <- obj .? "title"
source <- obj .? "source"
pub_year <- obj .? "publication_year"
pure $ Hyperdata { title,source, pub_year}
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
cid <- obj .? "id"
created <- pure "2019"
--created <- obj .? "date"
favorite <- obj .? "favorite"
ngramCount <- obj .? "id"
hyperdata <- obj .? "hyperdata"
pure $ Response { cid, created, favorite, ngramCount, hyperdata }
pure $ Response { cid, favorite, ngramCount, hyperdata }
......@@ -168,7 +168,6 @@ layoutDocview = simpleSpec performAction render
void $ lift $ if fav
then putFavorites nodeId (FavoriteQuery {favorites: [nid]})
else deleteFavorites nodeId (FavoriteQuery {favorites: [nid]})
--TODO add array of delete rows here
performAction (ToggleDocumentToDelete nid) _ _ =
modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
performAction Trash {nodeId} {documentIdsToDelete} = do
......@@ -232,7 +231,7 @@ loadPage {nodeId, tabType, params: {limit, offset, orderBy}} = do
res2corpus (Response r) =
DocumentsView { _id : r.cid
, url : ""
, date : r.created
, date : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite
......@@ -299,9 +298,9 @@ renderPage loaderDispatch { totalRecords, dispatch
]
-- TODO show date: Year-Month-Day only
, if (toDelete $ DocumentsView r) then
div [ style {textDecoration : "line-through"}][text r.date]
div [ style {textDecoration : "line-through"}][text (show r.date)]
else
div [ ][text r.date]
div [ ][text (show r.date)]
, if (toDelete $ DocumentsView r) then
a [ href (toUrl Front Url_Document (Just r._id))
, style {textDecoration : "line-through"}
......@@ -329,11 +328,11 @@ pageLoader props = React.createElement pageLoaderClass props []
---------------------------------------------------------
sampleData' :: DocumentsView
sampleData' = DocumentsView {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1, delete : false}
sampleData' = DocumentsView {_id : 1, url : "", date : 2010, title : "title", source : "source", fav : false, ngramCount : 1, delete : false}
sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> DocumentsView {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10, delete : false}) sampleDocuments
sampleData = map (\(Tuple t s) -> DocumentsView {_id : 1, url : "", date : 2017, title: t, source: s, fav : false, ngramCount : 10, delete : false}) sampleDocuments
sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
......
......@@ -41,7 +41,7 @@ exports.forceLinkClass = FL.default;
}
exports.setSigmaRef = function(props) {
if (props.sigma) {
if (props && props.sigma) {
window.sigmaGargInstance = props.sigma;
}
};
......
......@@ -176,10 +176,9 @@ tableSpec = simpleSpec performAction render
defaultContainer :: {title :: String} -> TableContainerProps -> Array ReactElement
defaultContainer {title} props =
[ div [className "row"]
[ div [className "col-md-1"] [b [] [text title]]
, div [className "col-md-2"] [props.pageSizeControl]
, div [className "col-md-3"] [props.pageSizeDescription]
, div [className "col-md-3"] [props.paginationLinks]
[ div [className "col-md-4"] [props.pageSizeDescription]
, div [className "col-md-4"] [props.paginationLinks]
, div [className "col-md-4"] [props.pageSizeControl]
]
, table [ className "table"]
[ thead [className "thead-dark"] [ props.tableHead ]
......@@ -218,8 +217,9 @@ tableElt props = createElement tableClass props []
sizeDD :: PageSizes -> (Action -> Effect Unit) -> ReactElement
sizeDD ps d
= span []
[ text " "
, select [onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))] $ map (optps ps) aryPS
[ select [ className "form-control"
, onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))
] $ map (optps ps) aryPS
]
textDescription :: Int -> PageSizes -> Int -> ReactElement
......
......@@ -170,6 +170,13 @@ pathUrl c (CorpusMetrics {tabType, listId, limit}) i =
<> "?list=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
<> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path
pathUrl c (Chart {chartType, tabType}) i =
pathUrl c (NodeAPI Corpus) i <> "/" <> show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit
------------------------------------------------------------
......@@ -251,6 +258,20 @@ data Path
, listId :: ListId
, limit :: Maybe Limit
}
| Chart { chartType :: ChartType
, tabType :: TabType
-- , listId :: ListId
-- , limit :: Maybe Limit
}
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
......
module Gargantext.Pages.Corpus.Pie where
module Gargantext.Pages.Corpus.Chart.Histo where
import Data.Array (foldl)
import Data.Tuple (Tuple(..))
import Data.Map as Map
import Data.Int (toNumber)
import Data.Map (Map)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Maybe (Maybe(..), maybe)
......@@ -21,98 +22,65 @@ import Gargantext.Components.Charts.Options.Color
import Gargantext.Components.Charts.Options.Font
import Gargantext.Components.Charts.Options.Data
import Gargantext.Pages.Corpus.Dashboard (distriBySchool)
type Path =
{ corpusId :: Int
, listId :: Int
, tabType :: TabType
, limit :: Maybe Int
}
newtype Metric = Metric
{ label :: String
, x :: Number
, y :: Number
, cat :: TermList
newtype ChartMetrics = ChartMetrics
{ "data" :: HistoMetrics
}
instance decodeMetric :: DecodeJson Metric where
instance decodeChartMetrics :: DecodeJson ChartMetrics 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 }
d <- obj .? "data"
pure $ ChartMetrics { "data": d }
newtype Metrics = Metrics
{ "data" :: Array Metric
newtype HistoMetrics = HistoMetrics
{ dates :: Array String
, count :: Array Number
}
instance decodeMetrics :: DecodeJson Metrics where
instance decodeHistoMetrics :: DecodeJson HistoMetrics where
decodeJson json = do
obj <- decodeJson json
d <- obj .? "data"
pure $ Metrics { "data": d }
d <- obj .? "dates"
c <- obj .? "count"
pure $ HistoMetrics { dates : d , count: c}
type Loaded = Array Metric
type Loaded = HistoMetrics
loadedMetricsSpec :: Spec {} (Loader.InnerProps Path Loaded ()) Void
loadedMetricsSpec = simpleSpec defaultPerformAction render
where
render :: Render {} (Loader.InnerProps Path Loaded ()) Void
render dispatch {loaded} {} _ = [chart distriBySchool]
--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
, addZoom : false
render dispatch {loaded:histoMetrics} {} _ = [chart (chartOptions histoMetrics)]
chartOptions :: HistoMetrics -> Options
chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Histogram"
, subTitle : "Distribution of publications over time"
, xAxis : xAxis' dates'
, yAxis : yAxis' { position: "left", show: true }
, series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", value: n, itemStyle : itemStyle {color:grey}}) count']
, addZoom : true
, 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
--{-
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)
metricsLoader :: Loader.Props' Path HistoMetrics -> ReactElement
metricsLoader props = createElement metricsLoaderClass props []
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]
}
--}
metricsLoaderClass :: ReactClass (Loader.Props Path HistoMetrics)
metricsLoaderClass = Loader.createLoaderClass "MetricsLoader" getMetrics
getMetrics :: Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ toUrl Back (CorpusMetrics {listId, tabType, limit}) $ Just corpusId
getMetrics :: Path -> Aff HistoMetrics
getMetrics {corpusId, tabType} = do
ChartMetrics ms <- get $ toUrl Back (Chart {chartType: Histo, tabType: tabType}) $ Just corpusId
pure ms."data"
metricsLoaderClass :: ReactClass (Loader.Props Path Loaded)
metricsLoaderClass = Loader.createLoaderClass "MetricsLoader" getMetrics
metricsLoader :: Loader.Props' Path Loaded -> ReactElement
metricsLoader props = createElement metricsLoaderClass props []
pieSpec :: Spec {} Path Void
pieSpec = simpleSpec defaultPerformAction render
histoSpec :: Spec {} Path Void
histoSpec = simpleSpec defaultPerformAction render
where
render :: Render {} Path Void
render dispatch path {} _ =
......
module Gargantext.Pages.Corpus.Metrics where
module Gargantext.Pages.Corpus.Chart.Metrics where
import Data.Array (foldl)
import Data.Tuple (Tuple(..))
......
module Gargantext.Pages.Corpus.Chart.Pie where
import Data.Array (foldl, zip)
import Data.Tuple (Tuple(..))
import Data.Map as Map
import Data.Int (toNumber)
import Data.Map (Map)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Maybe (Maybe(..), maybe)
import Effect.Aff (Aff)
import Gargantext.Config -- (End(..), Path(..), TabType, toUrl)
import Gargantext.Config.REST (get)
import React (ReactClass, ReactElement, createElement)
import Thermite (Spec, Render, defaultPerformAction, simpleSpec, createClass)
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Charts.Options.ECharts
import Gargantext.Components.Charts.Options.Type
import Gargantext.Components.Charts.Options.Series
import Gargantext.Components.Charts.Options.Color
import Gargantext.Components.Charts.Options.Font
import Gargantext.Components.Charts.Options.Data
type Path =
{ corpusId :: Int
, tabType :: TabType
}
newtype ChartMetrics = ChartMetrics
{ "data" :: HistoMetrics
}
instance decodeChartMetrics :: DecodeJson ChartMetrics where
decodeJson json = do
obj <- decodeJson json
d <- obj .? "data"
pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics
{ dates :: Array String
, count :: Array Number
}
instance decodeHistoMetrics :: DecodeJson HistoMetrics where
decodeJson json = do
obj <- decodeJson json
d <- obj .? "dates"
c <- obj .? "count"
pure $ HistoMetrics { dates : d , count: c}
type Loaded = HistoMetrics
loadedMetricsSpec :: Spec {} (Loader.InnerProps Path Loaded ()) Void
loadedMetricsSpec = simpleSpec defaultPerformAction render
where
render :: Render {} (Loader.InnerProps Path Loaded ()) Void
render dispatch {loaded : metricsData} {} _ = [chart (chartOptions metricsData)]
chartOptions :: HistoMetrics -> Options
chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Bar"
, subTitle : "Count of GraphTerm"
, xAxis : xAxis' dates'
, yAxis : yAxis' { position: "left", show: true }
, series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", itemStyle: itemStyle {color:blue}, value: n }) count']
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
loadedMetricsSpecPie :: Spec {} (Loader.InnerProps Path Loaded ()) Void
loadedMetricsSpecPie = simpleSpec defaultPerformAction render
where
render :: Render {} (Loader.InnerProps Path Loaded ()) Void
render dispatch {loaded : metricsData} {} _ = [chart (chartOptionsPie metricsData)]
chartOptionsPie :: HistoMetrics -> Options
chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Pie"
, subTitle : "Distribution by GraphTerm"
, xAxis : xAxis' []
, yAxis : yAxis' { position: "", show: false }
, series : [seriesPieD1 {name: "Data"} $ map (\(Tuple n v) -> dataSerie {name: n, value:v}) $ zip dates' count']
-- , series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", value: n }) count']
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
metricsLoader :: Loader.Props' Path HistoMetrics -> ReactElement
metricsLoader props = createElement metricsLoaderClass props []
where
metricsLoaderClass :: ReactClass (Loader.Props Path HistoMetrics)
metricsLoaderClass = Loader.createLoaderClass "MetricsLoader" getMetrics
getMetrics :: Path -> Aff HistoMetrics
getMetrics {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ toUrl Back (Chart {chartType: ChartPie, tabType: tabType}) $ Just corpusId
pure ms."data"
pieSpec :: Spec {} Path Void
pieSpec = simpleSpec defaultPerformAction render
where
render :: Render {} Path Void
render dispatch path {} _ =
[ metricsLoader
{ path
, component: createClass "LoadedMetrics" loadedMetricsSpecPie (const {})
} ]
barSpec :: Spec {} Path Void
barSpec = simpleSpec defaultPerformAction render
where
render :: Render {} Path Void
render dispatch path {} _ =
[ metricsLoader
{ path
, component: createClass "LoadedMetrics" loadedMetricsSpec (const {})
} ]
module Gargantext.Pages.Corpus.Tree where
module Gargantext.Pages.Corpus.Chart.Tree where
import Data.Array (foldl)
import Data.Tuple (Tuple(..))
......@@ -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)
......
......@@ -41,7 +41,7 @@ render dispatch _ state _ = [
, subTitle : "Total scientific publications"
, xAxis : xAxis' ["2015", "2016", "2017"]
, yAxis : yAxis' { position: "left"
, show: true
, show: false
}
, series : myData
, addZoom : false
......@@ -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]]
]
]
......
......@@ -12,9 +12,10 @@ import Gargantext.Config (TabType(..), TabSubType(..))
import Gargantext.Config (CTabNgramType(..), End(..), Path(..), TabSubType(..), TabType(..), toUrl)
import Gargantext.Pages.Corpus.Tabs.Types (Props)
import Gargantext.Pages.Corpus.Metrics (metricsSpec)
import Gargantext.Pages.Corpus.Pie (pieSpec)
import Gargantext.Pages.Corpus.Tree (treeSpec)
import Gargantext.Pages.Corpus.Chart.Histo (histoSpec)
import Gargantext.Pages.Corpus.Chart.Metrics (metricsSpec)
import Gargantext.Pages.Corpus.Chart.Pie (pieSpec, barSpec)
import Gargantext.Pages.Corpus.Chart.Tree (treeSpec)
import Gargantext.Pages.Corpus.Dashboard (globalPublis)
import Gargantext.Components.NgramsTable as NT
......@@ -48,39 +49,47 @@ statefulTabs :: Spec Tab.State Props Tab.Action
statefulTabs =
Tab.tabs identity identity $ fromFoldable
[ Tuple "Documents" $ docs
, Tuple "Authors" $ ngramsViewSpec {mode: Authors }
, Tuple "Sources" $ ngramsViewSpec {mode: Sources }
, Tuple "Authors" $ ngramsViewSpec {mode: Authors }
, Tuple "Institutes" $ ngramsViewSpec {mode: Institutes}
, Tuple "Terms" $ ngramsViewSpec {mode: Terms }
, Tuple "Trash" $ trash
]
where
-- TODO totalRecords
chart = ECharts.chart globalPublis
docs = cmapProps (\{path: nodeId} ->
{nodeId, chart , tabType: TabCorpus TabDocs, totalRecords: 4736}) $
noState DT.docViewSpec
trash = cmapProps (\{path: nodeId} ->
{nodeId, chart: div [][], tabType: TabCorpus TabTrash, totalRecords: 4736}) $
noState DT.docViewSpec
docs = noState ( cmapProps (\{path: corpusId} -> {corpusId : corpusId, tabType: TabCorpus TabDocs}) histoSpec
<>
(cmapProps (\{path: nodeId} -> { nodeId : nodeId
, chart : div [][] -- ECharts.chart globalPublis
, tabType: TabCorpus TabDocs
, totalRecords: 4736}) $ noState DT.docViewSpec
)
)
trash = cmapProps (\{path: nodeId} -> { nodeId
, chart: div [][]
, tabType: TabCorpus TabTrash
, totalRecords: 4736}) $ noState DT.docViewSpec
ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action
ngramsViewSpec {mode} =
noState (
cmapProps (\{loaded: {defaultListId}, path: corpusId} ->
{corpusId, listId: defaultListId, tabType, limit: (Just 1000)}) -- TODO limit should be select in the chart by default it is 1000
(chart mode) <>
noState ( (chart mode) <>
cmapProps (\{loaded: {defaultListId}, path, dispatch} ->
{loaded: {defaultListId}, path, dispatch, tabType})
NT.mainNgramsTableSpec
)
where
tabType = TabCorpus $ TabNgramType $ modeTabType mode
chart Authors = pieSpec
chart Sources = pieSpec
chart Institutes = treeSpec
chart Terms = metricsSpec
chart Authors = cmapProps (\{path: corpusId} -> {corpusId : corpusId, tabType}) pieSpec
chart Sources = cmapProps (\{path: corpusId} -> {corpusId : corpusId, tabType}) barSpec
chart Institutes = cmapProps (\{loaded: {defaultListId}, path: corpusId} ->
{corpusId, listId: defaultListId, tabType, limit: (Just 10000)})
treeSpec
chart Terms = cmapProps (\{loaded: {defaultListId}, path: corpusId} ->
{corpusId, listId: defaultListId, tabType, limit: (Just 10000)})
-- TODO limit should be select in the chart by default it is 1000
metricsSpec
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