Commit 1167c256 authored by qlobbe's avatar qlobbe

new logs

parent 881d5bab
Pipeline #599 canceled with stage
...@@ -169,8 +169,6 @@ main = do ...@@ -169,8 +169,6 @@ main = do
let dot = toPhyloExport phylo let dot = toPhyloExport phylo
printIOMsg "##########################"
let output = (outputPath config) let output = (outputPath config)
<> (unpack $ phyloName config) <> (unpack $ phyloName config)
<> "_V2.dot" <> "_V2.dot"
......
...@@ -36,6 +36,7 @@ import System.FilePath ...@@ -36,6 +36,7 @@ import System.FilePath
import Debug.Trace (trace) import Debug.Trace (trace)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import qualified Data.GraphViz.Attributes.HTML as H import qualified Data.GraphViz.Attributes.HTML as H
...@@ -159,7 +160,8 @@ exportToDot :: Phylo -> PhyloExport -> DotGraph DotId ...@@ -159,7 +160,8 @@ exportToDot :: Phylo -> PhyloExport -> DotGraph DotId
exportToDot phylo export = exportToDot phylo export =
trace ("\n-- | Convert " <> show(length $ export ^. export_branches) <> " branches and " trace ("\n-- | Convert " <> show(length $ export ^. export_branches) <> " branches and "
<> show(length $ export ^. export_groups) <> " groups " <> show(length $ export ^. export_groups) <> " groups "
<> show(length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) $ export ^. export_groups) <> " terms to a dot file\n") $ <> show(length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) $ export ^. export_groups) <> " terms to a dot file\n\n"
<> "##########################") $
digraph ((Str . fromStrict) $ (phyloName $ getConfig phylo)) $ do digraph ((Str . fromStrict) $ (phyloName $ getConfig phylo)) $ do
-- | 1) init the dot graph -- | 1) init the dot graph
...@@ -463,20 +465,30 @@ toPhyloExport phylo = exportToDot phylo ...@@ -463,20 +465,30 @@ toPhyloExport phylo = exportToDot phylo
export = PhyloExport groups branches export = PhyloExport groups branches
-------------------------------------- --------------------------------------
branches :: [PhyloBranch] branches :: [PhyloBranch]
branches = traceExportBranches $ map (\bId -> PhyloBranch bId "" empty) $ nub $ map _phylo_groupBranchId groups branches = map (\bId -> PhyloBranch bId "" empty) $ nub $ map _phylo_groupBranchId groups
-------------------------------------- --------------------------------------
groups :: [PhyloGroup] groups :: [PhyloGroup]
groups = traceExportGroups groups = traceExportGroups
$ processDynamics $ processDynamics
$ getGroupsFromLevel (phyloLevel $ getConfig phylo) phylo $ getGroupsFromLevel (phyloLevel $ getConfig phylo)
$ tracePhyloInfo phylo
traceExportBranches :: [PhyloBranch] -> [PhyloBranch] traceExportBranches :: [PhyloBranch] -> [PhyloBranch]
traceExportBranches branches = trace ("\n" traceExportBranches branches = trace ("\n"
<> "-- | Export " <> show(length branches) <> " branches") branches <> "-- | Export " <> show(length branches) <> " branches") branches
tracePhyloInfo :: Phylo -> Phylo
tracePhyloInfo phylo = trace ("\n" <> "##########################" <> "\n\n" <> "-- | Phylo with β = "
<> show(_qua_granularity $ phyloQuality $ getConfig phylo) <> " applied to "
<> show(length $ Vector.toList $ getRoots phylo) <> " foundations"
) phylo
traceExportGroups :: [PhyloGroup] -> [PhyloGroup] traceExportGroups :: [PhyloGroup] -> [PhyloGroup]
traceExportGroups groups = trace ("\n" <> "##########################" <> "\n\n" <> "-- | Export " <> show(length groups) <> " groups and " traceExportGroups groups = trace ("\n" <> "-- | Export "
<> show(length $ nub $ map (\g -> g ^. phylo_groupBranchId) groups) <> " branches, "
<> show(length groups) <> " groups and "
<> show(length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) groups) <> " terms" <> show(length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) groups) <> " terms"
) groups ) groups
...@@ -149,13 +149,15 @@ filterFisByNested m = ...@@ -149,13 +149,15 @@ filterFisByNested m =
-- | To transform a time map of docs innto a time map of Fis with some filters -- | To transform a time map of docs innto a time map of Fis with some filters
toPhyloFis :: Map (Date, Date) [Document] -> Int -> Int -> Map (Date,Date) [PhyloCUnit] toPhyloFis :: Map (Date, Date) [Document] -> Int -> Int -> Map (Date,Date) [PhyloCUnit]
toPhyloFis phyloDocs support clique = traceFis "Filtered Fis" toPhyloFis phyloDocs support clique =
$ filterFisByNested -- traceFis "Filtered Fis"
$ traceFis "Filtered by clique size" filterFisByNested
-- $ traceFis "Filtered by clique size"
$ filterFis True clique (filterFisByClique) $ filterFis True clique (filterFisByClique)
$ traceFis "Filtered by support" -- $ traceFis "Filtered by support"
$ filterFis True support (filterFisBySupport) $ filterFis True support (filterFisBySupport)
$ traceFis "Unfiltered Fis" phyloFis -- $ traceFis "Unfiltered Fis"
phyloFis
where where
-------------------------------------- --------------------------------------
phyloFis :: Map (Date,Date) [PhyloCUnit] phyloFis :: Map (Date,Date) [PhyloCUnit]
......
...@@ -25,7 +25,7 @@ import Gargantext.Viz.Phylo.PhyloTools ...@@ -25,7 +25,7 @@ import Gargantext.Viz.Phylo.PhyloTools
-- import Prelude (logBase) -- import Prelude (logBase)
import Control.Lens hiding (Level) import Control.Lens hiding (Level)
import Control.Parallel.Strategies (parList, rdeepseq, using) import Control.Parallel.Strategies (parList, rdeepseq, using)
import Debug.Trace (trace) -- import Debug.Trace (trace)
import qualified Data.Set as Set import qualified Data.Set as Set
...@@ -209,8 +209,9 @@ getCandidates fil ego targets = ...@@ -209,8 +209,9 @@ getCandidates fil ego targets =
phyloBranchMatching :: Int -> [PhyloPeriodId] -> Proximity -> Double -> Map Date Double -> [PhyloGroup] -> [PhyloGroup] phyloBranchMatching :: Int -> [PhyloPeriodId] -> Proximity -> Double -> Map Date Double -> [PhyloGroup] -> [PhyloGroup]
phyloBranchMatching frame periods proximity thr docs branch = traceBranchMatching proximity thr phyloBranchMatching frame periods proximity thr docs branch =
$ matchByPeriods -- traceBranchMatching proximity thr
matchByPeriods
$ groupByField _phylo_groupPeriod branch $ groupByField _phylo_groupPeriod branch
where where
-------------------------------------- --------------------------------------
...@@ -298,16 +299,18 @@ seqMatching proximity beta frequency minBranch egoThr frame docs periods done eg ...@@ -298,16 +299,18 @@ seqMatching proximity beta frequency minBranch egoThr frame docs periods done eg
-- | 1) keep or not the new division of ego -- | 1) keep or not the new division of ego
let done' = done ++ (if snd ego let done' = done ++ (if snd ego
then (if ((null (fst ego')) || (quality > quality')) then (if ((null (fst ego')) || (quality > quality'))
then trace (" ✗ F(β) = " <> show(quality) <> " (vs) " <> show(quality') then
<> " | " <> show(length $ fst ego) <> " groups : " -- trace (" ✗ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
<> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego') -- <> " | " <> show(length $ fst ego) <> " groups : "
<> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]") -- <> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego')
$ [(fst ego,False)] -- <> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]")
else trace (" ✓ F(β) = " <> show(quality) <> " (vs) " <> show(quality') [(fst ego,False)]
<> " | " <> show(length $ fst ego) <> " groups : " else
<> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego') -- trace (" ✓ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
<> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]") -- <> " | " <> show(length $ fst ego) <> " groups : "
$ ((map (\e -> (e,True)) (fst ego')) ++ (map (\e -> (e,False)) (snd ego')))) -- <> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego')
-- <> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]")
((map (\e -> (e,True)) (fst ego')) ++ (map (\e -> (e,False)) (snd ego'))))
else [ego]) else [ego])
in in
-- | 2) if there is no more branches in rest then return else continue -- | 2) if there is no more branches in rest then return else continue
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment