[FIX] TFICF condition (better implemented definition)
[gargantext.git] / src / Gargantext / Viz / Phylo / Tools.hs
index 070edf59761368ddd1731ebdea468ad472c7e918..e8993a0d5c28da5edeb46e4eba04fd5743ad1c8f 100644 (file)
@@ -10,10 +10,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE ViewPatterns      #-}
 
 module Gargantext.Viz.Phylo.Tools
@@ -116,7 +112,6 @@ listToEqualCombi l = [(x,y) | x <- l, y <- l, x == y]
 listToPairs :: Eq a => [a] -> [(a,a)]
 listToPairs l = (listToEqualCombi l) ++ (listToUnDirectedCombi l)
 
-
 -- | To get all combinations of a list and apply a function to the resulting list of pairs
 listToDirectedCombiWith :: Eq a => forall b. (a -> b) -> [a] -> [(b,b)]
 listToDirectedCombiWith f l = [(f x,f y) | x <- l, y <- l, x /= y]
@@ -238,19 +233,23 @@ getFoundationsRoots p = (getFoundations p) ^. phylo_foundationsRoots
 -- | To get the Index of a Ngrams in the foundationsRoots of a Phylo
 getIdxInRoots :: Ngrams -> Phylo -> Int
 getIdxInRoots n p = case (elemIndex n (getFoundationsRoots p)) of
-    Nothing  -> panic "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots"
+    Nothing  -> panic $ "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots: " <> cs n
     Just idx -> idx
 
+getIdxInRoots' :: Ngrams -> Vector Ngrams -> Int
+getIdxInRoots' n root = case (elemIndex n root) of
+    Nothing  -> panic $ "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots: " <> cs n
+    Just idx -> idx    
+
 getIdxInVector :: Ngrams -> Vector Ngrams -> Int
 getIdxInVector n ns = case (elemIndex n ns) of
-  Nothing  -> panic "[ERR][Viz.Phylo.Tools.getIdxInRoots] Ngrams not in foundationsRoots"
-  Just idx -> idx 
+  Nothing  -> panic $ "[ERR][Viz.Phylo.Tools.getIdxInVector] Ngrams not in foundationsRoots: " <> cs n
+  Just idx -> idx
 
 --------------------
 -- | PhyloGroup | --
 --------------------
 
-
 -- | To alter a PhyloGroup matching a given Level
 alterGroupWithLevel :: (PhyloGroup -> PhyloGroup) -> Level -> Phylo -> Phylo
 alterGroupWithLevel f lvl p = over ( phylo_periods
@@ -261,7 +260,7 @@ alterGroupWithLevel f lvl p = over ( phylo_periods
                                    .  traverse
                                    ) (\g -> if getGroupLevel g == lvl
                                             then f g
-                                            else g ) p                          
+                                            else g ) p
 
 
 -- | To alter each list of PhyloGroups following a given function
@@ -566,6 +565,13 @@ getFisPeriod = _phyloFis_period
 ----------------------------
 
 
+-- | To alter a PhyloNode
+alterPhyloNode :: (PhyloNode -> PhyloNode) -> PhyloView -> PhyloView
+alterPhyloNode f v = over ( pv_nodes
+                          .  traverse
+                          ) (\pn ->  f pn ) v
+
+
 -- | To filter some GroupEdges with a given threshold
 filterGroupEdges :: Double -> [GroupEdge] -> [GroupEdge]
 filterGroupEdges thr edges = filter (\((_s,_t),w) -> w > thr) edges
@@ -592,6 +598,10 @@ getNodeId :: PhyloNode -> PhyloGroupId
 getNodeId n = n ^. pn_id
 
 
+getNodePeriod :: PhyloNode -> (Date,Date)
+getNodePeriod n = fst $ fst $ getNodeId n
+
+
 -- | To get the Level of a PhyloNode
 getNodeLevel :: PhyloNode -> Level
 getNodeLevel n = (snd . fst) $ getNodeId n
@@ -800,7 +810,7 @@ getProximity cluster = case cluster of
 
 -- | To initialize all the Cluster / Proximity with their default parameters
 initFis :: Maybe Bool -> Maybe Support -> Maybe Int -> FisParams
-initFis (def True -> kmf) (def 1 -> min') (def 1 -> thr) = FisParams kmf min' thr
+initFis (def True -> kmf) (def 0 -> min') (def 0 -> thr) = FisParams kmf min' thr
 
 initHamming :: Maybe Double -> HammingParams
 initHamming (def 0.01 -> sens) = HammingParams sens
@@ -818,17 +828,26 @@ initLouvain :: Maybe Proximity -> LouvainParams
 initLouvain (def defaultWeightedLogJaccard -> proxi) = LouvainParams proxi
 
 initRelatedComponents :: Maybe Proximity -> RCParams
-initRelatedComponents (def Filiation -> proxi) = RCParams proxi
+initRelatedComponents (def defaultWeightedLogJaccard -> proxi) = RCParams proxi
 
+-- | TODO user param in main function
 initWeightedLogJaccard :: Maybe Double -> Maybe Double -> WLJParams
-initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
+initWeightedLogJaccard (def 0.3 -> thr) (def 20.0 -> sens) = WLJParams thr sens
 
 
 -- | To initialize a PhyloQueryBuild from given and default parameters
-initPhyloQueryBuild :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Int -> Maybe Double -> Maybe Double -> Maybe Int -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
-initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
-  (def defaultWeightedLogJaccard -> matching') (def 5 -> frame) (def 0.8 -> frameThr) (def 0.5 -> reBranchThr) (def 4 -> reBranchNth) (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
-    PhyloQueryBuild name desc grain steps cluster metrics filters matching' frame frameThr reBranchThr reBranchNth nthLevel nthCluster
+initPhyloQueryBuild :: Text          -> Text            -> Maybe Int
+                    -> Maybe Int     -> Maybe Cluster   -> Maybe [Metric]
+                    -> Maybe [Filter]-> Maybe Proximity -> Maybe Int
+                    -> Maybe Double  -> Maybe Double    -> Maybe Int
+                    -> Maybe Level   -> Maybe Cluster   -> PhyloQueryBuild
+initPhyloQueryBuild name desc (def 5 -> grain)
+                    (def 1 -> steps)      (def defaultFis -> cluster) (def [] -> metrics)
+                    (def [] -> filters)   (def defaultWeightedLogJaccard -> matching') (def 5 -> frame)
+                    (def 0.8 -> frameThr) (def 0.5 -> reBranchThr) (def 4 -> reBranchNth)
+                    (def 2 -> nthLevel)   (def defaultRelatedComponents -> nthCluster) =
+    PhyloQueryBuild name  desc    grain
+                    steps cluster metrics filters matching' frame frameThr reBranchThr reBranchNth nthLevel nthCluster
 
 
 -- | To initialize a PhyloQueryView default parameters