Revert "wip - disable debug logs for Phylo code"

This reverts commit a60a1be7.

bench/Main.hs

@@ -49,7 +49,7 @@ main = do
           whnfIO (toUserHash $ NewUser "alfredo" "alfredo@well-typed.com" (GargPassword "rabbit"))
       ]
       , bgroup "Phylo" [
-          bench "toPhylo (small)" $ nf (toPhyloWithOptions (ToPhyloOptions False) issue290PhyloSmall
+          bench "toPhylo (small)" $ nf toPhylo issue290PhyloSmall
       ]
       ]
     ]

src/Gargantext/Core/Viz/Phylo/Example.hs

@@ -41,22 +41,19 @@ phyloExport = dotToFile "/home/qlobbe/data/phylo/output/cesar_cleopatre_V2.dot"
 phyloDot :: DotGraph DotId
 phyloDot = toPhyloExport phyloCleopatre
 
-phyloOpts :: ToPhyloOptions
-phyloOpts = ToPhyloOptions True -- enable debug logs
-
 --------------------------------------------------
 -- | STEP 4 | -- Process the synchronic clustering
 --------------------------------------------------
 
 phyloCleopatre :: Phylo
-phyloCleopatre = synchronicClustering phyloOpts $ toHorizon flatPhylo
+phyloCleopatre = synchronicClustering $ toHorizon flatPhylo
 
 -----------------------------------------------
 -- | STEP 3 | -- Build the Level 1 of the Phylo
 -----------------------------------------------
 
 flatPhylo :: Phylo
