[FIX] removing printDebug
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / PhyloTools.hs
index 01906c18a29a0310256ec72beb8fd9f0d0727989..d4b675cb0f4640e1d4a4ec152cc75122444c88a8 100644 (file)
@@ -13,12 +13,14 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.PhyloTools where
 
 import Data.Vector (Vector, elemIndex)
-import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, maximum, group)
+import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, group)
 import Data.Set (Set, disjoint)
 import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
 import Data.String (String)
 import Data.Text (Text)
 
+import Prelude (floor)
+
 import Gargantext.Prelude
 import Gargantext.Core.Viz.AdaptativePhylo
 import Text.Printf
@@ -56,6 +58,22 @@ printIOComment cmt =
 -- | Misc | --
 --------------
 
+-- truncate' :: Double -> Int -> Double
+-- truncate' x n = (fromIntegral (floor (x * t))) / t
+--     where t = 10^n
+
+truncate' :: Double -> Int -> Double
+truncate' x n = (fromIntegral $ (floor (x * t) :: Int)) / t
+    where 
+        --------------
+        t :: Double
+        t = 10 ^n
+
+getInMap :: Int -> Map Int Double -> Double
+getInMap k m = 
+    if (member k m)
+        then m ! k
+        else 0
 
 roundToStr :: (PrintfArg a, Floating a) => Int -> a -> String
 roundToStr = printf "%0.*f"
@@ -207,12 +225,12 @@ traceFis msg mFis = trace ( "\n" <> "-- | " <> msg <> " : " <> show (sum $ map l
 getCliqueSupport :: Clique -> Int
 getCliqueSupport unit = case unit of 
     Fis s _ -> s
-    MaxClique _ -> 0
+    MaxClique _ _ _ -> 0
 
 getCliqueSize :: Clique -> Int
 getCliqueSize unit = case unit of 
     Fis _ s -> s
-    MaxClique s -> s
+    MaxClique s _ _ -> s
 
 
 --------------
@@ -277,12 +295,14 @@ filterProximity :: Proximity -> Double -> Double -> Bool
 filterProximity proximity thr local = 
     case proximity of
         WeightedLogJaccard _ -> local >= thr
+        WeightedLogSim _ -> local >= thr
         Hamming -> undefined   
 
 getProximityName :: Proximity -> String
 getProximityName proximity =
     case proximity of
         WeightedLogJaccard _ -> "WLJaccard"
+        WeightedLogSim _ -> "WeightedLogSim"
         Hamming -> "Hamming"            
 
 ---------------
@@ -326,6 +346,16 @@ getConfig :: Phylo -> Config
 getConfig phylo = (phylo ^. phylo_param) ^. phyloParam_config
 
 
+setConfig :: Config -> Phylo -> Phylo
+setConfig config phylo = phylo 
+                       & phylo_param .~ (PhyloParam 
+                                            ((phylo ^. phylo_param) ^. phyloParam_version) 
+                                            ((phylo ^. phylo_param) ^. phyloParam_software) 
+                                            config)
+
+-- & phylo_param & phyloParam_config & phyloParam_config .~ config
+
+
 getRoots :: Phylo -> Vector Ngrams
 getRoots phylo = (phylo ^. phylo_foundations) ^. foundations_roots
 
@@ -417,13 +447,13 @@ mergeMeta bId groups =
 
 groupsToBranches :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
 groupsToBranches groups =
-    -- | run the related component algorithm
+    {- run the related component algorithm -}
     let egos  = map (\g -> [getGroupId g] 
                         ++ (map fst $ g ^. phylo_groupPeriodParents)
                         ++ (map fst $ g ^. phylo_groupPeriodChilds)
                         ++ (map fst $ g ^. phylo_groupAncestors)) $ elems groups
         graph = relatedComponents egos
-    -- | update each group's branch id
+    {- update each group's branch id -}
     in map (\ids ->
         let groups' = elems $ restrictKeys groups (Set.fromList ids)
             bId = mergeBranchIds $ map (\g -> snd $ g ^. phylo_groupBranchId) groups'
@@ -446,7 +476,7 @@ toRelatedComponents nodes edges =
 
 traceSynchronyEnd :: Phylo -> Phylo
 traceSynchronyEnd phylo = 
-    trace ( "\n" <> "-- | End synchronic clustering at level " <> show (getLastLevel phylo) 
+    trace ( "-- | End synchronic clustering at level " <> show (getLastLevel phylo) 
                  <> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
                  <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
                  <> "\n" ) phylo
@@ -466,6 +496,7 @@ traceSynchronyStart phylo =
 getSensibility :: Proximity -> Double
 getSensibility proxi = case proxi of 
     WeightedLogJaccard s -> s
+    WeightedLogSim s -> s
     Hamming -> undefined
 
 ----------------