]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/Tools.hs
Missing file
[gargantext.git] / src / Gargantext / Viz / Phylo / Tools.hs
1 {-|
2 Module : Gargantext.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 {-# LANGUAGE FlexibleContexts #-}
14 {-# LANGUAGE NoImplicitPrelude #-}
15 {-# LANGUAGE OverloadedStrings #-}
16 {-# LANGUAGE RankNTypes #-}
17 {-# LANGUAGE ViewPatterns #-}
18
19 module Gargantext.Viz.Phylo.Tools
20 where
21
22 import Control.Lens hiding (both, Level, Empty)
23 import Data.List (filter, intersect, (++), sort, null, tail, last, tails, delete, nub, concat, sortOn)
24 import Data.Maybe (mapMaybe,fromMaybe)
25 import Data.Map (Map, mapKeys, member, (!))
26 import Data.Set (Set)
27 import Data.Text (Text, toLower)
28 import Data.Tuple.Extra
29 import Data.Vector (Vector,elemIndex)
30 import Gargantext.Prelude
31 import Gargantext.Viz.Phylo
32 import qualified Data.Map as Map
33 import qualified Data.Set as Set
34 import qualified Data.Vector as Vector
35
36
37 --------------
38 -- | Misc | --
39 --------------
40
41
42 -- | Define a default value
43 def :: a -> Maybe a -> a
44 def = fromMaybe
45
46
47 -- | Does a List of Sets contains at least one Set of an other List
48 doesAnySetContains :: Eq a => Set a -> [Set a] -> [Set a] -> Bool
49 doesAnySetContains h l l' = any (\c -> doesContains (Set.toList c) (Set.toList h)) (l' ++ l)
50
51
52 -- | Does a list of A contains an other list of A
53 doesContains :: Eq a => [a] -> [a] -> Bool
54 doesContains l l'
55 | null l' = True
56 | length l' > length l = False
57 | elem (head' "doesContains" l') l = doesContains l (tail l')
58 | otherwise = False
59
60
61 -- | Does a list of ordered A contains an other list of ordered A
62 doesContainsOrd :: Eq a => Ord a => [a] -> [a] -> Bool
63 doesContainsOrd l l'
64 | null l' = False
65 | last l < (head' "doesContainsOrd" l') = False
66 | (head' "doesContainsOrd" l') `elem` l = True
67 | otherwise = doesContainsOrd l (tail l')
68
69
70 -- | To filter nested Sets of a
71 filterNestedSets :: Eq a => Set a -> [Set a] -> [Set a] -> [Set a]
72 filterNestedSets h l l'
73 | null l = if doesAnySetContains h l l'
74 then l'
75 else h : l'
76 | doesAnySetContains h l l' = filterNestedSets (head' "filterNestedSets1" l) (tail l) l'
77 | otherwise = filterNestedSets (head' "filterNestedSets2" l) (tail l) (h : l')
78
79
80
81 -- | To get the good pair of keys (x,y) or (y,x) in a given Map (a,b) c
82 getKeyPair :: (Int,Int) -> Map (Int,Int) a -> (Int,Int)
83 getKeyPair (x,y) m = case findPair (x,y) m of
84 Nothing -> panic "[ERR][Viz.Phylo.Example.getKeyPair] Nothing"
85 Just i -> i
86 where
87 --------------------------------------
88 findPair :: (Int,Int) -> Map (Int,Int) a -> Maybe (Int,Int)
89 findPair (x',y') m'
90 | member (x',y') m' = Just (x',y')
91 | member (y',x') m' = Just (y',x')
92 | otherwise = Nothing
93 --------------------------------------
94
95
96 -- | To filter Fis with small Support but by keeping non empty Periods
97 keepFilled :: (Int -> [a] -> [a]) -> Int -> [a] -> [a]
98 keepFilled f thr l = if (null $ f thr l) && (not $ null l)
99 then keepFilled f (thr - 1) l
100 else f thr l
101
102
103 -- | To get all combinations of a list
104 listToDirectedCombi :: Eq a => [a] -> [(a,a)]
105 listToDirectedCombi l = [(x,y) | x <- l, y <- l, x /= y]
106
107
108 -- | To get all combinations of a list and apply a function to the resulting list of pairs
109 listToDirectedCombiWith :: Eq a => forall b. (a -> b) -> [a] -> [(b,b)]
110 listToDirectedCombiWith f l = [(f x,f y) | x <- l, y <- l, x /= y]
111
112
113 -- | To get all combinations of a list with no repetition
114 listToUnDirectedCombi :: [a] -> [(a,a)]
115 listToUnDirectedCombi l = [ (x,y) | (x:rest) <- tails l, y <- rest ]
116
117
118 -- | To get all combinations of a list with no repetition and apply a function to the resulting list of pairs
119 listToUnDirectedCombiWith :: forall a b. (a -> b) -> [a] -> [(b,b)]
120 listToUnDirectedCombiWith f l = [ (f x, f y) | (x:rest) <- tails l, y <- rest ]
121
122
123 -- | To unify the keys (x,y) that Map 1 share with Map 2 such as: (x,y) <=> (y,x)
124 unifySharedKeys :: Eq a => Ord a => Map (a,a) b -> Map (a,a) b -> Map (a,a) b
125 unifySharedKeys m1 m2 = mapKeys (\(x,y) -> if member (y,x) m2
126 then (y,x)
127 else (x,y) ) m1
128
129
130 ---------------
131 -- | Phylo | --
132 ---------------
133
134
135 -- | An analyzer ingests a Ngrams and generates a modified version of it
136 phyloAnalyzer :: Ngrams -> Ngrams
137 phyloAnalyzer n = toLower n
138
139 -- | To init the foundation of the Phylo as a Vector of Ngrams
140 initFoundations :: [Ngrams] -> Vector Ngrams
141 initFoundations l = Vector.fromList $ map phyloAnalyzer l
142
143 -- | To init the base of a Phylo from a List of Periods and Foundations
144 initPhyloBase :: [(Date, Date)] -> Vector Ngrams -> PhyloPeaks -> PhyloParam -> Phylo
145 initPhyloBase pds fds pks prm = Phylo ((fst . (head' "initPhyloBase")) pds, (snd . last) pds) fds pks (map (\pd -> initPhyloPeriod pd []) pds) prm
146
147 -- | To init the param of a Phylo
148 initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQueryBuild -> PhyloParam
149 initPhyloParam (def defaultPhyloVersion -> v)
150 (def defaultSoftware -> s)
151 (def defaultQueryBuild -> q) = PhyloParam v s q
152
153 -- | To get the foundations of a Phylo
154 getFoundations :: Phylo -> Vector Ngrams
155 getFoundations = _phylo_foundations
156
157 -- | To get the Index of a Ngrams in the Foundations of a Phylo
158 getIdxInFoundations :: Ngrams -> Phylo -> Int
159 getIdxInFoundations n p = case (elemIndex n (getFoundations p)) of
160 Nothing -> panic "[ERR][Viz.Phylo.Tools.getIdxInFoundations] Ngrams not in Foundations"
161 Just idx -> idx
162
163
164 -- | To get the last computed Level in a Phylo
165 getLastLevel :: Phylo -> Level
166 getLastLevel p = (last . sort)
167 $ map (snd . getPhyloLevelId)
168 $ view ( phylo_periods
169 . traverse
170 . phylo_periodLevels ) p
171
172
173 --------------------
174 -- | PhyloPeaks | --
175 --------------------
176
177 -- | To apply a fonction to each label of a Ngrams Tree
178 alterLabels :: (Ngrams -> Ngrams) -> Tree Ngrams -> Tree Ngrams
179 alterLabels f (Node lbl ns) = Node (f lbl) (map (\n -> alterLabels f n) ns)
180 alterLabels _ Empty = panic "[ERR][Viz.Phylo.Tools.alterLabels] Empty"
181
182 -- | To transform a forest of trees into a map (node,root)
183 forestToMap :: [Tree Ngrams] -> Map Ngrams Ngrams
184 forestToMap trees = Map.fromList $ concat $ map treeToTuples' trees
185 where
186 treeToTuples' (Node lbl ns) = treeToTuples (Node lbl ns) lbl
187 treeToTuples' Empty = panic "[ERR][Viz.Phylo.Tools.forestToMap] Empty"
188
189 -- | To get the foundationsPeaks of a Phylo
190 getPeaks :: Phylo -> PhyloPeaks
191 getPeaks = _phylo_foundationsPeaks
192
193 -- | To get the peaksLabels of a Phylo
194 getPeaksLabels :: Phylo -> Vector Ngrams
195 getPeaksLabels p = (getPeaks p) ^. phylo_peaksLabels
196
197 -- | To get the Index of a Ngrams in the foundationsPeaks of a Phylo
198 getIdxInPeaks :: Ngrams -> Phylo -> Int
199 getIdxInPeaks n p = case (elemIndex n (getPeaksLabels p)) of
200 Nothing -> panic "[ERR][Viz.Phylo.Tools.getIdxInPeaks] Ngrams not in foundationsPeaks"
201 Just idx -> idx
202
203 -- | To init the PhyloPeaks of a Phylo
204 initPeaks :: [Tree Ngrams] -> Vector Ngrams -> PhyloPeaks
205 initPeaks trees ns = PhyloPeaks labels trees
206 where
207 --------------------------------------
208 labels :: Vector Ngrams
209 labels = Vector.fromList
210 $ nub
211 $ Vector.toList
212 $ map (\n -> if member n mTrees
213 then mTrees Map.! n
214 else n ) ns
215 --------------------------------------
216 mTrees :: Map Ngrams Ngrams
217 mTrees = forestToMap trees
218 --------------------------------------
219
220 -- | To transform a Ngrams Tree into a list of (node,root)
221 treeToTuples :: Tree Ngrams -> Ngrams -> [(Ngrams,Ngrams)]
222 treeToTuples (Node lbl ns) root = [(lbl,root)] ++ (concat $ map (\n -> treeToTuples n root) ns)
223 treeToTuples Empty _ = panic "[ERR][Viz.Phylo.Tools.treeToTuples] Empty"
224
225 --------------------
226 -- | PhyloGroup | --
227 --------------------
228
229
230 -- | To alter a PhyloGroup matching a given Level
231 alterGroupWithLevel :: (PhyloGroup -> PhyloGroup) -> Level -> Phylo -> Phylo
232 alterGroupWithLevel f lvl p = over ( phylo_periods
233 . traverse
234 . phylo_periodLevels
235 . traverse
236 . phylo_levelGroups
237 . traverse
238 ) (\g -> if getGroupLevel g == lvl
239 then f g
240 else g ) p
241
242
243 -- | To alter each list of PhyloGroups following a given function
244 alterPhyloGroups :: ([PhyloGroup] -> [PhyloGroup]) -> Phylo -> Phylo
245 alterPhyloGroups f p = over ( phylo_periods
246 . traverse
247 . phylo_periodLevels
248 . traverse
249 . phylo_levelGroups
250 ) f p
251
252
253 -- | To filter the PhyloGroup of a Phylo according to a function and a value
254 filterGroups :: Eq a => (PhyloGroup -> a) -> a -> [PhyloGroup] -> [PhyloGroup]
255 filterGroups f x l = filter (\g -> (f g) == x) l
256
257
258 -- | To maybe get the PhyloBranchId of a PhyloGroup
259 getGroupBranchId :: PhyloGroup -> Maybe PhyloBranchId
260 getGroupBranchId = _phylo_groupBranchId
261
262
263 -- | To get the PhyloGroups Childs of a PhyloGroup
264 getGroupChilds :: PhyloGroup -> Phylo -> [PhyloGroup]
265 getGroupChilds g p = getGroupsFromIds (getGroupPeriodChildsId g) p
266
267
268 -- | To get the id of a PhyloGroup
269 getGroupId :: PhyloGroup -> PhyloGroupId
270 getGroupId = _phylo_groupId
271
272
273 -- | To get the Cooc Matrix of a PhyloGroup
274 getGroupCooc :: PhyloGroup -> Map (Int,Int) Double
275 getGroupCooc = _phylo_groupCooc
276
277
278 -- | To get the level out of the id of a PhyloGroup
279 getGroupLevel :: PhyloGroup -> Int
280 getGroupLevel = snd . fst . getGroupId
281
282
283 -- | To get the level child pointers of a PhyloGroup
284 getGroupLevelChilds :: PhyloGroup -> [Pointer]
285 getGroupLevelChilds = _phylo_groupLevelChilds
286
287
288 -- | To get the PhyloGroups Level Childs Ids of a PhyloGroup
289 getGroupLevelChildsId :: PhyloGroup -> [PhyloGroupId]
290 getGroupLevelChildsId g = map fst $ getGroupLevelChilds g
291
292
293 -- | To get the level parent pointers of a PhyloGroup
294 getGroupLevelParents :: PhyloGroup -> [Pointer]
295 getGroupLevelParents = _phylo_groupLevelParents
296
297
298 -- | To get the PhyloGroups Level Parents Ids of a PhyloGroup
299 getGroupLevelParentsId :: PhyloGroup -> [PhyloGroupId]
300 getGroupLevelParentsId g = map fst $ getGroupLevelParents g
301
302
303 -- | To get the Ngrams of a PhyloGroup
304 getGroupNgrams :: PhyloGroup -> [Int]
305 getGroupNgrams = _phylo_groupNgrams
306
307
308 -- | To get the list of pairs (Childs & Parents) of a PhyloGroup
309 getGroupPairs :: PhyloGroup -> Phylo -> [PhyloGroup]
310 getGroupPairs g p = (getGroupChilds g p) ++ (getGroupParents g p)
311
312
313 -- | To get the PhyloGroups Parents of a PhyloGroup
314 getGroupParents :: PhyloGroup -> Phylo -> [PhyloGroup]
315 getGroupParents g p = getGroupsFromIds (getGroupPeriodParentsId g) p
316
317
318 -- | To get the period out of the id of a PhyloGroup
319 getGroupPeriod :: PhyloGroup -> (Date,Date)
320 getGroupPeriod = fst . fst . getGroupId
321
322
323 -- | To get the period child pointers of a PhyloGroup
324 getGroupPeriodChilds :: PhyloGroup -> [Pointer]
325 getGroupPeriodChilds = _phylo_groupPeriodChilds
326
327
328 -- | To get the PhyloGroups Period Parents Ids of a PhyloGroup
329 getGroupPeriodChildsId :: PhyloGroup -> [PhyloGroupId]
330 getGroupPeriodChildsId g = map fst $ getGroupPeriodChilds g
331
332
333 -- | To get the period parent pointers of a PhyloGroup
334 getGroupPeriodParents :: PhyloGroup -> [Pointer]
335 getGroupPeriodParents = _phylo_groupPeriodParents
336
337
338 -- | To get the PhyloGroups Period Parents Ids of a PhyloGroup
339 getGroupPeriodParentsId :: PhyloGroup -> [PhyloGroupId]
340 getGroupPeriodParentsId g = map fst $ getGroupPeriodParents g
341
342
343 -- | To get all the PhyloGroup of a Phylo
344 getGroups :: Phylo -> [PhyloGroup]
345 getGroups = view ( phylo_periods
346 . traverse
347 . phylo_periodLevels
348 . traverse
349 . phylo_levelGroups
350 )
351
352
353 -- | To get all PhyloGroups matching a list of PhyloGroupIds in a Phylo
354 getGroupsFromIds :: [PhyloGroupId] -> Phylo -> [PhyloGroup]
355 getGroupsFromIds ids p = filter (\g -> elem (getGroupId g) ids) $ getGroups p
356
357
358 -- | To get the corresponding list of PhyloGroups from a list of PhyloNodes
359 getGroupsFromNodes :: [PhyloNode] -> Phylo -> [PhyloGroup]
360 getGroupsFromNodes ns p = getGroupsFromIds (map getNodeId ns) p
361
362
363 -- | To get all the PhyloGroup of a Phylo with a given level and period
364 getGroupsWithFilters :: Int -> (Date,Date) -> Phylo -> [PhyloGroup]
365 getGroupsWithFilters lvl prd p = (getGroupsWithLevel lvl p)
366 `intersect`
367 (getGroupsWithPeriod prd p)
368
369
370 -- | To get all the PhyloGroup of a Phylo with a given Level
371 getGroupsWithLevel :: Int -> Phylo -> [PhyloGroup]
372 getGroupsWithLevel lvl p = filterGroups getGroupLevel lvl (getGroups p)
373
374
375 -- | To get all the PhyloGroup of a Phylo with a given Period
376 getGroupsWithPeriod :: (Date,Date) -> Phylo -> [PhyloGroup]
377 getGroupsWithPeriod prd p = filterGroups getGroupPeriod prd (getGroups p)
378
379
380 -- | To create a PhyloGroup in a Phylo out of a list of Ngrams and a set of parameters
381 initGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> Phylo -> PhyloGroup
382 initGroup ngrams lbl idx lvl from' to' p = PhyloGroup
383 (((from', to'), lvl), idx)
384 lbl
385 (sort $ map (\x -> getIdxInPeaks x p) ngrams)
386 (Map.empty)
387 (Map.empty)
388 Nothing
389 [] [] [] []
390
391
392 ---------------------
393 -- | PhyloPeriod | --
394 ---------------------
395
396
397 -- | To alter each PhyloPeriod of a Phylo following a given function
398 alterPhyloPeriods :: (PhyloPeriod -> PhyloPeriod) -> Phylo -> Phylo
399 alterPhyloPeriods f p = over ( phylo_periods
400 . traverse) f p
401
402
403 -- | To append a list of PhyloPeriod to a Phylo
404 appendToPhyloPeriods :: [PhyloPeriod] -> Phylo -> Phylo
405 appendToPhyloPeriods l p = over (phylo_periods) (++ l) p
406
407
408 -- | To get all the PhyloPeriodIds of a Phylo
409 getPhyloPeriods :: Phylo -> [PhyloPeriodId]
410 getPhyloPeriods p = map _phylo_periodId
411 $ view (phylo_periods) p
412
413
414 -- | To get the id of a given PhyloPeriod
415 getPhyloPeriodId :: PhyloPeriod -> PhyloPeriodId
416 getPhyloPeriodId prd = _phylo_periodId prd
417
418
419 -- | To create a PhyloPeriod
420 initPhyloPeriod :: PhyloPeriodId -> [PhyloLevel] -> PhyloPeriod
421 initPhyloPeriod id l = PhyloPeriod id l
422
423
424 --------------------
425 -- | PhyloLevel | --
426 --------------------
427
428
429 -- | To alter a list of PhyloLevels following a given function
430 alterPhyloLevels :: ([PhyloLevel] -> [PhyloLevel]) -> Phylo -> Phylo
431 alterPhyloLevels f p = over ( phylo_periods
432 . traverse
433 . phylo_periodLevels) f p
434
435
436 -- | To get the PhylolevelId of a given PhyloLevel
437 getPhyloLevelId :: PhyloLevel -> PhyloLevelId
438 getPhyloLevelId = _phylo_levelId
439
440
441 -- | To get all the Phylolevels of a given PhyloPeriod
442 getPhyloLevels :: PhyloPeriod -> [PhyloLevel]
443 getPhyloLevels = view (phylo_periodLevels)
444
445
446 -- | To create a PhyloLevel
447 initPhyloLevel :: PhyloLevelId -> [PhyloGroup] -> PhyloLevel
448 initPhyloLevel id groups = PhyloLevel id groups
449
450
451 -- | To set the LevelId of a PhyloLevel and of all its PhyloGroups
452 setPhyloLevelId :: Int -> PhyloLevel -> PhyloLevel
453 setPhyloLevelId lvl' (PhyloLevel (id, _lvl) groups)
454 = PhyloLevel (id, lvl') groups'
455 where
456 groups' = over (traverse . phylo_groupId)
457 (\((period, _lvl), idx) -> ((period, lvl'), idx))
458 groups
459
460
461 ------------------
462 -- | PhyloFis | --
463 ------------------
464
465
466 -- | To get the clique of a PhyloFis
467 getClique :: PhyloFis -> Clique
468 getClique = _phyloFis_clique
469
470 -- | To get the metrics of a PhyloFis
471 getFisMetrics :: PhyloFis -> Map (Int,Int) (Map Text [Double])
472 getFisMetrics = _phyloFis_metrics
473
474 -- | To get the support of a PhyloFis
475 getSupport :: PhyloFis -> Support
476 getSupport = _phyloFis_support
477
478
479 ----------------------------
480 -- | PhyloNodes & Edges | --
481 ----------------------------
482
483
484 -- | To filter some GroupEdges with a given threshold
485 filterGroupEdges :: Double -> GroupEdges -> GroupEdges
486 filterGroupEdges thr edges = filter (\((_s,_t),w) -> w > thr) edges
487
488
489 -- | To get the neighbours (directed/undirected) of a PhyloGroup from a list of GroupEdges
490 getNeighbours :: Bool -> PhyloGroup -> GroupEdges -> [PhyloGroup]
491 getNeighbours directed g e = case directed of
492 True -> map (\((_s,t),_w) -> t)
493 $ filter (\((s,_t),_w) -> s == g) e
494 False -> map (\((s,t),_w) -> (head' "getNeighbours") $ delete g $ nub [s,t,g])
495 $ filter (\((s,t),_w) -> s == g || t == g) e
496
497
498 -- | To get the PhyloBranchId of PhyloNode if it exists
499 getNodeBranchId :: PhyloNode -> PhyloBranchId
500 getNodeBranchId n = case n ^. pn_bid of
501 Nothing -> panic "[ERR][Viz.Phylo.Tools.getNodeBranchId] branchId not found"
502 Just i -> i
503
504
505 -- | To get the PhyloGroupId of a PhyloNode
506 getNodeId :: PhyloNode -> PhyloGroupId
507 getNodeId n = n ^. pn_id
508
509
510 -- | To get the Level of a PhyloNode
511 getNodeLevel :: PhyloNode -> Level
512 getNodeLevel n = (snd . fst) $ getNodeId n
513
514
515 -- | To get the Parent Node of a PhyloNode in a PhyloView
516 getNodeParent :: PhyloNode -> PhyloView -> [PhyloNode]
517 getNodeParent n v = filter (\n' -> elem (getNodeId n') (getNodeParentsId n))
518 $ v ^. pv_nodes
519
520
521 -- | To get the Parent Node id of a PhyloNode if it exists
522 getNodeParentsId :: PhyloNode -> [PhyloGroupId]
523 getNodeParentsId n = case n ^. pn_parents of
524 Nothing -> panic "[ERR][Viz.Phylo.Tools.getNodeParentsId] node parent not found"
525 Just ids -> ids
526
527
528 -- | To get a list of PhyloNodes grouped by PhyloBranch in a PhyloView
529 getNodesByBranches :: PhyloView -> [(PhyloBranchId,[PhyloNode])]
530 getNodesByBranches v = zip bIds $ map (\id -> filter (\n -> (getNodeBranchId n) == id)
531 $ getNodesInBranches v ) bIds
532 where
533 --------------------------------------
534 bIds :: [PhyloBranchId]
535 bIds = getViewBranchIds v
536 --------------------------------------
537
538
539 -- | To get a list of PhyloNodes owned by any PhyloBranches in a PhyloView
540 getNodesInBranches :: PhyloView -> [PhyloNode]
541 getNodesInBranches v = filter (\n -> isJust $ n ^. pn_bid)
542 $ v ^. pv_nodes
543
544
545 -- | To get the PhyloGroupId of the Source of a PhyloEdge
546 getSourceId :: PhyloEdge -> PhyloGroupId
547 getSourceId e = e ^. pe_source
548
549
550 -- | To get the PhyloGroupId of the Target of a PhyloEdge
551 getTargetId :: PhyloEdge -> PhyloGroupId
552 getTargetId e = e ^. pe_target
553
554
555 ---------------------
556 -- | PhyloBranch | --
557 ---------------------
558
559
560 -- | To get the PhyloBranchId of a PhyloBranch
561 getBranchId :: PhyloBranch -> PhyloBranchId
562 getBranchId b = b ^. pb_id
563
564
565 -- | To get a list of PhyloBranchIds given a Level in a Phylo
566 getBranchIdsWith :: Level -> Phylo -> [PhyloBranchId]
567 getBranchIdsWith lvl p = sortOn snd
568 $ mapMaybe getGroupBranchId
569 $ getGroupsWithLevel lvl p
570
571
572 -- | To get the Meta value of a PhyloBranch
573 getBranchMeta :: Text -> PhyloBranch -> [Double]
574 getBranchMeta k b = (b ^. pb_metrics) ! k
575
576
577 -- | To get all the PhyloBranchIds of a PhyloView
578 getViewBranchIds :: PhyloView -> [PhyloBranchId]
579 getViewBranchIds v = map getBranchId $ v ^. pv_branches
580
581
582 --------------------------------
583 -- | PhyloQuery & QueryView | --
584 --------------------------------
585
586 -- | To get the first clustering method to apply to get the contextual units of a Phylo
587 getContextualUnit :: PhyloQueryBuild -> Cluster
588 getContextualUnit q = q ^. q_contextualUnit
589
590
591 -- | To get the metrics to apply to contextual units
592 getContextualUnitMetrics :: PhyloQueryBuild -> [Metric]
593 getContextualUnitMetrics q = q ^. q_contextualUnitMetrics
594
595
596 -- | To get the filters to apply to contextual units
597 getContextualUnitFilters :: PhyloQueryBuild -> [Filter]
598 getContextualUnitFilters q = q ^. q_contextualUnitFilters
599
600
601 -- | To get the cluster methods to apply to the Nths levels of a Phylo
602 getNthCluster :: PhyloQueryBuild -> Cluster
603 getNthCluster q = q ^. q_nthCluster
604
605
606 -- | To get the Sup Level of a reconstruction of a Phylo from a PhyloQuery
607 getNthLevel :: PhyloQueryBuild -> Level
608 getNthLevel q = q ^. q_nthLevel
609
610
611 -- | To get the Grain of the PhyloPeriods from a PhyloQuery
612 getPeriodGrain :: PhyloQueryBuild -> Int
613 getPeriodGrain q = q ^. q_periodGrain
614
615
616 -- | To get the intertemporal matching strategy to apply to a Phylo from a PhyloQuery
617 getInterTemporalMatching :: PhyloQueryBuild -> Proximity
618 getInterTemporalMatching q = q ^. q_interTemporalMatching
619
620
621 -- | To get the Steps of the PhyloPeriods from a PhyloQuery
622 getPeriodSteps :: PhyloQueryBuild -> Int
623 getPeriodSteps q = q ^. q_periodSteps
624
625
626 --------------------------------------------------
627 -- | PhyloQueryBuild & PhyloQueryView Constructors | --
628 --------------------------------------------------
629
630
631 -- | To get the Proximity associated to a given Clustering method
632 getProximity :: Cluster -> Proximity
633 getProximity cluster = case cluster of
634 Louvain (LouvainParams proxi) -> proxi
635 RelatedComponents (RCParams proxi) -> proxi
636 _ -> panic "[ERR][Viz.Phylo.Tools.getProximity] this cluster has no associated Proximity"
637
638
639 -- | To initialize all the Cluster / Proximity with their default parameters
640 initFis :: Maybe Bool -> Maybe Support -> FisParams
641 initFis (def True -> kmf) (def 1 -> min') = FisParams kmf min'
642
643 initHamming :: Maybe Double -> HammingParams
644 initHamming (def 0.01 -> sens) = HammingParams sens
645
646 initSmallBranch :: Maybe Int -> Maybe Int -> Maybe Int -> SBParams
647 initSmallBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = SBParams periodsInf periodsSup minNodes
648
649 initLouvain :: Maybe Proximity -> LouvainParams
650 initLouvain (def defaultWeightedLogJaccard -> proxi) = LouvainParams proxi
651
652 initRelatedComponents :: Maybe Proximity -> RCParams
653 initRelatedComponents (def Filiation -> proxi) = RCParams proxi
654
655 initWeightedLogJaccard :: Maybe Double -> Maybe Double -> WLJParams
656 initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
657
658
659 -- | To initialize a PhyloQuery from given and default parameters
660 initPhyloQueryBuild :: Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
661 initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
662 (def defaultWeightedLogJaccard -> matching') (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
663 PhyloQueryBuild name' desc' grain steps cluster metrics filters matching' nthLevel nthCluster
664 where
665 name' = maybe "Phylo Title" identity name
666 desc' = maybe "Phylo Desc" identity desc
667
668
669
670 -- | To initialize a PhyloQueryView default parameters
671 initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
672 initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Flat -> dm) (def True -> v) =
673 PhyloQueryView lvl f c d ms fs ts s dm v
674
675
676 -- | To define some obvious boolean getters
677 shouldKeepMinorFis :: FisParams -> Bool
678 shouldKeepMinorFis = _fis_keepMinorFis
679
680 ----------------------------
681 -- | Default ressources | --
682 ----------------------------
683
684 -- Clusters
685
686 defaultFis :: Cluster
687 defaultFis = Fis (initFis Nothing Nothing)
688
689 defaultLouvain :: Cluster
690 defaultLouvain = Louvain (initLouvain Nothing)
691
692 defaultRelatedComponents :: Cluster
693 defaultRelatedComponents = RelatedComponents (initRelatedComponents Nothing)
694
695 -- Filters
696
697 defaultSmallBranch :: Filter
698 defaultSmallBranch = SmallBranch (initSmallBranch Nothing Nothing Nothing)
699
700 -- Params
701
702 defaultPhyloParam :: PhyloParam
703 defaultPhyloParam = initPhyloParam Nothing Nothing Nothing
704
705 -- Proximities
706
707 defaultHamming :: Proximity
708 defaultHamming = Hamming (initHamming Nothing)
709
710 defaultWeightedLogJaccard :: Proximity
711 defaultWeightedLogJaccard = WeightedLogJaccard (initWeightedLogJaccard Nothing Nothing)
712
713 -- Queries
714
715 defaultQueryBuild :: PhyloQueryBuild
716 defaultQueryBuild = initPhyloQueryBuild (Just "Cesar et Cleôpatre")
717 (Just "An example of Phylomemy (french without accent)")
718 Nothing Nothing Nothing
719 Nothing Nothing Nothing
720 Nothing Nothing
721
722 defaultQueryView :: PhyloQueryView
723 defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
724
725 -- Software
726
727 defaultSoftware :: Software
728 defaultSoftware = Software "Gargantext" "v4"
729
730 -- Version
731
732 defaultPhyloVersion :: Text
733 defaultPhyloVersion = "v1"
734