[FIX] TFICF condition (better implemented definition)
[gargantext.git] / src / Gargantext / Viz / Phylo / View / ViewMaker.hs
index c8001ac1066af11e5ccb514ac402d16f643fdb45..b5efaffdc2d31290e68d64b99367931afae58dfe 100644 (file)
@@ -10,15 +10,12 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 module Gargantext.Viz.Phylo.View.ViewMaker
   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)
@@ -26,13 +23,16 @@ import Data.Vector      (Vector)
 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.Export
 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
@@ -46,9 +46,11 @@ initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
 
 -- | To init a PhyloView
 initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView
-initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl empty
+initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl 
+                                    (getPhyloPeriods p)
+                                    empty
                                     ([] ++ (phyloToBranches lvl p))
-                                    ([] ++ (groupsToNodes True vb (getPeaksLabels p) gs))
+                                    ([] ++ (groupsToNodes True vb (getFoundationsRoots p) gs))
                                     ([] ++ (groupsToEdges fl PeriodEdge gs))
   where
     --------------------------------------
@@ -67,7 +69,8 @@ groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
                                               (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)
@@ -75,6 +78,7 @@ groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
                                   ) gs
 
 
+-- | To merge edges by keeping the maximum weight
 mergeEdges :: [PhyloEdge] -> [PhyloEdge] -> [PhyloEdge]
 mergeEdges lAsc lDes = elems
                      $ unionWithKey (\_k vAsc vDes -> vDes & pe_weight .~ (max (vAsc ^. pe_weight) (vDes ^. pe_weight))) mAsc mDes
@@ -82,6 +86,8 @@ mergeEdges lAsc lDes = elems
     --------------------------------------
     mAsc :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
     mAsc = fromList
+         $ map (\(k,e) -> (k, e & pe_source .~ fst k
+                                & pe_target .~ snd k))
          $ zip (map (\e -> (e ^. pe_target,e ^. pe_source)) lAsc) lAsc
     --------------------------------------
     mDes :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
@@ -119,7 +125,7 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
   then v
   else addChildNodes shouldDo (lvl - 1) lvlMin vb fl p
      $ v & pv_branches %~ (++ (phyloToBranches (lvl - 1) p))
-         & pv_nodes %~ (++ (groupsToNodes False vb (getPeaksLabels 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'))
@@ -135,9 +141,11 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
 
 -- | To transform a PhyloQuery into a PhyloView
 toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
-toPhyloView q p = processDisplay (q ^. qv_display)
+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
@@ -145,14 +153,18 @@ toPhyloView q p = processDisplay (q ^. qv_display)
 
 
 
--- | 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