where
import Control.Lens hiding (makeLenses, both, Level)
-import Data.List (concat,nub,(++))
+import Data.List (concat,nub,(++),sort)
import Data.Text (Text)
import Data.Map (Map, empty, elems, unionWithKey, fromList)
import Data.Tuple (fst, snd)
import Gargantext.Prelude
import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Tools
+import Gargantext.Viz.Phylo.Metrics
import Gargantext.Viz.Phylo.View.Display
import Gargantext.Viz.Phylo.View.Filters
import Gargantext.Viz.Phylo.View.Metrics
import Gargantext.Viz.Phylo.View.Sort
import Gargantext.Viz.Phylo.View.Taggers
+import qualified Data.Vector.Storable as VS
+import Debug.Trace (trace)
+import Numeric.Statistics (percentile)
-- | To init a PhyloBranch
initPhyloBranch :: PhyloBranchId -> Text -> PhyloBranch
(getPhyloPeriods p)
empty
([] ++ (phyloToBranches lvl p))
- ([] ++ (groupsToNodes True vb (getRootsLabels p) gs))
+ ([] ++ (groupsToNodes True vb (getFoundationsRoots p) gs))
([] ++ (groupsToEdges fl PeriodEdge gs))
where
--------------------------------------
(if isV
then Just (ngramsToText ns idxs)
else Nothing)
- empty
+ (g ^. phylo_groupNgramsMeta)
+ (g ^. phylo_groupCooc)
(if (not isR)
then Just (getGroupLevelParentsId g)
else Nothing)
then v
else addChildNodes shouldDo (lvl - 1) lvlMin vb fl p
$ v & pv_branches %~ (++ (phyloToBranches (lvl - 1) p))
- & pv_nodes %~ (++ (groupsToNodes False vb (getRootsLabels p) gs'))
+ & pv_nodes %~ (++ (groupsToNodes False vb (getFoundationsRoots p) gs'))
& pv_edges %~ (++ (groupsToEdges fl PeriodEdge gs'))
& pv_edges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
& pv_edges %~ (++ (groupsToEdges Ascendant LevelEdge gs'))
-- | To transform a PhyloQuery into a PhyloView
toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
-toPhyloView q p = processDisplay (q ^. qv_display) (q ^. qv_export)
+toPhyloView q p = traceView
+ $ processDisplay (q ^. qv_display) (q ^. qv_export)
$ processSort (q ^. qv_sort ) p
$ processTaggers (q ^. qv_taggers) p
+ $ processDynamics
$ processFilters (q ^. qv_filters) p
$ processMetrics (q ^. qv_metrics) p
$ addChildNodes (q ^. qv_levelChilds) (q ^. qv_lvl) (q ^. qv_levelChildsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
--- | To get the PhyloParam of a Phylo
-getPhyloParams :: Phylo -> PhyloParam
-getPhyloParams = _phylo_param
+-----------------
+-- | Taggers | --
+-----------------
--- | To get the title of a Phylo
-getPhyloTitle :: Phylo -> Text
-getPhyloTitle p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
--- | To get the desc of a Phylo
-getPhyloDescription :: Phylo -> Text
-getPhyloDescription p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
+traceView :: PhyloView -> PhyloView
+traceView pv = trace ("------------\n--| View |--\n------------\n\n"
+ <> "view level : " <> show (pv ^. pv_level) <> "\n"
+ <> show (length $ pv ^. pv_branches) <> " exported branches with " <> show (length $ pv ^. pv_nodes) <> " groups\n"
+ <> "groups by branches : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
+ <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
+ <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
+ <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") pv
+ where
+ lst = sort $ map (fromIntegral . length . snd) $ getNodesByBranches pv
\ No newline at end of file