-flatPhylo = temporalMatching phyloOpts (getLadder emptyPhylo') emptyPhylo'
+flatPhylo = temporalMatching (getLadder emptyPhylo') emptyPhylo'
 
 emptyPhylo' :: Phylo
 emptyPhylo' = joinRoots

src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs

@@ -11,21 +11,7 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
-module Gargantext.Core.Viz.Phylo.PhyloMaker (
-    toPhylo
-  , toPhyloWithOptions
-  , toPhyloWithoutLink
-
-  , appendGroups
-  , clusterToGroup
-  , docsToTimeScaleCooc
-  , docsToTimeScaleNb
-  , findSeaLadder
-  , groupDocsByPeriod
-  , initPhylo
-  , joinRoots
-  , toSeriesOfClustering
-  ) where
+module Gargantext.Core.Viz.Phylo.PhyloMaker where
 
 
 import Control.Lens hiding (Level)
@@ -57,23 +43,17 @@ data Phylo' = PhyloBase { _phylo'_phyloBase :: Phylo}
             | PhyloN    { _phylo'_flatPhylo :: Phylo}
 
 
-
 toPhylo' :: Phylo' -> [Document] -> TermList -> PhyloConfig -> Phylo
 toPhylo' (PhyloN    phylo) = toPhylo'
 toPhylo' (PhyloBase phylo) = toPhylo
 -}
 
-toPhylo :: Phylo -> Phylo
-toPhylo = toPhyloWithOptions (ToPhyloOptions True)
-
 -- TODO an adaptative synchronic clustering with a slider
--- FIXME(adn) Currently we emit traces from pure code(!!). This is obviously not very nice
--- and it breaks referencial transparency; we ought to fix it, but in order to smooth out
--- the compatibility story, for now we keep the status quo.
-toPhyloWithOptions :: ToPhyloOptions -> Phylo -> Phylo
-toPhyloWithOptions phyloOpts phylowithoutLink = traceToPhylo phyloOpts (phyloScale $ getConfig phylowithoutLink) $
+
+toPhylo :: Phylo -> Phylo
+toPhylo phylowithoutLink = traceToPhylo (phyloScale $ getConfig phylowithoutLink) $
     if (phyloScale $ getConfig phylowithoutLink) > 1
-      then foldl' (\phylo' _ -> synchronicClustering phyloOpts phylo') phyloAncestors [2..(phyloScale $ getConfig phylowithoutLink)]
+      then foldl' (\phylo' _ -> synchronicClustering phylo') phyloAncestors [2..(phyloScale $ getConfig phylowithoutLink)]
       else phyloAncestors
     where
         --------------------------------------
@@ -84,7 +64,7 @@ toPhyloWithOptions phyloOpts phylowithoutLink = traceToPhylo phyloOpts (phyloSca
               else phyloWithLinks
         --------------------------------------
         phyloWithLinks :: Phylo
-        phyloWithLinks = temporalMatching phyloOpts (getLadder phylowithoutLink) phylowithoutLink
+        phyloWithLinks = temporalMatching (getLadder phylowithoutLink) phylowithoutLink
         --------------------------------------
 
 

src/Gargantext/Core/Viz/Phylo/PhyloTools.hs

@@ -8,89 +8,11 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# LANGUAGE ViewPatterns              #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
-module Gargantext.Core.Viz.Phylo.PhyloTools (
-
-   -- * Types
-     ToPhyloOptions(..)
-
-  , addMemoryPointers
-  , addPointers
-  , commonPrefix
-  , coocToDiago
-  , elemIndex'
-  , filterSimilarity
-  , findDefaultLevel
-  , findMaxima
-  , getConfig
-  , getCoocByDate
-  , getDocsByDate
-  , getGroupId
-  , getGroupNgrams
-  , getGroupsFromScale
-  , getGroupsFromScalePeriods
-  , getInMap
-  , getLadder
-  , getLastLevel
-  , getLastRootsFreq
-  , getLevel
-  , getLevelParentId
-  , getMinSharedNgrams
-  , getPeriodIds
-  , getPeriodPointers
-  , getPhyloSeaRiseStart
-  , getPhyloSeaRiseSteps
-  , getRoots
-  , getRootsCountByDate
-  , getRootsFreq
-  , getSeaElevation
-  , getSimilarity
-  , getSources
-  , getTimeFrame
-  , getTimePeriod
-  , getTimeScale
-  , getTimeStep
-  , groupByField
-  , groupsToBranches'
-  , idToPrd
-  , idxToLabel
-  , idxToLabel'
-  , isNested
-  , isRoots
-  , keepFilled
-  , listToCombi'
-  , listToMatrix
-  , listToSeq
-  , mergeBranchIds
-  , mergeMeta
-  , ngramsToCooc
-  , ngramsToDensity
-  , ngramsToIdx
-  , ngramsToLabel
-  , periodsToYears
-  , phyloLastScale
-  , relatedComponents
-  , setConfig
-  , sourcesToIdx
-  , sumCooc
-  , toFstDate
-  , toLstDate
-  , toPeriods
-  , toRelatedComponents
-  , toTimeScale
-  , traceSynchronyEnd
-  , traceSynchronyStart
-  , updatePeriods
-  , updatePhyloGroups
-  , updateQuality
-
-  -- * Tracing the Phylo algorithm (deprecated, trace from pure code is bade)
-  , traceMatchEnd
-  , traceTemporalMatching
-  , traceToPhylo
-  ) where
+{-# LANGUAGE ViewPatterns      #-}
+
+module Gargantext.Core.Viz.Phylo.PhyloTools where
 
 import Control.Lens hiding (Level)
 import Data.List (union, nub, init, tail, partition, nubBy, (!!))
@@ -110,14 +32,6 @@ import Gargantext.Prelude hiding (empty)
 import Prelude (read)
 import Text.Printf
 
--- | Options to use with the 'toPhylo' function and others.
-newtype ToPhyloOptions
-  = ToPhyloOptions
-  { -- | If 'True', enable debug logs.
-    tpoptsDebugLogs :: Bool
-  } deriving (Show, Eq)
-
-
 ------------
 -- | Io | --
 ------------
@@ -141,6 +55,10 @@ 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
@@ -716,15 +634,13 @@ updateQuality quality phylo = phylo { _phylo_quality = quality }
 updateLevel :: Double -> Phylo -> Phylo
 updateLevel level phylo = phylo { _phylo_level = level }
 
-traceToPhylo :: ToPhyloOptions -> Scale -> Phylo -> Phylo
-traceToPhylo ToPhyloOptions{..} lvl phylo =
-    traceIt ("\n" <> "-- | End of phylo making at scale " <> show (lvl) <> " with "
+traceToPhylo :: Scale -> Phylo -> Phylo
+traceToPhylo lvl phylo =
+    trace ("\n" <> "-- | End of phylo making at scale " <> show (lvl) <> " with "
                 <> show (length $ getGroupsFromScale lvl phylo) <> " groups and "
                 <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale lvl phylo)
                 <> " branches" <> "\n" :: Text
           ) phylo
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
 --------------------
 -- | Clustering | --
@@ -784,25 +700,21 @@ toRelatedComponents nodes edges =
    in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters
 
 
-traceSynchronyEnd :: ToPhyloOptions -> Phylo -> Phylo
-traceSynchronyEnd ToPhyloOptions{..} phylo =
-    traceIt ( "-- | End synchronic clustering at scale " <> show (getLastLevel phylo)
+traceSynchronyEnd :: Phylo -> Phylo
+traceSynchronyEnd phylo =
+    trace ( "-- | End synchronic clustering at scale " <> show (getLastLevel phylo)
             <> " with " <> show (length $ getGroupsFromScale (getLastLevel phylo) phylo) <> " groups"
             <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale (getLastLevel phylo) phylo)
             <> " branches" <> "\n" :: Text
           ) phylo
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
-traceSynchronyStart :: ToPhyloOptions -> Phylo -> Phylo
-traceSynchronyStart ToPhyloOptions{..} phylo =
-    traceIt ( "\n" <> "-- | Start synchronic clustering at scale " <> show (getLastLevel phylo)
+traceSynchronyStart :: Phylo -> Phylo
+traceSynchronyStart phylo =
+    trace ( "\n" <> "-- | Start synchronic clustering at scale " <> show (getLastLevel phylo)
                  <> " with " <> show (length $ getGroupsFromScale (getLastLevel phylo) phylo) <> " groups"
                  <> " and "  <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromScale (getLastLevel phylo) phylo)
                  <> " branches" <> "\n" :: Text
           ) phylo
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
 
 -------------------
@@ -836,31 +748,13 @@ intersectInit acc lst lst' =
 branchIdsToSimilarity :: PhyloBranchId -> PhyloBranchId -> Double -> Double -> Double
 branchIdsToSimilarity id id' thrInit thrStep = thrInit + thrStep * (fromIntegral $ length $ intersectInit [] (snd id) (snd id'))
 
-traceMatchEnd :: ToPhyloOptions -> [PhyloGroup] -> [PhyloGroup]
-traceMatchEnd ToPhyloOptions{..} groups =
-    traceIt ("\n" <> "-- | End temporal matching with " <> show (length $ nub $ map (\g -> g ^. phylo_groupBranchId) groups)
-                                                         <> " branches and " <> show (length groups) <> " groups" <> "\n" :: Text) groups
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
-
-
-traceTemporalMatching :: ToPhyloOptions -> [PhyloGroup] -> [PhyloGroup]
-traceTemporalMatching ToPhyloOptions{..} groups =
-    traceIt ( "\n" <> "-- | Start temporal matching for " <> show(length groups) <> " groups" <> "\n" :: Text ) groups
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
-
---
--- Unused functions (remove at some point)
---
+ngramsInBranches :: [[PhyloGroup]] -> [Int]
+ngramsInBranches branches = nub $ foldl (\acc g -> acc ++ (g ^. phylo_groupNgrams)) [] $ concat branches
 
-_ngramsInBranches :: [[PhyloGroup]] -> [Int]
-_ngramsInBranches branches = nub $ foldl (\acc g -> acc ++ (g ^. phylo_groupNgrams)) [] $ concat branches
 
-
-_traceMatchSuccess :: ToPhyloOptions -> Double -> Double -> Double -> [[[PhyloGroup]]] -> [[[PhyloGroup]]]
-_traceMatchSuccess ToPhyloOptions{..} thr qua qua' nextBranches =
-    traceIt ( "\n" <> "-- local branches : "
+traceMatchSuccess :: Double -> Double -> Double -> [[[PhyloGroup]]] -> [[[PhyloGroup]]]
+traceMatchSuccess thr qua qua' nextBranches =
+    trace ( "\n" <> "-- local branches : "
             <> (Text.pack $ init $ show ((init . init . snd)
                                           $ (head' "trace" $ head' "trace" $ head' "trace" nextBranches) ^. phylo_groupBranchId))
             <> ",(1.." <> show (length nextBranches) <> ")]"
@@ -869,48 +763,50 @@ _traceMatchSuccess ToPhyloOptions{..} thr qua qua' nextBranches =
             <> " - for the local threshold "  <> show (thr)
             <> " ( quality : " <> show (qua) <> " < " <> show(qua') <> ")\n" :: Text
           ) nextBranches
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
 
-_traceMatchFailure :: ToPhyloOptions -> Double -> Double -> Double -> [[PhyloGroup]] -> [[PhyloGroup]]
-_traceMatchFailure ToPhyloOptions{..} thr qua qua' branches =
-    traceIt ( "\n" <> "-- local branches : "
+traceMatchFailure :: Double -> Double -> Double -> [[PhyloGroup]] -> [[PhyloGroup]]
+traceMatchFailure thr qua qua' branches =
+    trace ( "\n" <> "-- local branches : "
             <> (Text.pack $ init $ show ((init . snd) $ (head' "trace" $ head' "trace" branches) ^. phylo_groupBranchId))
             <> ",(1.." <> show (length branches) <> ")]"
             <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
             <> " - split with failure for the local threshold " <> show (thr)
             <> " ( quality : " <> show (qua) <> " > " <> show(qua') <> ")\n" :: Text
         ) branches
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
 
-_traceMatchNoSplit :: ToPhyloOptions -> [[PhyloGroup]] -> [[PhyloGroup]]
-_traceMatchNoSplit ToPhyloOptions{..} branches =
-    traceIt ( "\n" <> "-- local branches : "
+traceMatchNoSplit :: [[PhyloGroup]] -> [[PhyloGroup]]
+traceMatchNoSplit branches =
+    trace ( "\n" <> "-- local branches : "
             <> (Text.pack $ init $ show ((init . snd) $ (head' "trace" $ head' "trace" branches) ^. phylo_groupBranchId))
             <> ",(1.." <> show (length branches) <> ")]"
             <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
             <> " - unable to split in smaller branches" <> "\n" :: Text
         ) branches
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
 
-_traceMatchLimit :: ToPhyloOptions -> [[PhyloGroup]] -> [[PhyloGroup]]
-_traceMatchLimit ToPhyloOptions{..} branches =
-    traceIt ( "\n" <> "-- local branches : "
+traceMatchLimit :: [[PhyloGroup]] -> [[PhyloGroup]]
+traceMatchLimit branches =
+    trace ( "\n" <> "-- local branches : "
             <> (Text.pack $ init $ show ((init . snd) $ (head' "trace" $ head' "trace" branches) ^. phylo_groupBranchId))
             <> ",(1.." <> show (length branches) <> ")]"
             <> " | " <> show (length $ concat branches) <> " groups" <> "\n"
             <> " - unable to increase the threshold above 1" <> "\n" :: Text
         ) branches
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
 
-_traceGroupsProxi :: ToPhyloOptions -> [Double] -> [Double]
-_traceGroupsProxi ToPhyloOptions{..} l =
-    traceIt ( "\n" <> "-- | " <> show(List.length l) <> " computed pairs of groups Similarity" <> "\n" :: Text ) l
-  where
-    traceIt = if tpoptsDebugLogs then trace else flip const
+
+traceMatchEnd :: [PhyloGroup] -> [PhyloGroup]
+traceMatchEnd groups =
+    trace ("\n" <> "-- | End temporal matching with " <> show (length $ nub $ map (\g -> g ^. phylo_groupBranchId) groups)
+                                                         <> " branches and " <> show (length groups) <> " groups" <> "\n" :: Text) groups
+
+
+traceTemporalMatching :: [PhyloGroup] -> [PhyloGroup]
+traceTemporalMatching groups =
+    trace ( "\n" <> "-- | Start temporal matching for " <> show(length groups) <> " groups" <> "\n" :: Text ) groups
+
+
+traceGroupsProxi :: [Double] -> [Double]
+traceGroupsProxi l =
+    trace ( "\n" <> "-- | " <> show(List.length l) <> " computed pairs of groups Similarity" <> "\n" :: Text ) l

src/Gargantext/Core/Viz/Phylo/SynchronicClustering.hs

@@ -72,8 +72,8 @@ addPhyloScale lvl phylo =
                                    (PhyloScale (phyloPrd ^. phylo_periodPeriod) (phyloPrd ^. phylo_periodPeriodStr) lvl empty))) phylo
 
 
-toNextScale :: ToPhyloOptions -> Phylo -> [PhyloGroup] -> Phylo
-toNextScale opts phylo groups =
+toNextScale :: Phylo -> [PhyloGroup] -> Phylo
+toNextScale phylo groups =
     let curLvl = getLastLevel phylo
         oldGroups = fromList $ map (\g -> (getGroupId g, getLevelParentId g)) groups
         newGroups = concat $ groupsToBranches'
@@ -86,7 +86,7 @@ toNextScale opts phylo groups =
                   $ fromListWith (++) $ map (\g -> (getLevelParentId g, [g])) groups
 
         newPeriods = fromListWith (++) $ map (\g -> (g ^. phylo_groupPeriod, [g])) newGroups
-    in  traceSynchronyEnd opts
+    in  traceSynchronyEnd 
       $ over ( phylo_periods . traverse . phylo_periodScales . traverse
              --  6) update each period at curLvl + 1
              . filtered (\phyloLvl -> phyloLvl ^. phylo_scaleScale == (curLvl + 1)))
@@ -205,8 +205,8 @@ levelUpAncestors groups =
          in g & phylo_groupAncestors .~ ancestors'
       ) groups
 
-synchronicClustering :: ToPhyloOptions -> Phylo -> Phylo
-synchronicClustering opts phylo =
+synchronicClustering :: Phylo -> Phylo
+synchronicClustering phylo =
     let prox = similarity $ getConfig phylo
         sync = phyloSynchrony $ getConfig phylo
         docs = getDocsByDate phylo
@@ -215,9 +215,9 @@ synchronicClustering opts phylo =
                      $ map processDynamics
                      $ chooseClusteringStrategy sync
                      $ phyloLastScale 
-                     $ traceSynchronyStart opts phylo
+                     $ traceSynchronyStart phylo
         newBranches' = newBranches `using` parList rdeepseq
-     in toNextScale opts phylo $ levelUpAncestors $ concat newBranches'
+     in toNextScale phylo $ levelUpAncestors $ concat newBranches'
 
 
 -- synchronicDistance :: Phylo -> Level -> String

src/Gargantext/Core/Viz/Phylo/TemporalMatching.hs

@@ -679,9 +679,9 @@ seaLevelRise fdt similarity lambda minBranch frequency ladder rise frame periods
 {- 
 -- start the temporal matching process up, recover the resulting branches and update the groups (at scale 1) consequently
 -}
-temporalMatching :: ToPhyloOptions -> [Double] -> Phylo -> Phylo
-temporalMatching opts ladder phylo = updatePhyloGroups 1
-                         (Map.fromList $ map (\g -> (getGroupId g,g)) $ traceMatchEnd opts $ concat branches)
+temporalMatching :: [Double] -> Phylo -> Phylo
+temporalMatching ladder phylo = updatePhyloGroups 1
+                         (Map.fromList $ map (\g -> (getGroupId g,g)) $ traceMatchEnd $ concat branches)
                          (updateQuality quality phylo)
   where
     -------
@@ -718,4 +718,4 @@ temporalMatching opts ladder phylo = updatePhyloGroups 1
                          (getDocsByDate phylo)
                          (getCoocByDate phylo)
                          ((phylo ^. phylo_foundations) ^. foundations_rootsInGroups)
-                         (traceTemporalMatching opts $ getGroupsFromScale 1 phylo)
+                         (traceTemporalMatching $ getGroupsFromScale 1 phylo)