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