Commit 1167c256 authored by qlobbe's avatar qlobbe

new logs

parent 881d5bab
Pipeline #599 canceled with stage
......@@ -167,9 +167,7 @@ main = do
printIOMsg "End of reconstruction, start the export"
let dot = toPhyloExport phylo
printIOMsg "##########################"
let dot = toPhyloExport phylo
let output = (outputPath config)
<> (unpack $ phyloName config)
......
......@@ -36,6 +36,7 @@ import System.FilePath
import Debug.Trace (trace)
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified Data.Text.Lazy as Lazy
import qualified Data.GraphViz.Attributes.HTML as H
......@@ -159,7 +160,8 @@ exportToDot :: Phylo -> PhyloExport -> DotGraph DotId
exportToDot phylo export =
trace ("\n-- | Convert " <> show(length $ export ^. export_branches) <> " branches and "
<> 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
-- | 1) init the dot graph
......@@ -463,20 +465,30 @@ toPhyloExport phylo = exportToDot phylo
export = PhyloExport groups branches
--------------------------------------
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 = traceExportGroups
$ processDynamics
$ getGroupsFromLevel (phyloLevel $ getConfig phylo) phylo
$ getGroupsFromLevel (phyloLevel $ getConfig phylo)
$ tracePhyloInfo phylo
traceExportBranches :: [PhyloBranch] -> [PhyloBranch]
traceExportBranches branches = trace ("\n"
<> "-- | 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 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"
) groups
......@@ -149,13 +149,15 @@ filterFisByNested m =
-- | 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 phyloDocs support clique = traceFis "Filtered Fis"
$ filterFisByNested
$ traceFis "Filtered by clique size"
toPhyloFis phyloDocs support clique =
-- traceFis "Filtered Fis"
filterFisByNested
-- $ traceFis "Filtered by clique size"
$ filterFis True clique (filterFisByClique)
$ traceFis "Filtered by support"
-- $ traceFis "Filtered by support"
$ filterFis True support (filterFisBySupport)
$ traceFis "Unfiltered Fis" phyloFis
-- $ traceFis "Unfiltered Fis"
phyloFis
where
--------------------------------------
phyloFis :: Map (Date,Date) [PhyloCUnit]
......
......@@ -25,7 +25,7 @@ import Gargantext.Viz.Phylo.PhyloTools
-- import Prelude (logBase)
import Control.Lens hiding (Level)
import Control.Parallel.Strategies (parList, rdeepseq, using)
import Debug.Trace (trace)
-- import Debug.Trace (trace)
import qualified Data.Set as Set
......@@ -209,8 +209,9 @@ getCandidates fil ego targets =
phyloBranchMatching :: Int -> [PhyloPeriodId] -> Proximity -> Double -> Map Date Double -> [PhyloGroup] -> [PhyloGroup]
phyloBranchMatching frame periods proximity thr docs branch = traceBranchMatching proximity thr
$ matchByPeriods
phyloBranchMatching frame periods proximity thr docs branch =
-- traceBranchMatching proximity thr
matchByPeriods
$ groupByField _phylo_groupPeriod branch
where
--------------------------------------
......@@ -298,16 +299,18 @@ seqMatching proximity beta frequency minBranch egoThr frame docs periods done eg
-- | 1) keep or not the new division of ego
let done' = done ++ (if snd ego
then (if ((null (fst ego')) || (quality > quality'))
then trace (" ✗ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
<> " | " <> show(length $ fst ego) <> " groups : "
<> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego')
<> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]")
$ [(fst ego,False)]
else trace (" ✓ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
<> " | " <> show(length $ fst ego) <> " groups : "
<> " |✓ " <> 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'))))
then
-- trace (" ✗ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
-- <> " | " <> show(length $ fst ego) <> " groups : "
-- <> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego')
-- <> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]")
[(fst ego,False)]
else
-- trace (" ✓ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
-- <> " | " <> show(length $ fst ego) <> " groups : "
-- <> " |✓ " <> 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])
in
-- | 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