{-| Module : Gargantext.Viz.Phylo.PhyloExport Description : Exportation module of a Phylo Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} module Gargantext.Viz.Phylo.PhyloExport where import Data.Map (Map, fromList, empty, fromListWith, insert, (!), elems, unionWith, findWithDefault, toList) import Data.List ((++), sort, nub, concat, sortOn, reverse, groupBy, union, (\\), (!!), init, partition, unwords, nubBy, inits, elemIndex) import Data.Vector (Vector) import Prelude (writeFile) import Gargantext.Prelude import Gargantext.Viz.AdaptativePhylo import Gargantext.Viz.Phylo.PhyloTools import Control.Lens import Data.GraphViz hiding (DotGraph, Order) import Data.GraphViz.Types.Generalised (DotGraph) import Data.GraphViz.Attributes.Complete hiding (EdgeType, Order) import Data.GraphViz.Types.Monadic import Data.Text.Lazy (fromStrict, pack, unpack) import System.FilePath import Debug.Trace (trace) import qualified Data.Map as Map 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 -------------------- -- | Dot export | -- -------------------- dotToFile :: FilePath -> DotGraph DotId -> IO () dotToFile filePath dotG = writeFile filePath $ dotToString dotG dotToString :: DotGraph DotId -> [Char] dotToString dotG = unpack (printDotGraph dotG) dynamicToColor :: Double -> H.Attribute dynamicToColor d | d == 0 = H.BGColor (toColor LightCoral) | d == 1 = H.BGColor (toColor Khaki) | d == 2 = H.BGColor (toColor SkyBlue) | otherwise = H.Color (toColor Black) pickLabelColor :: [Double] -> H.Attribute pickLabelColor lst | elem 0 lst = dynamicToColor 0 | elem 2 lst = dynamicToColor 2 | elem 1 lst = dynamicToColor 1 | otherwise = dynamicToColor 3 toDotLabel :: Text.Text -> Label toDotLabel lbl = StrLabel $ fromStrict lbl toAttr :: AttributeName -> Lazy.Text -> CustomAttribute toAttr k v = customAttribute k v metaToAttr :: Map Text.Text [Double] -> [CustomAttribute] metaToAttr meta = map (\(k,v) -> toAttr (fromStrict k) $ (pack . unwords) $ map show v) $ toList meta groupIdToDotId :: PhyloGroupId -> DotId groupIdToDotId (((d,d'),lvl),idx) = (fromStrict . Text.pack) $ ("group" <> (show d) <> (show d') <> (show lvl) <> (show idx)) branchIdToDotId :: PhyloBranchId -> DotId branchIdToDotId bId = (fromStrict . Text.pack) $ ("branch" <> show (snd bId)) periodIdToDotId :: PhyloPeriodId -> DotId periodIdToDotId prd = (fromStrict . Text.pack) $ ("period" <> show (fst prd) <> show (snd prd)) groupToTable :: Vector Ngrams -> PhyloGroup -> H.Label groupToTable fdt g = H.Table H.HTable { H.tableFontAttrs = Just [H.PointSize 14, H.Align H.HLeft] , H.tableAttrs = [H.Border 0, H.CellBorder 0, H.BGColor (toColor White)] , H.tableRows = [header] <> [H.Cells [H.LabelCell [H.Height 10] $ H.Text [H.Str $ fromStrict ""]]] <> ( map ngramsToRow $ splitEvery 4 $ reverse $ sortOn (snd . snd) $ zip (ngramsToText fdt (g ^. phylo_groupNgrams)) $ zip ((g ^. phylo_groupMeta) ! "dynamics") ((g ^. phylo_groupMeta) ! "inclusion"))} where -------------------------------------- ngramsToRow :: [(Ngrams,(Double,Double))] -> H.Row ngramsToRow ns = H.Cells $ map (\(n,(d,_)) -> H.LabelCell [H.Align H.HLeft,dynamicToColor d] $ H.Text [H.Str $ fromStrict n]) ns -------------------------------------- header :: H.Row header = H.Cells [ H.LabelCell [pickLabelColor ((g ^. phylo_groupMeta) ! "dynamics")] $ H.Text [H.Str $ (((fromStrict . Text.toUpper) $ g ^. phylo_groupLabel) <> (fromStrict " ( ") <> (pack $ show (fst $ g ^. phylo_groupPeriod)) <> (fromStrict " , ") <> (pack $ show (snd $ g ^. phylo_groupPeriod)) <> (fromStrict " ) ") <> (pack $ show (getGroupId g)))]] -------------------------------------- branchToDotNode :: PhyloBranch -> Int -> Dot DotId branchToDotNode b bId = node (branchIdToDotId $ b ^. branch_id) ([FillColor [toWColor CornSilk], FontName "Arial", FontSize 40, Shape Egg, Style [SItem Bold []], Label (toDotLabel $ b ^. branch_label)] <> (metaToAttr $ b ^. branch_meta) <> [ toAttr "nodeType" "branch" , toAttr "bId" (pack $ show bId) , toAttr "branchId" (pack $ unwords (map show $ snd $ b ^. branch_id)) , toAttr "branch_x" (fromStrict $ Text.pack $ (show $ b ^. branch_x)) , toAttr "branch_y" (fromStrict $ Text.pack $ (show $ b ^. branch_y)) , toAttr "label" (pack $ show $ b ^. branch_label) ]) periodToDotNode :: (Date,Date) -> Dot DotId periodToDotNode prd = node (periodIdToDotId prd) ([Shape BoxShape, FontSize 50, Label (toDotLabel $ Text.pack (show (fst prd) <> " " <> show (snd prd)))] <> [ toAttr "nodeType" "period" , toAttr "from" (fromStrict $ Text.pack $ (show $ fst prd)) , toAttr "to" (fromStrict $ Text.pack $ (show $ snd prd))]) groupToDotNode :: Vector Ngrams -> PhyloGroup -> Int -> Dot DotId groupToDotNode fdt g bId = node (groupIdToDotId $ getGroupId g) ([FontName "Arial", Shape Square, penWidth 4, toLabel (groupToTable fdt g)] <> [ toAttr "nodeType" "group" , toAttr "from" (pack $ show (fst $ g ^. phylo_groupPeriod)) , toAttr "to" (pack $ show (snd $ g ^. phylo_groupPeriod)) , toAttr "branchId" (pack $ unwords (init $ map show $ snd $ g ^. phylo_groupBranchId)) , toAttr "bId" (pack $ show bId) , toAttr "support" (pack $ show (g ^. phylo_groupSupport))]) toDotEdge :: DotId -> DotId -> Text.Text -> EdgeType -> Dot DotId toDotEdge source target lbl edgeType = edge source target (case edgeType of GroupToGroup -> [ Width 3, penWidth 4, Color [toWColor Black], Constraint True , Label (StrLabel $ fromStrict lbl)] <> [toAttr "edgeType" "link" ] BranchToGroup -> [ Width 3, Color [toWColor Black], ArrowHead (AType [(ArrMod FilledArrow RightSide,DotArrow)]) , Label (StrLabel $ fromStrict lbl)] <> [toAttr "edgeType" "branchLink" ] BranchToBranch -> [ Width 2, Color [toWColor Black], Style [SItem Dashed []], ArrowHead (AType [(ArrMod FilledArrow BothSides,DotArrow)]) , Label (StrLabel $ fromStrict lbl)] PeriodToPeriod -> [ Width 5, Color [toWColor Black]]) mergePointers :: [PhyloGroup] -> Map (PhyloGroupId,PhyloGroupId) Double mergePointers groups = let toChilds = fromList $ concat $ map (\g -> map (\(target,w) -> ((getGroupId g,target),w)) $ g ^. phylo_groupPeriodChilds) groups toParents = fromList $ concat $ map (\g -> map (\(target,w) -> ((getGroupId g,target),w)) $ g ^. phylo_groupPeriodParents) groups in unionWith (\w w' -> max w w') toChilds toParents toBid :: PhyloGroup -> [PhyloBranch] -> Int toBid g bs = let b' = head' "toBid" (filter (\b -> b ^. branch_id == g ^. phylo_groupBranchId) bs) in fromJust $ elemIndex b' bs 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\n" <> "##########################") $ digraph ((Str . fromStrict) $ (phyloName $ getConfig phylo)) $ do -- | 1) init the dot graph graphAttrs ( [ Label (toDotLabel $ (phyloName $ getConfig phylo))] <> [ FontSize 30, LabelLoc VTop, NodeSep 1, RankSep [1], Rank SameRank, Splines SplineEdges, Overlap ScaleOverlaps , Ratio FillRatio , Style [SItem Filled []],Color [toWColor White]] -- | home made attributes <> [(toAttr (fromStrict "phyloFoundations") $ pack $ show (length $ Vector.toList $ getRoots phylo)) ,(toAttr (fromStrict "phyloTerms") $ pack $ show (length $ nub $ concat $ map (\g -> g ^. phylo_groupNgrams) $ export ^. export_groups)) ,(toAttr (fromStrict "phyloDocs") $ pack $ show (sum $ elems $ phylo ^. phylo_timeDocs)) ,(toAttr (fromStrict "phyloPeriods") $ pack $ show (length $ elems $ phylo ^. phylo_periods)) ,(toAttr (fromStrict "phyloBranches") $ pack $ show (length $ export ^. export_branches)) ,(toAttr (fromStrict "phyloGroups") $ pack $ show (length $ export ^. export_groups)) ]) -- toAttr (fromStrict k) $ (pack . unwords) $ map show v -- | 2) create a layer for the branches labels subgraph (Str "Branches peaks") $ do graphAttrs [Rank SameRank] -- | 3) group the branches by hierarchy -- mapM (\branches -> -- subgraph (Str "Branches clade") $ do -- graphAttrs [Rank SameRank] -- -- | 4) create a node for each branch -- mapM branchToDotNode branches -- ) $ elems $ fromListWith (++) $ map (\b -> ((init . snd) $ b ^. branch_id,[b])) $ export ^. export_branches mapM (\b -> branchToDotNode b (fromJust $ elemIndex b (export ^. export_branches))) $ export ^. export_branches -- | 5) create a layer for each period _ <- mapM (\period -> subgraph ((Str . fromStrict . Text.pack) $ ("Period" <> show (fst period) <> show (snd period))) $ do graphAttrs [Rank SameRank] periodToDotNode period -- | 6) create a node for each group mapM (\g -> groupToDotNode (getRoots phylo) g (toBid g (export ^. export_branches))) (filter (\g -> g ^. phylo_groupPeriod == period) $ export ^. export_groups) ) $ getPeriodIds phylo -- | 7) create the edges between a branch and its first groups _ <- mapM (\(bId,groups) -> mapM (\g -> toDotEdge (branchIdToDotId bId) (groupIdToDotId $ getGroupId g) "" BranchToGroup) groups ) $ toList $ map (\groups -> head' "toDot" $ groupBy (\g g' -> g' ^. phylo_groupPeriod == g ^. phylo_groupPeriod) $ sortOn (fst . _phylo_groupPeriod) groups) $ fromListWith (++) $ map (\g -> (g ^. phylo_groupBranchId,[g])) $ export ^. export_groups -- | 8) create the edges between the groups _ <- mapM (\((k,k'),_) -> toDotEdge (groupIdToDotId k) (groupIdToDotId k') "" GroupToGroup ) $ (toList . mergePointers) $ export ^. export_groups -- | 7) create the edges between the periods _ <- mapM (\(prd,prd') -> toDotEdge (periodIdToDotId prd) (periodIdToDotId prd') "" PeriodToPeriod ) $ nubBy (\combi combi' -> fst combi == fst combi') $ listToCombi' $ getPeriodIds phylo -- | 8) create the edges between the branches -- _ <- mapM (\(bId,bId') -> -- toDotEdge (branchIdToDotId bId) (branchIdToDotId bId') -- (Text.pack $ show(branchIdsToProximity bId bId' -- (getThresholdInit $ phyloProximity $ getConfig phylo) -- (getThresholdStep $ phyloProximity $ getConfig phylo))) BranchToBranch -- ) $ nubBy (\combi combi' -> fst combi == fst combi') $ listToCombi' $ map _branch_id $ export ^. export_branches graphAttrs [Rank SameRank] ---------------- -- | Filter | -- ---------------- filterByBranchSize :: Double -> PhyloExport -> PhyloExport filterByBranchSize thr export = let branches' = partition (\b -> head' "filter" ((b ^. branch_meta) ! "size") >= thr) $ export ^. export_branches in export & export_branches .~ (fst branches') & export_groups %~ (filter (\g -> not $ elem (g ^. phylo_groupBranchId) (map _branch_id $ snd branches'))) processFilters :: [Filter] -> Quality -> PhyloExport -> PhyloExport processFilters filters qua export = foldl (\export' f -> case f of ByBranchSize thr -> if (thr < (fromIntegral $ qua ^. qua_minBranch)) then filterByBranchSize (fromIntegral $ qua ^. qua_minBranch) export' else filterByBranchSize thr export' ) export filters -------------- -- | Sort | -- -------------- branchToIso :: [PhyloBranch] -> [PhyloBranch] branchToIso branches = let steps = map sum $ inits $ map (\(b,x) -> b ^. branch_y + 0.05 - x) $ zip branches $ ([0] ++ (map (\(b,b') -> let idx = length $ commonPrefix (b ^. branch_canonId) (b' ^. branch_canonId) [] in (b' ^. branch_seaLevel) !! (idx - 1) ) $ listToSeq branches)) in map (\(x,b) -> b & branch_x .~ x) $ zip steps branches sortByHierarchy :: Int -> [PhyloBranch] -> [PhyloBranch] sortByHierarchy depth branches = if (length branches == 1) then branchToIso branches else branchToIso $ concat $ map (\branches' -> let partitions = partition (\b -> depth + 1 == ((length . snd) $ b ^. branch_id)) branches' in (sortOn (\b -> (b ^. branch_meta) ! "birth") (fst partitions)) ++ (sortByHierarchy (depth + 1) (snd partitions))) $ groupBy (\b b' -> ((take depth . snd) $ b ^. branch_id) == ((take depth . snd) $ b' ^. branch_id) ) $ sortOn (\b -> (take depth . snd) $ b ^. branch_id) branches sortByBirthDate :: Order -> PhyloExport -> PhyloExport sortByBirthDate order export = let branches = sortOn (\b -> (b ^. branch_meta) ! "birth") $ export ^. export_branches branches' = case order of Asc -> branches Desc -> reverse branches in export & export_branches .~ branches' processSort :: Sort -> PhyloExport -> PhyloExport processSort sort' export = case sort' of ByBirthDate o -> sortByBirthDate o export ByHierarchy -> export & export_branches .~ sortByHierarchy 0 (export ^. export_branches) ----------------- -- | Metrics | -- ----------------- -- | Return the conditional probability of i knowing j conditional :: Ord a => Map (a,a) Double -> a -> a -> Double conditional m i j = (findWithDefault 0 (i,j) m) / (m ! (j,j)) -- | Return the genericity score of a given ngram genericity :: Map (Int, Int) Double -> [Int] -> Int -> Double genericity m l i = ( (sum $ map (\j -> conditional m i j) l) - (sum $ map (\j -> conditional m j i) l)) / (fromIntegral $ (length l) + 1) -- | Return the specificity score of a given ngram specificity :: Map (Int, Int) Double -> [Int] -> Int -> Double specificity m l i = ( (sum $ map (\j -> conditional m j i) l) - (sum $ map (\j -> conditional m i j) l)) / (fromIntegral $ (length l) + 1) -- | Return the inclusion score of a given ngram inclusion :: Map (Int, Int) Double -> [Int] -> Int -> Double inclusion m l i = ( (sum $ map (\j -> conditional m j i) l) + (sum $ map (\j -> conditional m i j) l)) / (fromIntegral $ (length l) + 1) ngramsMetrics :: PhyloExport -> PhyloExport ngramsMetrics export = over ( export_groups . traverse ) (\g -> g & phylo_groupMeta %~ insert "genericity" (map (\n -> genericity (g ^. phylo_groupCooc) ((g ^. phylo_groupNgrams) \\ [n]) n) $ g ^. phylo_groupNgrams) & phylo_groupMeta %~ insert "specificity" (map (\n -> specificity (g ^. phylo_groupCooc) ((g ^. phylo_groupNgrams) \\ [n]) n) $ g ^. phylo_groupNgrams) & phylo_groupMeta %~ insert "inclusion" (map (\n -> inclusion (g ^. phylo_groupCooc) ((g ^. phylo_groupNgrams) \\ [n]) n) $ g ^. phylo_groupNgrams) ) export branchDating :: PhyloExport -> PhyloExport branchDating export = over ( export_branches . traverse ) (\b -> let groups = sortOn fst $ foldl' (\acc g -> if (g ^. phylo_groupBranchId == b ^. branch_id) then acc ++ [g ^. phylo_groupPeriod] else acc ) [] $ export ^. export_groups periods = nub groups birth = fst $ head' "birth" groups age = (snd $ last' "age" groups) - birth in b & branch_meta %~ insert "birth" [fromIntegral birth] & branch_meta %~ insert "age" [fromIntegral age] & branch_meta %~ insert "size" [fromIntegral $ length periods] ) export processMetrics :: PhyloExport -> PhyloExport processMetrics export = ngramsMetrics $ branchDating export ----------------- -- | Taggers | -- ----------------- getNthMostMeta :: Int -> [Double] -> [Int] -> [Int] getNthMostMeta nth meta ns = map (\(idx,_) -> (ns !! idx)) $ take nth $ reverse $ sortOn snd $ zip [0..] meta mostInclusive :: Int -> Vector Ngrams -> PhyloExport -> PhyloExport mostInclusive nth foundations export = over ( export_branches . traverse ) (\b -> let groups = filter (\g -> g ^. phylo_groupBranchId == b ^. branch_id) $ export ^. export_groups cooc = foldl (\acc g -> unionWith (+) acc (g ^. phylo_groupCooc)) empty groups ngrams = sort $ foldl (\acc g -> union acc (g ^. phylo_groupNgrams)) [] groups inc = map (\n -> inclusion cooc (ngrams \\ [n]) n) ngrams lbl = ngramsToLabel foundations $ getNthMostMeta nth inc ngrams in b & branch_label .~ lbl ) export mostEmergentInclusive :: Int -> Vector Ngrams -> PhyloExport -> PhyloExport mostEmergentInclusive nth foundations export = over ( export_groups . traverse ) (\g -> let lbl = ngramsToLabel foundations $ take nth $ map (\(_,(_,idx)) -> idx) $ concat $ map (\groups -> sortOn (fst . snd) groups) $ groupBy ((==) `on` fst) $ reverse $ sortOn fst $ zip ((g ^. phylo_groupMeta) ! "inclusion") $ zip ((g ^. phylo_groupMeta) ! "dynamics") (g ^. phylo_groupNgrams) in g & phylo_groupLabel .~ lbl ) export processLabels :: [PhyloLabel] -> Vector Ngrams -> PhyloExport -> PhyloExport processLabels labels foundations export = foldl (\export' label -> case label of GroupLabel tagger nth -> case tagger of MostEmergentInclusive -> mostEmergentInclusive nth foundations export' _ -> panic "[ERR][Viz.Phylo.PhyloExport] unknown tagger" BranchLabel tagger nth -> case tagger of MostInclusive -> mostInclusive nth foundations export' _ -> panic "[ERR][Viz.Phylo.PhyloExport] unknown tagger" ) export labels ------------------ -- | Dynamics | -- ------------------ toDynamics :: Int -> [PhyloGroup] -> PhyloGroup -> Map Int (Date,Date) -> Double toDynamics n parents g m = let prd = g ^. phylo_groupPeriod end = last' "dynamics" (sort $ map snd $ elems m) in if (((snd prd) == (snd $ m ! n)) && (snd prd /= end)) -- | decrease then 2 else if ((fst prd) == (fst $ m ! n)) -- | recombination then 0 else if isNew -- | emergence then 1 else 3 where -------------------------------------- isNew :: Bool isNew = not $ elem n $ concat $ map _phylo_groupNgrams parents processDynamics :: [PhyloGroup] -> [PhyloGroup] processDynamics groups = map (\g -> let parents = filter (\g' -> (g ^. phylo_groupBranchId == g' ^. phylo_groupBranchId) && ((fst $ g ^. phylo_groupPeriod) > (fst $ g' ^. phylo_groupPeriod))) groups in g & phylo_groupMeta %~ insert "dynamics" (map (\n -> toDynamics n parents g mapNgrams) $ g ^. phylo_groupNgrams) ) groups where -------------------------------------- mapNgrams :: Map Int (Date,Date) mapNgrams = map (\dates -> let dates' = sort dates in (head' "dynamics" dates', last' "dynamics" dates')) $ fromListWith (++) $ foldl (\acc g -> acc ++ ( map (\n -> (n,[fst $ g ^. phylo_groupPeriod, snd $ g ^. phylo_groupPeriod])) $ (g ^. phylo_groupNgrams))) [] groups ----------------- -- | horizon | -- ----------------- horizonToAncestors :: Double -> Phylo -> [PhyloAncestor] horizonToAncestors delta phylo = let horizon = Map.toList $ Map.filter (\v -> v > delta) $ phylo ^. phylo_horizon ct0 = fromList $ map (\g -> (getGroupId g, g)) $ getGroupsFromLevelPeriods 1 (take 1 (getPeriodIds phylo)) phylo aDelta = toRelatedComponents (elems ct0) (map (\((g,g'),v) -> ((ct0 ! g,ct0 ! g'),v)) horizon) in map (\(id,groups) -> toAncestor id groups) $ zip [1..] aDelta where -- | note : possible bug if we sync clus more than once -- | horizon is calculated at level 1, ancestors have to be related to the last level toAncestor :: Int -> [PhyloGroup] -> PhyloAncestor toAncestor id groups = PhyloAncestor id (foldl' (\acc g -> union acc (g ^. phylo_groupNgrams)) [] groups) (concat $ map (\g -> map fst (g ^. phylo_groupLevelParents)) groups) --------------------- -- | phyloExport | -- --------------------- toPhyloExport :: Phylo -> DotGraph DotId toPhyloExport phylo = exportToDot phylo $ processFilters (exportFilter $ getConfig phylo) (phyloQuality $ getConfig phylo) $ processSort (exportSort $ getConfig phylo) $ processLabels (exportLabel $ getConfig phylo) (getRoots phylo) $ processMetrics export where export :: PhyloExport export = PhyloExport groups branches (horizonToAncestors 0 phylo) -------------------------------------- branches :: [PhyloBranch] branches = map (\g -> let seaLvl = (g ^. phylo_groupMeta) ! "seaLevels" breaks = (g ^. phylo_groupMeta) ! "breaks" canonId = take (round $ (last' "export" breaks) + 2) (snd $ g ^. phylo_groupBranchId) in PhyloBranch (g ^. phylo_groupBranchId) canonId seaLvl 0 (last' "export" (take (round $ (last' "export" breaks) + 1) seaLvl)) 0 0 "" empty) $ map (\gs -> head' "export" gs) $ groupBy (\g g' -> g ^. phylo_groupBranchId == g' ^. phylo_groupBranchId) $ sortOn (\g -> g ^. phylo_groupBranchId) groups -------------------------------------- groups :: [PhyloGroup] groups = traceExportGroups $ processDynamics $ 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" <> "-- | 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