]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Viz/Phylo/View/ViewMaker.hs
[Merge] dev -> dev-phylo ready
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / View / ViewMaker.hs
1 {-|
2 Module : Gargantext.Core.Viz.Phylo.Tools
3 Description : Phylomemy Tools to build/manage it
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10
11 -}
12
13
14 module Gargantext.Core.Viz.Phylo.View.ViewMaker
15 where
16
17 import Control.Lens hiding (makeLenses, both, Level)
18 import Data.List (concat,nub,(++),sort)
19 import Data.Text (Text)
20 import Data.Map (Map, empty, elems, unionWithKey, fromList)
21 import Data.Tuple (fst, snd)
22 import Data.Vector (Vector)
23 import Gargantext.Prelude
24 import Gargantext.Core.Viz.Phylo
25 import Gargantext.Core.Viz.Phylo.Tools
26 import Gargantext.Core.Viz.Phylo.Metrics
27 import Gargantext.Core.Viz.Phylo.View.Display
28 import Gargantext.Core.Viz.Phylo.View.Filters
29 import Gargantext.Core.Viz.Phylo.View.Metrics
30 import Gargantext.Core.Viz.Phylo.View.Sort
31 import Gargantext.Core.Viz.Phylo.View.Taggers
32
33 import qualified Data.Vector.Storable as VS
34 import Debug.Trace (trace)
35 import Numeric.Statistics (percentile)
36
37 -- | To init a PhyloBranch
38 initPhyloBranch :: PhyloBranchId -> Text -> PhyloBranch
39 initPhyloBranch id lbl = PhyloBranch id lbl empty
40
41
42 -- | To init a PhyloEdge
43 initPhyloEdge :: PhyloGroupId -> [Pointer] -> EdgeType -> [PhyloEdge]
44 initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
45
46
47 -- | To init a PhyloView
48 initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView
49 initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl
50 (getPhyloPeriods p)
51 empty
52 ([] ++ (phyloToBranches lvl p))
53 ([] ++ (groupsToNodes True vb (getFoundationsRoots p) gs))
54 ([] ++ (groupsToEdges fl PeriodEdge gs))
55 where
56 --------------------------------------
57 gs :: [PhyloGroup]
58 gs = getGroupsWithLevel lvl p
59 --------------------------------------
60
61
62 -- | To transform a list of PhyloGroups into a list of PhyloNodes
63 groupsToNodes :: Bool -> Bool -> Vector Ngrams -> [PhyloGroup] -> [PhyloNode]
64 groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
65 in PhyloNode
66 (getGroupId g)
67 (getGroupBranchId g)
68 "" idxs
69 (if isV
70 then Just (ngramsToText ns idxs)
71 else Nothing)
72 (g ^. phylo_groupNgramsMeta)
73 (g ^. phylo_groupCooc)
74 (if (not isR)
75 then Just (getGroupLevelParentsId g)
76 else Nothing)
77 []
78 ) gs
79
80
81 -- | To merge edges by keeping the maximum weight
82 mergeEdges :: [PhyloEdge] -> [PhyloEdge] -> [PhyloEdge]
83 mergeEdges lAsc lDes = elems
84 $ unionWithKey (\_k vAsc vDes -> vDes & pe_weight .~ (max (vAsc ^. pe_weight) (vDes ^. pe_weight))) mAsc mDes
85 where
86 --------------------------------------
87 mAsc :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
88 mAsc = fromList
89 $ map (\(k,e) -> (k, e & pe_source .~ fst k
90 & pe_target .~ snd k))
91 $ zip (map (\e -> (e ^. pe_target,e ^. pe_source)) lAsc) lAsc
92 --------------------------------------
93 mDes :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
94 mDes = fromList
95 $ zip (map (\e -> (e ^. pe_source,e ^. pe_target)) lDes) lDes
96 --------------------------------------
97
98
99 -- | To transform a list of PhyloGroups into a list of PhyloEdges
100 groupsToEdges :: Filiation -> EdgeType -> [PhyloGroup] -> [PhyloEdge]
101 groupsToEdges fl et gs = case fl of
102 Complete -> (groupsToEdges Ascendant et gs) ++ (groupsToEdges Descendant et gs)
103 Merge -> mergeEdges (groupsToEdges Ascendant et gs) (groupsToEdges Descendant et gs)
104 _ -> concat
105 $ map (\g -> case fl of
106 Ascendant -> case et of
107 PeriodEdge -> initPhyloEdge (getGroupId g) (getGroupPeriodParents g) et
108 LevelEdge -> initPhyloEdge (getGroupId g) (getGroupLevelParents g) et
109 Descendant -> case et of
110 PeriodEdge -> initPhyloEdge (getGroupId g) (getGroupPeriodChilds g) et
111 LevelEdge -> initPhyloEdge (getGroupId g) (getGroupLevelChilds g) et
112 _Type -> panic "[ERR][Viz.Phylo.View.ViewMaker.groupsToEdges] not implemented"
113 ) gs
114
115
116 -- | To transform a Phylo into a list of PhyloBranch for a given Level
117 phyloToBranches :: Level -> Phylo -> [PhyloBranch]
118 phyloToBranches lvl p = map (\id -> initPhyloBranch id "") $ nub $ getBranchIdsWith lvl p
119
120
121 -- | To add recursively a list of PhyloNodes and Edges to PhyloView from a given Level and Depth
122 addChildNodes :: Bool -> Level -> Level -> Bool -> Filiation -> Phylo -> PhyloView -> PhyloView
123 addChildNodes shouldDo lvl lvlMin vb fl p v =
124 if (not shouldDo) || (lvl == lvlMin)
125 then v
126 else addChildNodes shouldDo (lvl - 1) lvlMin vb fl p
127 $ v & pv_branches %~ (++ (phyloToBranches (lvl - 1) p))
128 & pv_nodes %~ (++ (groupsToNodes False vb (getFoundationsRoots p) gs'))
129 & pv_edges %~ (++ (groupsToEdges fl PeriodEdge gs'))
130 & pv_edges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
131 & pv_edges %~ (++ (groupsToEdges Ascendant LevelEdge gs'))
132 where
133 --------------------------------------
134 gs :: [PhyloGroup]
135 gs = getGroupsWithLevel lvl p
136 --------------------------------------
137 gs' :: [PhyloGroup]
138 gs' = getGroupsWithLevel (lvl - 1) p
139 --------------------------------------
140
141
142 -- | To transform a PhyloQuery into a PhyloView
143 toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
144 toPhyloView q p = traceView
145 $ processDisplay (q ^. qv_display) (q ^. qv_export)
146 $ processSort (q ^. qv_sort ) p
147 $ processTaggers (q ^. qv_taggers) p
148 $ processDynamics
149 $ processFilters (q ^. qv_filters) p
150 $ processMetrics (q ^. qv_metrics) p
151 $ addChildNodes (q ^. qv_levelChilds) (q ^. qv_lvl) (q ^. qv_levelChildsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
152 $ initPhyloView (q ^. qv_lvl) (getPhyloTitle p) (getPhyloDescription p) (q ^. qv_filiation) (q ^. qv_verbose) p
153
154
155
156 -----------------
157 -- | Taggers | --
158 -----------------
159
160
161 traceView :: PhyloView -> PhyloView
162 traceView pv = trace ("------------\n--| View |--\n------------\n\n"
163 <> "view level : " <> show (pv ^. pv_level) <> "\n"
164 <> show (length $ pv ^. pv_branches) <> " exported branches with " <> show (length $ pv ^. pv_nodes) <> " groups\n"
165 <> "groups by branches : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
166 <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
167 <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
168 <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") pv
169 where
170 lst = sort $ map (fromIntegral . length . snd) $ getNodesByBranches pv