{-|
Module      : Gargantext.Core.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 TypeSynonymInstances #-}

module Gargantext.Core.Viz.Phylo.PhyloExport where

import Data.Map (Map, fromList, empty, fromListWith, insert, (!), elems, unionWith, findWithDefault, toList, member)
import Data.List ((++), sort, nub, null, concat, sortOn, groupBy, union, (\\), (!!), init, partition, notElem, unwords, nubBy, inits, elemIndex)
import Data.Vector (Vector)

import Prelude (writeFile)
import Gargantext.Prelude
import Gargantext.Core.Viz.AdaptativePhylo
import Gargantext.Core.Viz.Phylo.PhyloTools
import Gargantext.Core.Viz.Phylo.TemporalMatching (filterDocs, filterDiago, reduceDiagos, toProximity, getNextPeriods)

import Control.Lens hiding (Level)
import Control.Parallel.Strategies (parList, rdeepseq, using)
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.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 -> DotGraph DotId -> IO ()
dotToFile FilePath
filePath DotGraph DotId
dotG = FilePath -> FilePath -> IO ()
writeFile FilePath
filePath (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DotGraph DotId -> FilePath
dotToString DotGraph DotId
dotG

dotToString :: DotGraph DotId  -> [Char]
dotToString :: DotGraph DotId -> FilePath
dotToString DotGraph DotId
dotG = DotId -> FilePath
unpack (DotGraph DotId -> DotId
forall (dg :: * -> *) n. PrintDotRepr dg n => dg n -> DotId
printDotGraph DotGraph DotId
dotG)

dynamicToColor :: Double -> H.Attribute
dynamicToColor :: Double -> Attribute
dynamicToColor Double
d 
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0    = Color -> Attribute
H.BGColor (X11Color -> Color
forall nc. NamedColor nc => nc -> Color
toColor X11Color
LightCoral)
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1    = Color -> Attribute
H.BGColor (X11Color -> Color
forall nc. NamedColor nc => nc -> Color
toColor X11Color
Khaki)
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
2    = Color -> Attribute
H.BGColor (X11Color -> Color
forall nc. NamedColor nc => nc -> Color
toColor X11Color
SkyBlue)
  | Bool
otherwise = Color -> Attribute
H.Color   (X11Color -> Color
forall nc. NamedColor nc => nc -> Color
toColor X11Color
Black)

pickLabelColor :: [Double] -> H.Attribute
pickLabelColor :: [Double] -> Attribute
pickLabelColor [Double]
lst
  | Double -> [Double] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Double
0 [Double]
lst = Double -> Attribute
dynamicToColor Double
0
  | Double -> [Double] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Double
2 [Double]
lst = Double -> Attribute
dynamicToColor Double
2
  | Double -> [Double] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Double
1 [Double]
lst = Double -> Attribute
dynamicToColor Double
1
  | Bool
otherwise  = Double -> Attribute
dynamicToColor Double
3  

toDotLabel :: Text.Text -> Label
toDotLabel :: Text -> Label
toDotLabel Text
lbl = DotId -> Label
StrLabel (DotId -> Label) -> DotId -> Label
forall a b. (a -> b) -> a -> b
$ Text -> DotId
fromStrict Text
lbl

toAttr :: AttributeName -> Lazy.Text -> CustomAttribute
toAttr :: DotId -> DotId -> CustomAttribute
toAttr DotId
k DotId
v = DotId -> DotId -> CustomAttribute
customAttribute DotId
k DotId
v

metaToAttr :: Map Text.Text [Double] -> [CustomAttribute]
metaToAttr :: Map Text [Double] -> [CustomAttribute]
metaToAttr Map Text [Double]
meta = ((Text, [Double]) -> CustomAttribute)
-> [(Text, [Double])] -> [CustomAttribute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Text
k,[Double]
v) -> DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
k) (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ (FilePath -> DotId
pack (FilePath -> DotId)
-> ([FilePath] -> FilePath) -> [FilePath] -> DotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords) ([FilePath] -> DotId) -> [FilePath] -> DotId
forall a b. (a -> b) -> a -> b
$ (Double -> FilePath) -> [Double] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Double -> FilePath
forall a. Show a => a -> FilePath
show [Double]
v) ([(Text, [Double])] -> [CustomAttribute])
-> [(Text, [Double])] -> [CustomAttribute]
forall a b. (a -> b) -> a -> b
$ Map Text [Double] -> [(Text, [Double])]
forall k a. Map k a -> [(k, a)]
toList Map Text [Double]
meta

groupIdToDotId :: PhyloGroupId -> DotId
groupIdToDotId :: PhyloGroupId -> DotId
groupIdToDotId (((Level
d,Level
d'),Level
lvl),Level
idx) = (Text -> DotId
fromStrict (Text -> DotId) -> (FilePath -> Text) -> FilePath -> DotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ (FilePath
"group" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Level -> FilePath
forall a. Show a => a -> FilePath
show Level
d) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Level -> FilePath
forall a. Show a => a -> FilePath
show Level
d') FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Level -> FilePath
forall a. Show a => a -> FilePath
show Level
lvl) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Level -> FilePath
forall a. Show a => a -> FilePath
show Level
idx))

branchIdToDotId :: PhyloBranchId -> DotId
branchIdToDotId :: PhyloBranchId -> DotId
branchIdToDotId PhyloBranchId
bId = (Text -> DotId
fromStrict (Text -> DotId) -> (FilePath -> Text) -> FilePath -> DotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ (FilePath
"branch" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Level] -> FilePath
forall a. Show a => a -> FilePath
show (PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd PhyloBranchId
bId))

periodIdToDotId :: PhyloPeriodId -> DotId
periodIdToDotId :: PhyloPeriodId -> DotId
periodIdToDotId PhyloPeriodId
prd = (Text -> DotId
fromStrict (Text -> DotId) -> (FilePath -> Text) -> FilePath -> DotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ (FilePath
"period" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst PhyloPeriodId
prd) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd PhyloPeriodId
prd))

groupToTable :: Vector Ngrams -> PhyloGroup -> H.Label
groupToTable :: Vector Text -> PhyloGroup -> Label
groupToTable Vector Text
fdt PhyloGroup
g = Table -> Label
H.Table HTable :: Maybe Attributes -> Attributes -> [Row] -> Table
H.HTable
                    { tableFontAttrs :: Maybe Attributes
H.tableFontAttrs = Attributes -> Maybe Attributes
forall a. a -> Maybe a
Just [Double -> Attribute
H.PointSize Double
14, Align -> Attribute
H.Align Align
H.HLeft]
                    , tableAttrs :: Attributes
H.tableAttrs = [Word8 -> Attribute
H.Border Word8
0, Word8 -> Attribute
H.CellBorder Word8
0, Color -> Attribute
H.BGColor (X11Color -> Color
forall nc. NamedColor nc => nc -> Color
toColor X11Color
White)]
                    , tableRows :: [Row]
H.tableRows = [Row
header]
                                 [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [[Cell] -> Row
H.Cells [Attributes -> Label -> Cell
H.LabelCell [Word16 -> Attribute
H.Height Word16
10] (Label -> Cell) -> Label -> Cell
forall a b. (a -> b) -> a -> b
$ Text -> Label
H.Text [DotId -> TextItem
H.Str (DotId -> TextItem) -> DotId -> TextItem
forall a b. (a -> b) -> a -> b
$ Text -> DotId
fromStrict Text
""]]]
                                 [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> ( ([(Text, (Double, Double))] -> Row)
-> [[(Text, (Double, Double))]] -> [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [(Text, (Double, Double))] -> Row
ngramsToRow ([[(Text, (Double, Double))]] -> [Row])
-> [[(Text, (Double, Double))]] -> [Row]
forall a b. (a -> b) -> a -> b
$ Level -> [(Text, (Double, Double))] -> [[(Text, (Double, Double))]]
forall a. Level -> [a] -> [[a]]
splitEvery Level
4 
                                    ([(Text, (Double, Double))] -> [[(Text, (Double, Double))]])
-> [(Text, (Double, Double))] -> [[(Text, (Double, Double))]]
forall a b. (a -> b) -> a -> b
$ [(Text, (Double, Double))] -> [(Text, (Double, Double))]
forall a. [a] -> [a]
reverse ([(Text, (Double, Double))] -> [(Text, (Double, Double))])
-> [(Text, (Double, Double))] -> [(Text, (Double, Double))]
forall a b. (a -> b) -> a -> b
$ ((Text, (Double, Double)) -> Double)
-> [(Text, (Double, Double))] -> [(Text, (Double, Double))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double)
-> ((Text, (Double, Double)) -> (Double, Double))
-> (Text, (Double, Double))
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, (Double, Double)) -> (Double, Double)
forall a b. (a, b) -> b
snd)
                                    ([(Text, (Double, Double))] -> [(Text, (Double, Double))])
-> [(Text, (Double, Double))] -> [(Text, (Double, Double))]
forall a b. (a -> b) -> a -> b
$ [Text] -> [(Double, Double)] -> [(Text, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Vector Text -> [Level] -> [Text]
ngramsToText Vector Text
fdt (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)) 
                                    ([(Double, Double)] -> [(Text, (Double, Double))])
-> [(Double, Double)] -> [(Text, (Double, Double))]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"dynamics") ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"inclusion"))}
    where
        --------------------------------------
        ngramsToRow :: [(Ngrams,(Double,Double))] -> H.Row
        ngramsToRow :: [(Text, (Double, Double))] -> Row
ngramsToRow [(Text, (Double, Double))]
ns = [Cell] -> Row
H.Cells ([Cell] -> Row) -> [Cell] -> Row
forall a b. (a -> b) -> a -> b
$ ((Text, (Double, Double)) -> Cell)
-> [(Text, (Double, Double))] -> [Cell]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Text
n,(Double
d,Double
_)) -> 
                            Attributes -> Label -> Cell
H.LabelCell [Align -> Attribute
H.Align Align
H.HLeft,Double -> Attribute
dynamicToColor Double
d] (Label -> Cell) -> Label -> Cell
forall a b. (a -> b) -> a -> b
$ Text -> Label
H.Text [DotId -> TextItem
H.Str (DotId -> TextItem) -> DotId -> TextItem
forall a b. (a -> b) -> a -> b
$ Text -> DotId
fromStrict Text
n]) [(Text, (Double, Double))]
ns
        --------------------------------------
        header :: H.Row
        header :: Row
header = 
            [Cell] -> Row
H.Cells [ Attributes -> Label -> Cell
H.LabelCell [[Double] -> Attribute
pickLabelColor ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"dynamics")] 
                    (Label -> Cell) -> Label -> Cell
forall a b. (a -> b) -> a -> b
$ Text -> Label
H.Text [DotId -> TextItem
H.Str (DotId -> TextItem) -> DotId -> TextItem
forall a b. (a -> b) -> a -> b
$ (((Text -> DotId
fromStrict (Text -> DotId) -> (Text -> Text) -> Text -> DotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toUpper) (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting Text PhyloGroup Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text PhyloGroup Text
Lens' PhyloGroup Text
phylo_groupLabel)
                                   DotId -> DotId -> DotId
forall a. Semigroup a => a -> a -> a
<> (Text -> DotId
fromStrict Text
" ( ")
                                   DotId -> DotId -> DotId
forall a. Semigroup a => a -> a -> a
<> (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod))
                                   DotId -> DotId -> DotId
forall a. Semigroup a => a -> a -> a
<> (Text -> DotId
fromStrict Text
" , ")
                                   DotId -> DotId -> DotId
forall a. Semigroup a => a -> a -> a
<> (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod))
                                   DotId -> DotId -> DotId
forall a. Semigroup a => a -> a -> a
<> (Text -> DotId
fromStrict Text
" ) ")
                                   DotId -> DotId -> DotId
forall a. Semigroup a => a -> a -> a
<> (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ PhyloGroupId -> FilePath
forall a. Show a => a -> FilePath
show (PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g)))]] 
        --------------------------------------

branchToDotNode :: PhyloBranch -> Int -> Dot DotId
branchToDotNode :: PhyloBranch -> Level -> Dot DotId
branchToDotNode PhyloBranch
b Level
bId = 
    DotId -> [CustomAttribute] -> Dot DotId
forall n. n -> [CustomAttribute] -> Dot n
node (PhyloBranchId -> DotId
branchIdToDotId (PhyloBranchId -> DotId) -> PhyloBranchId -> DotId
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id)
         ([ColorList -> CustomAttribute
FillColor [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
CornSilk], DotId -> CustomAttribute
FontName DotId
"Arial", Double -> CustomAttribute
FontSize Double
40, Shape -> CustomAttribute
Shape Shape
Egg, [StyleItem] -> CustomAttribute
Style [StyleName -> [DotId] -> StyleItem
SItem StyleName
Bold []], Label -> CustomAttribute
Label (Text -> Label
toDotLabel (Text -> Label) -> Text -> Label
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch -> Getting Text PhyloBranch Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text PhyloBranch Text
Lens' PhyloBranch Text
branch_label)]
         [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> (Map Text [Double] -> [CustomAttribute]
metaToAttr (Map Text [Double] -> [CustomAttribute])
-> Map Text [Double] -> [CustomAttribute]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
Lens' PhyloBranch (Map Text [Double])
branch_meta)
         [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [ DotId -> DotId -> CustomAttribute
toAttr DotId
"nodeType" DotId
"branch"
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"bId"      (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show Level
bId)
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"branchId" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords ((Level -> FilePath) -> [Level] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Level -> FilePath
forall a. Show a => a -> FilePath
show ([Level] -> [FilePath]) -> [Level] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id))
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"branch_x" (Text -> DotId
fromStrict (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Double -> FilePath
forall a. Show a => a -> FilePath
show (Double -> FilePath) -> Double -> FilePath
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch -> Getting Double PhyloBranch Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double PhyloBranch Double
Lens' PhyloBranch Double
branch_x))
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"branch_y" (Text -> DotId
fromStrict (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Double -> FilePath
forall a. Show a => a -> FilePath
show (Double -> FilePath) -> Double -> FilePath
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch -> Getting Double PhyloBranch Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double PhyloBranch Double
Lens' PhyloBranch Double
branch_y))
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"label"    (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. Show a => a -> FilePath
show (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch -> Getting Text PhyloBranch Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text PhyloBranch Text
Lens' PhyloBranch Text
branch_label)
            ])
 
periodToDotNode :: (Date,Date) -> (Text.Text,Text.Text) -> Dot DotId
periodToDotNode :: PhyloPeriodId -> (Text, Text) -> Dot DotId
periodToDotNode PhyloPeriodId
prd (Text, Text)
prd' =
    DotId -> [CustomAttribute] -> Dot DotId
forall n. n -> [CustomAttribute] -> Dot n
node (PhyloPeriodId -> DotId
periodIdToDotId PhyloPeriodId
prd)
         ([Shape -> CustomAttribute
Shape Shape
BoxShape, Double -> CustomAttribute
FontSize Double
50, Label -> CustomAttribute
Label (Text -> Label
toDotLabel (Text -> Label) -> Text -> Label
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst PhyloPeriodId
prd) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd PhyloPeriodId
prd)))]
         [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [ DotId -> DotId -> CustomAttribute
toAttr DotId
"nodeType" DotId
"period"
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"strFrom" (Text -> DotId
fromStrict (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath
forall a. Show a => a -> FilePath
show (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
prd'))
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"strTo"   (Text -> DotId
fromStrict (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath
forall a. Show a => a -> FilePath
show (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
prd'))          
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"from" (Text -> DotId
fromStrict (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Level -> FilePath
forall a. Show a => a -> FilePath
show (Level -> FilePath) -> Level -> FilePath
forall a b. (a -> b) -> a -> b
$ PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst PhyloPeriodId
prd))
            , DotId -> DotId -> CustomAttribute
toAttr DotId
"to"   (Text -> DotId
fromStrict (Text -> DotId) -> Text -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Level -> FilePath
forall a. Show a => a -> FilePath
show (Level -> FilePath) -> Level -> FilePath
forall a b. (a -> b) -> a -> b
$ PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd PhyloPeriodId
prd))])


groupToDotNode :: Vector Ngrams -> PhyloGroup -> Int -> Dot DotId
groupToDotNode :: Vector Text -> PhyloGroup -> Level -> Dot DotId
groupToDotNode Vector Text
fdt PhyloGroup
g Level
bId = 
    DotId -> [CustomAttribute] -> Dot DotId
forall n. n -> [CustomAttribute] -> Dot n
node (PhyloGroupId -> DotId
groupIdToDotId (PhyloGroupId -> DotId) -> PhyloGroupId -> DotId
forall a b. (a -> b) -> a -> b
$ PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g)
                     ([DotId -> CustomAttribute
FontName DotId
"Arial", Shape -> CustomAttribute
Shape Shape
Square, Double -> CustomAttribute
penWidth Double
4,  Label -> CustomAttribute
forall a. Labellable a => a -> CustomAttribute
toLabel (Vector Text -> PhyloGroup -> Label
groupToTable Vector Text
fdt PhyloGroup
g)]
                      [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [ DotId -> DotId -> CustomAttribute
toAttr DotId
"nodeType" DotId
"group"
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"from" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"to"   (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"strFrom" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. Show a => a -> FilePath
show ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting (Text, Text) PhyloGroup (Text, Text) -> (Text, Text)
forall s a. s -> Getting a s a -> a
^. Getting (Text, Text) PhyloGroup (Text, Text)
Lens' PhyloGroup (Text, Text)
phylo_groupPeriod'))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"strTo"   (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. Show a => a -> FilePath
show ((Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting (Text, Text) PhyloGroup (Text, Text) -> (Text, Text)
forall s a. s -> Getting a s a -> a
^. Getting (Text, Text) PhyloGroup (Text, Text)
Lens' PhyloGroup (Text, Text)
phylo_groupPeriod'))                         
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"branchId" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords ([FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Level -> FilePath) -> [Level] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Level -> FilePath
forall a. Show a => a -> FilePath
show ([Level] -> [FilePath]) -> [Level] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"bId" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show Level
bId)
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"support" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloGroup
g PhyloGroup -> Getting Level PhyloGroup Level -> Level
forall s a. s -> Getting a s a -> a
^. Getting Level PhyloGroup Level
Lens' PhyloGroup Level
phylo_groupSupport))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"weight" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Maybe Double -> FilePath
forall a. Show a => a -> FilePath
show (PhyloGroup
g PhyloGroup
-> Getting (Maybe Double) PhyloGroup (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Double) PhyloGroup (Maybe Double)
Lens' PhyloGroup (Maybe Double)
phylo_groupWeight))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"source" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ [Level] -> FilePath
forall a. Show a => a -> FilePath
show ([Level] -> [Level]
forall a. Eq a => [a] -> [a]
nub ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupSources))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"lbl" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. Show a => a -> FilePath
show (Vector Text -> [Level] -> Text
ngramsToLabel Vector Text
fdt (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"foundation" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. Show a => a -> FilePath
show ([Level] -> FilePath
idxToLabel (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"role" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. Show a => a -> FilePath
show ([Double] -> FilePath
idxToLabel' ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"dynamics")))
                         , DotId -> DotId -> CustomAttribute
toAttr DotId
"frequence" (FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. Show a => a -> FilePath
show ([Double] -> FilePath
idxToLabel' ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"frequence")))
                         ])  


toDotEdge :: DotId -> DotId -> [Char] -> EdgeType -> Dot DotId
toDotEdge :: DotId -> DotId -> FilePath -> EdgeType -> Dot DotId
toDotEdge DotId
source DotId
target FilePath
lbl EdgeType
edgeType = DotId -> DotId -> [CustomAttribute] -> Dot DotId
forall n. n -> n -> [CustomAttribute] -> Dot n
edge DotId
source DotId
target
    (case EdgeType
edgeType of
        EdgeType
GroupToGroup    -> [ Double -> CustomAttribute
Width Double
3, Double -> CustomAttribute
penWidth Double
4, ColorList -> CustomAttribute
Color [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
Black], Bool -> CustomAttribute
Constraint Bool
True] [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [DotId -> DotId -> CustomAttribute
toAttr DotId
"edgeType" DotId
"link", DotId -> DotId -> CustomAttribute
toAttr DotId
"lbl" (FilePath -> DotId
pack FilePath
lbl)]
        EdgeType
BranchToGroup   -> [ Double -> CustomAttribute
Width Double
3, ColorList -> CustomAttribute
Color [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
Black], ArrowType -> CustomAttribute
ArrowHead ([(ArrowModifier, ArrowShape)] -> ArrowType
AType [(ArrowFill -> ArrowSide -> ArrowModifier
ArrMod ArrowFill
FilledArrow ArrowSide
RightSide,ArrowShape
DotArrow)])] [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [DotId -> DotId -> CustomAttribute
toAttr DotId
"edgeType" DotId
"branchLink" ]
        EdgeType
BranchToBranch  -> [ Double -> CustomAttribute
Width Double
2, ColorList -> CustomAttribute
Color [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
Black], [StyleItem] -> CustomAttribute
Style [StyleName -> [DotId] -> StyleItem
SItem StyleName
Dashed []], ArrowType -> CustomAttribute
ArrowHead ([(ArrowModifier, ArrowShape)] -> ArrowType
AType [(ArrowFill -> ArrowSide -> ArrowModifier
ArrMod ArrowFill
FilledArrow ArrowSide
BothSides,ArrowShape
DotArrow)])]
        EdgeType
GroupToAncestor -> [ Double -> CustomAttribute
Width Double
3, ColorList -> CustomAttribute
Color [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
Red], [StyleItem] -> CustomAttribute
Style [StyleName -> [DotId] -> StyleItem
SItem StyleName
Dashed []], ArrowType -> CustomAttribute
ArrowHead ([(ArrowModifier, ArrowShape)] -> ArrowType
AType [(ArrowFill -> ArrowSide -> ArrowModifier
ArrMod ArrowFill
FilledArrow ArrowSide
BothSides,ArrowShape
NoArrow)]), Double -> CustomAttribute
PenWidth Double
4] [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [DotId -> DotId -> CustomAttribute
toAttr DotId
"edgeType" DotId
"ancestorLink", DotId -> DotId -> CustomAttribute
toAttr DotId
"lbl" (FilePath -> DotId
pack FilePath
lbl)]                          
        EdgeType
PeriodToPeriod  -> [ Double -> CustomAttribute
Width Double
5, ColorList -> CustomAttribute
Color [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
Black]])


mergePointers :: [PhyloGroup] -> Map (PhyloGroupId,PhyloGroupId) Double
mergePointers :: [PhyloGroup] -> Map (PhyloGroupId, PhyloGroupId) Double
mergePointers [PhyloGroup]
groups = 
    let toChilds :: Map (PhyloGroupId, PhyloGroupId) Double
toChilds  = [((PhyloGroupId, PhyloGroupId), Double)]
-> Map (PhyloGroupId, PhyloGroupId) Double
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([((PhyloGroupId, PhyloGroupId), Double)]
 -> Map (PhyloGroupId, PhyloGroupId) Double)
-> [((PhyloGroupId, PhyloGroupId), Double)]
-> Map (PhyloGroupId, PhyloGroupId) Double
forall a b. (a -> b) -> a -> b
$ [[((PhyloGroupId, PhyloGroupId), Double)]]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((PhyloGroupId, PhyloGroupId), Double)]]
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [[((PhyloGroupId, PhyloGroupId), Double)]]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [PhyloGroup] -> [[((PhyloGroupId, PhyloGroupId), Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> ((PhyloGroupId, Double) -> ((PhyloGroupId, PhyloGroupId), Double))
-> [(PhyloGroupId, Double)]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloGroupId
target,Double
w) -> ((PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g,PhyloGroupId
target),Double
w)) ([(PhyloGroupId, Double)]
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [(PhyloGroupId, Double)]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupPeriodChilds) [PhyloGroup]
groups
        toParents :: Map (PhyloGroupId, PhyloGroupId) Double
toParents = [((PhyloGroupId, PhyloGroupId), Double)]
-> Map (PhyloGroupId, PhyloGroupId) Double
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([((PhyloGroupId, PhyloGroupId), Double)]
 -> Map (PhyloGroupId, PhyloGroupId) Double)
-> [((PhyloGroupId, PhyloGroupId), Double)]
-> Map (PhyloGroupId, PhyloGroupId) Double
forall a b. (a -> b) -> a -> b
$ [[((PhyloGroupId, PhyloGroupId), Double)]]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((PhyloGroupId, PhyloGroupId), Double)]]
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [[((PhyloGroupId, PhyloGroupId), Double)]]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [PhyloGroup] -> [[((PhyloGroupId, PhyloGroupId), Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> ((PhyloGroupId, Double) -> ((PhyloGroupId, PhyloGroupId), Double))
-> [(PhyloGroupId, Double)]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloGroupId
target,Double
w) -> ((PhyloGroupId
target,PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g),Double
w)) ([(PhyloGroupId, Double)]
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [(PhyloGroupId, Double)]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupPeriodParents) [PhyloGroup]
groups
    in  (Double -> Double -> Double)
-> Map (PhyloGroupId, PhyloGroupId) Double
-> Map (PhyloGroupId, PhyloGroupId) Double
-> Map (PhyloGroupId, PhyloGroupId) Double
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith (\Double
w Double
w' -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
w Double
w') Map (PhyloGroupId, PhyloGroupId) Double
toChilds Map (PhyloGroupId, PhyloGroupId) Double
toParents

mergeAncestors :: [PhyloGroup] -> [((PhyloGroupId,PhyloGroupId), Double)]
mergeAncestors :: [PhyloGroup] -> [((PhyloGroupId, PhyloGroupId), Double)]
mergeAncestors [PhyloGroup]
groups = [[((PhyloGroupId, PhyloGroupId), Double)]]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                      ([[((PhyloGroupId, PhyloGroupId), Double)]]
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [[((PhyloGroupId, PhyloGroupId), Double)]]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [PhyloGroup] -> [[((PhyloGroupId, PhyloGroupId), Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> ((PhyloGroupId, Double) -> ((PhyloGroupId, PhyloGroupId), Double))
-> [(PhyloGroupId, Double)]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloGroupId
target,Double
w) -> ((PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g,PhyloGroupId
target),Double
w)) ([(PhyloGroupId, Double)]
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [(PhyloGroupId, Double)]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupAncestors) 
                      ([PhyloGroup] -> [[((PhyloGroupId, PhyloGroupId), Double)]])
-> [PhyloGroup] -> [[((PhyloGroupId, PhyloGroupId), Double)]]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> (Bool -> Bool
not (Bool -> Bool)
-> ([(PhyloGroupId, Double)] -> Bool)
-> [(PhyloGroupId, Double)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PhyloGroupId, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([(PhyloGroupId, Double)] -> Bool)
-> [(PhyloGroupId, Double)] -> Bool
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupAncestors) [PhyloGroup]
groups


toBid :: PhyloGroup -> [PhyloBranch] -> Int
toBid :: PhyloGroup -> [PhyloBranch] -> Level
toBid PhyloGroup
g [PhyloBranch]
bs = 
  let b' :: PhyloBranch
b' = Text -> [PhyloBranch] -> PhyloBranch
forall a. Text -> [a] -> a
head' Text
"toBid" ((PhyloBranch -> Bool) -> [PhyloBranch] -> [PhyloBranch]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloBranch
b -> PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId) [PhyloBranch]
bs)
   in Maybe Level -> Level
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Level -> Level) -> Maybe Level -> Level
forall a b. (a -> b) -> a -> b
$ PhyloBranch -> [PhyloBranch] -> Maybe Level
forall a. Eq a => a -> [a] -> Maybe Level
elemIndex PhyloBranch
b' [PhyloBranch]
bs

exportToDot :: Phylo -> PhyloExport -> DotGraph DotId
exportToDot :: Phylo -> PhyloExport -> DotGraph DotId
exportToDot Phylo
phylo PhyloExport
export = 
    FilePath -> DotGraph DotId -> DotGraph DotId
forall a. FilePath -> a -> a
trace (FilePath
"\n-- | Convert " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([PhyloBranch] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([PhyloBranch] -> Level) -> [PhyloBranch] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" branches and "
         FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([PhyloGroup] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([PhyloGroup] -> Level) -> [PhyloGroup] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" groups " 
         FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level]
forall a. Eq a => [a] -> [a]
nub ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [Level]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Level]] -> [Level]) -> [[Level]] -> [Level]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [Level]) -> [PhyloGroup] -> [[Level]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) ([PhyloGroup] -> [[Level]]) -> [PhyloGroup] -> [[Level]]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" terms to a dot file\n\n"
         FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"##########################") (DotGraph DotId -> DotGraph DotId)
-> DotGraph DotId -> DotGraph DotId
forall a b. (a -> b) -> a -> b
$
    GraphID -> Dot DotId -> DotGraph DotId
forall n a. GraphID -> DotM n a -> DotGraph n
digraph ((DotId -> GraphID
Str (DotId -> GraphID) -> (Text -> DotId) -> Text -> GraphID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotId
fromStrict) (Text -> GraphID) -> Text -> GraphID
forall a b. (a -> b) -> a -> b
$ (Config -> Text
phyloName (Config -> Text) -> Config -> Text
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo)) (Dot DotId -> DotGraph DotId) -> Dot DotId -> DotGraph DotId
forall a b. (a -> b) -> a -> b
$ do 

        {- 1) init the dot graph -}
        [CustomAttribute] -> Dot DotId
forall n. [CustomAttribute] -> Dot n
graphAttrs ( [ Label -> CustomAttribute
Label (Text -> Label
toDotLabel (Text -> Label) -> Text -> Label
forall a b. (a -> b) -> a -> b
$ (Config -> Text
phyloName (Config -> Text) -> Config -> Text
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo))]
                  [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [ Double -> CustomAttribute
FontSize Double
30, VerticalPlacement -> CustomAttribute
LabelLoc VerticalPlacement
VTop, Double -> CustomAttribute
NodeSep Double
1, [Double] -> CustomAttribute
RankSep [Double
1], RankType -> CustomAttribute
Rank RankType
SameRank, EdgeType -> CustomAttribute
Splines EdgeType
SplineEdges, Overlap -> CustomAttribute
Overlap Overlap
ScaleOverlaps
                     , Ratios -> CustomAttribute
Ratio Ratios
FillRatio
                     , [StyleItem] -> CustomAttribute
Style [StyleName -> [DotId] -> StyleItem
SItem StyleName
Filled []],ColorList -> CustomAttribute
Color [X11Color -> WeightedColor
forall nc. NamedColor nc => nc -> WeightedColor
toWColor X11Color
White]]
                  {-- home made attributes -}
                  [CustomAttribute] -> [CustomAttribute] -> [CustomAttribute]
forall a. Semigroup a => a -> a -> a
<> [(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloFoundations") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show ([Text] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Text] -> Level) -> [Text] -> Level
forall a b. (a -> b) -> a -> b
$ Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Phylo -> Vector Text
getRoots Phylo
phylo))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloTerms") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show ([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level]
forall a. Eq a => [a] -> [a]
nub ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [Level]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Level]] -> [Level]) -> [[Level]] -> [Level]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [Level]) -> [PhyloGroup] -> [[Level]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) ([PhyloGroup] -> [[Level]]) -> [PhyloGroup] -> [[Level]]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloDocs") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Double -> FilePath
forall a. Show a => a -> FilePath
show ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Map Level Double -> [Double]
forall k a. Map k a -> [a]
elems (Map Level Double -> [Double]) -> Map Level Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Phylo
phylo Phylo
-> Getting (Map Level Double) Phylo (Map Level Double)
-> Map Level Double
forall s a. s -> Getting a s a -> a
^. Getting (Map Level Double) Phylo (Map Level Double)
Lens' Phylo (Map Level Double)
phylo_timeDocs))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloPeriods") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show ([PhyloPeriod] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([PhyloPeriod] -> Level) -> [PhyloPeriod] -> Level
forall a b. (a -> b) -> a -> b
$ Map PhyloPeriodId PhyloPeriod -> [PhyloPeriod]
forall k a. Map k a -> [a]
elems (Map PhyloPeriodId PhyloPeriod -> [PhyloPeriod])
-> Map PhyloPeriodId PhyloPeriod -> [PhyloPeriod]
forall a b. (a -> b) -> a -> b
$ Phylo
phylo Phylo
-> Getting
     (Map PhyloPeriodId PhyloPeriod)
     Phylo
     (Map PhyloPeriodId PhyloPeriod)
-> Map PhyloPeriodId PhyloPeriod
forall s a. s -> Getting a s a -> a
^. Getting
  (Map PhyloPeriodId PhyloPeriod)
  Phylo
  (Map PhyloPeriodId PhyloPeriod)
Lens' Phylo (Map PhyloPeriodId PhyloPeriod)
phylo_periods))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloBranches") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show ([PhyloBranch] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([PhyloBranch] -> Level) -> [PhyloBranch] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloGroups") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Level -> FilePath
forall a. Show a => a -> FilePath
show ([PhyloGroup] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([PhyloGroup] -> Level) -> [PhyloGroup] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloSources") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ [Text] -> FilePath
forall a. Show a => a -> FilePath
show (Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Phylo -> Vector Text
getSources Phylo
phylo))
                     ,(DotId -> DotId -> CustomAttribute
toAttr (Text -> DotId
fromStrict Text
"phyloTimeScale") (DotId -> CustomAttribute) -> DotId -> CustomAttribute
forall a b. (a -> b) -> a -> b
$ FilePath -> DotId
pack (FilePath -> DotId) -> FilePath -> DotId
forall a b. (a -> b) -> a -> b
$ Phylo -> FilePath
getTimeScale Phylo
phylo)
                     -- ,(toAttr (fromStrict "phyloTermsFreq") $ pack $ show (toList $ _phylo_lastTermFreq phylo))
                     ])

{-
 -- toAttr (fromStrict k) $ (pack . unwords) $ map show v

        --  2) create a layer for the branches labels -}
        GraphID -> DotM DotId [()] -> Dot DotId
forall n a. GraphID -> DotM n a -> Dot n
subgraph (DotId -> GraphID
Str DotId
"Branches peaks") (DotM DotId [()] -> Dot DotId) -> DotM DotId [()] -> Dot DotId
forall a b. (a -> b) -> a -> b
$ 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
-}
            (PhyloBranch -> Dot DotId) -> [PhyloBranch] -> DotM DotId [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\PhyloBranch
b -> PhyloBranch -> Level -> Dot DotId
branchToDotNode PhyloBranch
b (Maybe Level -> Level
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Level -> Level) -> Maybe Level -> Level
forall a b. (a -> b) -> a -> b
$ PhyloBranch -> [PhyloBranch] -> Maybe Level
forall a. Eq a => a -> [a] -> Maybe Level
elemIndex PhyloBranch
b (PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches))) ([PhyloBranch] -> DotM DotId [()])
-> [PhyloBranch] -> DotM DotId [()]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches

        {--  5) create a layer for each period -}
        Map PhyloPeriodId ()
_ <- (PhyloPeriod -> Dot DotId)
-> Map PhyloPeriodId PhyloPeriod
-> DotM DotId (Map PhyloPeriodId ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\PhyloPeriod
period ->
                GraphID -> DotM DotId [()] -> Dot DotId
forall n a. GraphID -> DotM n a -> Dot n
subgraph ((DotId -> GraphID
Str (DotId -> GraphID) -> (FilePath -> DotId) -> FilePath -> GraphID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotId
fromStrict (Text -> DotId) -> (FilePath -> Text) -> FilePath -> DotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) (FilePath -> GraphID) -> FilePath -> GraphID
forall a b. (a -> b) -> a -> b
$ (FilePath
"Period" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloPeriod -> PhyloPeriodId
_phylo_periodPeriod PhyloPeriod
period) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloPeriod -> PhyloPeriodId
_phylo_periodPeriod PhyloPeriod
period))) (DotM DotId [()] -> Dot DotId) -> DotM DotId [()] -> Dot DotId
forall a b. (a -> b) -> a -> b
$ do 
                    [CustomAttribute] -> Dot DotId
forall n. [CustomAttribute] -> Dot n
graphAttrs [RankType -> CustomAttribute
Rank RankType
SameRank]
                    PhyloPeriodId -> (Text, Text) -> Dot DotId
periodToDotNode (PhyloPeriod
period PhyloPeriod
-> Getting PhyloPeriodId PhyloPeriod PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloPeriod PhyloPeriodId
Lens' PhyloPeriod PhyloPeriodId
phylo_periodPeriod) (PhyloPeriod
period PhyloPeriod
-> Getting (Text, Text) PhyloPeriod (Text, Text) -> (Text, Text)
forall s a. s -> Getting a s a -> a
^. Getting (Text, Text) PhyloPeriod (Text, Text)
Lens' PhyloPeriod (Text, Text)
phylo_periodPeriod')

                    {--  6) create a node for each group -}
                    (PhyloGroup -> Dot DotId) -> [PhyloGroup] -> DotM DotId [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\PhyloGroup
g -> Vector Text -> PhyloGroup -> Level -> Dot DotId
groupToDotNode (Phylo -> Vector Text
getRoots Phylo
phylo) PhyloGroup
g (PhyloGroup -> [PhyloBranch] -> Level
toBid PhyloGroup
g (PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches))) ((PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod PhyloPeriodId -> PhyloPeriodId -> Bool
forall a. Eq a => a -> a -> Bool
== (PhyloPeriod
period PhyloPeriod
-> Getting PhyloPeriodId PhyloPeriod PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloPeriod PhyloPeriodId
Lens' PhyloPeriod PhyloPeriodId
phylo_periodPeriod)) ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups)
            ) (Map PhyloPeriodId PhyloPeriod
 -> DotM DotId (Map PhyloPeriodId ()))
-> Map PhyloPeriodId PhyloPeriod
-> DotM DotId (Map PhyloPeriodId ())
forall a b. (a -> b) -> a -> b
$ Phylo
phylo Phylo
-> Getting
     (Map PhyloPeriodId PhyloPeriod)
     Phylo
     (Map PhyloPeriodId PhyloPeriod)
-> Map PhyloPeriodId PhyloPeriod
forall s a. s -> Getting a s a -> a
^. Getting
  (Map PhyloPeriodId PhyloPeriod)
  Phylo
  (Map PhyloPeriodId PhyloPeriod)
Lens' Phylo (Map PhyloPeriodId PhyloPeriod)
phylo_periods

        {--  7) create the edges between a branch and its first groups -}
        [[()]]
_ <- ((PhyloBranchId, [PhyloGroup]) -> DotM DotId [()])
-> [(PhyloBranchId, [PhyloGroup])] -> DotM DotId [[()]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(PhyloBranchId
bId,[PhyloGroup]
groups) ->
                (PhyloGroup -> Dot DotId) -> [PhyloGroup] -> DotM DotId [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\PhyloGroup
g -> DotId -> DotId -> FilePath -> EdgeType -> Dot DotId
toDotEdge (PhyloBranchId -> DotId
branchIdToDotId PhyloBranchId
bId) (PhyloGroupId -> DotId
groupIdToDotId (PhyloGroupId -> DotId) -> PhyloGroupId -> DotId
forall a b. (a -> b) -> a -> b
$ PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g) FilePath
"" EdgeType
BranchToGroup) [PhyloGroup]
groups 
             )
           ([(PhyloBranchId, [PhyloGroup])] -> DotM DotId [[()]])
-> [(PhyloBranchId, [PhyloGroup])] -> DotM DotId [[()]]
forall a b. (a -> b) -> a -> b
$ Map PhyloBranchId [PhyloGroup] -> [(PhyloBranchId, [PhyloGroup])]
forall k a. Map k a -> [(k, a)]
toList
           (Map PhyloBranchId [PhyloGroup] -> [(PhyloBranchId, [PhyloGroup])])
-> Map PhyloBranchId [PhyloGroup]
-> [(PhyloBranchId, [PhyloGroup])]
forall a b. (a -> b) -> a -> b
$ ([PhyloGroup] -> [PhyloGroup])
-> Map PhyloBranchId [PhyloGroup] -> Map PhyloBranchId [PhyloGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[PhyloGroup]
groups -> Text -> [[PhyloGroup]] -> [PhyloGroup]
forall a. Text -> [a] -> a
head' Text
"toDot" 
                           ([[PhyloGroup]] -> [PhyloGroup]) -> [[PhyloGroup]] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> PhyloGroup -> Bool)
-> [PhyloGroup] -> [[PhyloGroup]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\PhyloGroup
g PhyloGroup
g' -> PhyloGroup
g' PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod PhyloPeriodId -> PhyloPeriodId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod)
                           ([PhyloGroup] -> [[PhyloGroup]]) -> [PhyloGroup] -> [[PhyloGroup]]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> Level) -> [PhyloGroup] -> [PhyloGroup]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level)
-> (PhyloGroup -> PhyloPeriodId) -> PhyloGroup -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhyloGroup -> PhyloPeriodId
_phylo_groupPeriod) [PhyloGroup]
groups) 
           (Map PhyloBranchId [PhyloGroup] -> Map PhyloBranchId [PhyloGroup])
-> Map PhyloBranchId [PhyloGroup] -> Map PhyloBranchId [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ ([PhyloGroup] -> [PhyloGroup] -> [PhyloGroup])
-> [(PhyloBranchId, [PhyloGroup])]
-> Map PhyloBranchId [PhyloGroup]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith [PhyloGroup] -> [PhyloGroup] -> [PhyloGroup]
forall a. [a] -> [a] -> [a]
(++) ([(PhyloBranchId, [PhyloGroup])] -> Map PhyloBranchId [PhyloGroup])
-> [(PhyloBranchId, [PhyloGroup])]
-> Map PhyloBranchId [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> (PhyloBranchId, [PhyloGroup]))
-> [PhyloGroup] -> [(PhyloBranchId, [PhyloGroup])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> (PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId,[PhyloGroup
g])) ([PhyloGroup] -> [(PhyloBranchId, [PhyloGroup])])
-> [PhyloGroup] -> [(PhyloBranchId, [PhyloGroup])]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups

        {-  8) create the edges between the groups -}
        [()]
_ <- (((PhyloGroupId, PhyloGroupId), Double) -> Dot DotId)
-> [((PhyloGroupId, PhyloGroupId), Double)] -> DotM DotId [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\((PhyloGroupId
k,PhyloGroupId
k'),Double
v) -> 
                DotId -> DotId -> FilePath -> EdgeType -> Dot DotId
toDotEdge (PhyloGroupId -> DotId
groupIdToDotId PhyloGroupId
k) (PhyloGroupId -> DotId
groupIdToDotId PhyloGroupId
k') (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
v) EdgeType
GroupToGroup
            ) ([((PhyloGroupId, PhyloGroupId), Double)] -> DotM DotId [()])
-> [((PhyloGroupId, PhyloGroupId), Double)] -> DotM DotId [()]
forall a b. (a -> b) -> a -> b
$ (Map (PhyloGroupId, PhyloGroupId) Double
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall k a. Map k a -> [(k, a)]
toList (Map (PhyloGroupId, PhyloGroupId) Double
 -> [((PhyloGroupId, PhyloGroupId), Double)])
-> ([PhyloGroup] -> Map (PhyloGroupId, PhyloGroupId) Double)
-> [PhyloGroup]
-> [((PhyloGroupId, PhyloGroupId), Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PhyloGroup] -> Map (PhyloGroupId, PhyloGroupId) Double
mergePointers) ([PhyloGroup] -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [PhyloGroup] -> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups

        [()]
_ <- (((PhyloGroupId, PhyloGroupId), Double) -> Dot DotId)
-> [((PhyloGroupId, PhyloGroupId), Double)] -> DotM DotId [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\((PhyloGroupId
k,PhyloGroupId
k'),Double
v) -> 
                DotId -> DotId -> FilePath -> EdgeType -> Dot DotId
toDotEdge (PhyloGroupId -> DotId
groupIdToDotId PhyloGroupId
k) (PhyloGroupId -> DotId
groupIdToDotId PhyloGroupId
k') (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
v) EdgeType
GroupToAncestor
          ) ([((PhyloGroupId, PhyloGroupId), Double)] -> DotM DotId [()])
-> [((PhyloGroupId, PhyloGroupId), Double)] -> DotM DotId [()]
forall a b. (a -> b) -> a -> b
$ [PhyloGroup] -> [((PhyloGroupId, PhyloGroupId), Double)]
mergeAncestors ([PhyloGroup] -> [((PhyloGroupId, PhyloGroupId), Double)])
-> [PhyloGroup] -> [((PhyloGroupId, PhyloGroupId), Double)]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups

        -- 10) create the edges between the periods 
        [()]
_ <- ((PhyloPeriodId, PhyloPeriodId) -> Dot DotId)
-> [(PhyloPeriodId, PhyloPeriodId)] -> DotM DotId [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(PhyloPeriodId
prd,PhyloPeriodId
prd') ->
                DotId -> DotId -> FilePath -> EdgeType -> Dot DotId
toDotEdge (PhyloPeriodId -> DotId
periodIdToDotId PhyloPeriodId
prd) (PhyloPeriodId -> DotId
periodIdToDotId PhyloPeriodId
prd') FilePath
"" EdgeType
PeriodToPeriod
            ) ([(PhyloPeriodId, PhyloPeriodId)] -> DotM DotId [()])
-> [(PhyloPeriodId, PhyloPeriodId)] -> DotM DotId [()]
forall a b. (a -> b) -> a -> b
$ ((PhyloPeriodId, PhyloPeriodId)
 -> (PhyloPeriodId, PhyloPeriodId) -> Bool)
-> [(PhyloPeriodId, PhyloPeriodId)]
-> [(PhyloPeriodId, PhyloPeriodId)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(PhyloPeriodId, PhyloPeriodId)
combi (PhyloPeriodId, PhyloPeriodId)
combi' -> (PhyloPeriodId, PhyloPeriodId) -> PhyloPeriodId
forall a b. (a, b) -> a
fst (PhyloPeriodId, PhyloPeriodId)
combi PhyloPeriodId -> PhyloPeriodId -> Bool
forall a. Eq a => a -> a -> Bool
== (PhyloPeriodId, PhyloPeriodId) -> PhyloPeriodId
forall a b. (a, b) -> a
fst (PhyloPeriodId, PhyloPeriodId)
combi') ([(PhyloPeriodId, PhyloPeriodId)]
 -> [(PhyloPeriodId, PhyloPeriodId)])
-> [(PhyloPeriodId, PhyloPeriodId)]
-> [(PhyloPeriodId, PhyloPeriodId)]
forall a b. (a -> b) -> a -> b
$ [PhyloPeriodId] -> [(PhyloPeriodId, PhyloPeriodId)]
forall a. [a] -> [(a, a)]
listToCombi' ([PhyloPeriodId] -> [(PhyloPeriodId, PhyloPeriodId)])
-> [PhyloPeriodId] -> [(PhyloPeriodId, PhyloPeriodId)]
forall a b. (a -> b) -> a -> b
$ Phylo -> [PhyloPeriodId]
getPeriodIds Phylo
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
        -}


        [CustomAttribute] -> Dot DotId
forall n. [CustomAttribute] -> Dot n
graphAttrs [RankType -> CustomAttribute
Rank RankType
SameRank]


----------------
-- | Filter | --
----------------

filterByBranchSize :: Double -> PhyloExport -> PhyloExport
filterByBranchSize :: Double -> PhyloExport -> PhyloExport
filterByBranchSize Double
thr PhyloExport
export = 
    let splited :: ([PhyloBranch], [PhyloBranch])
splited  = (PhyloBranch -> Bool)
-> [PhyloBranch] -> ([PhyloBranch], [PhyloBranch])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\PhyloBranch
b -> Text -> [Double] -> Double
forall a. Text -> [a] -> a
head' Text
"filter" ((PhyloBranch
b PhyloBranch
-> Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
Lens' PhyloBranch (Map Text [Double])
branch_meta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"size") Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
thr) ([PhyloBranch] -> ([PhyloBranch], [PhyloBranch]))
-> [PhyloBranch] -> ([PhyloBranch], [PhyloBranch])
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches
     in PhyloExport
export PhyloExport -> (PhyloExport -> PhyloExport) -> PhyloExport
forall a b. a -> (a -> b) -> b
& ([PhyloBranch] -> Identity [PhyloBranch])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloBranch]
export_branches (([PhyloBranch] -> Identity [PhyloBranch])
 -> PhyloExport -> Identity PhyloExport)
-> [PhyloBranch] -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (([PhyloBranch], [PhyloBranch]) -> [PhyloBranch]
forall a b. (a, b) -> a
fst ([PhyloBranch], [PhyloBranch])
splited)
               PhyloExport -> (PhyloExport -> PhyloExport) -> PhyloExport
forall a b. a -> (a -> b) -> b
& ([PhyloGroup] -> Identity [PhyloGroup])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloGroup]
export_groups (([PhyloGroup] -> Identity [PhyloGroup])
 -> PhyloExport -> Identity PhyloExport)
-> ([PhyloGroup] -> [PhyloGroup]) -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PhyloBranchId -> [PhyloBranchId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem  (PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId) ((PhyloBranch -> PhyloBranchId) -> [PhyloBranch] -> [PhyloBranchId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PhyloBranch -> PhyloBranchId
_branch_id ([PhyloBranch] -> [PhyloBranchId])
-> [PhyloBranch] -> [PhyloBranchId]
forall a b. (a -> b) -> a -> b
$ ([PhyloBranch], [PhyloBranch]) -> [PhyloBranch]
forall a b. (a, b) -> b
snd ([PhyloBranch], [PhyloBranch])
splited)))


processFilters :: [Filter] -> Quality -> PhyloExport -> PhyloExport
processFilters :: [Filter] -> Quality -> PhyloExport -> PhyloExport
processFilters [Filter]
filters Quality
qua PhyloExport
export = 
    (PhyloExport -> Filter -> PhyloExport)
-> PhyloExport -> [Filter] -> PhyloExport
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PhyloExport
export' Filter
f -> case Filter
f of 
                ByBranchSize Double
thr -> if (Double
thr Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ Quality
qua Quality -> Getting Level Quality Level -> Level
forall s a. s -> Getting a s a -> a
^. Getting Level Quality Level
Lens' Quality Level
qua_minBranch))
                                      then Double -> PhyloExport -> PhyloExport
filterByBranchSize (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ Quality
qua Quality -> Getting Level Quality Level -> Level
forall s a. s -> Getting a s a -> a
^. Getting Level Quality Level
Lens' Quality Level
qua_minBranch) PhyloExport
export'
                                      else Double -> PhyloExport -> PhyloExport
filterByBranchSize Double
thr PhyloExport
export'  
        ) PhyloExport
export [Filter]
filters

--------------
-- | Sort | --
--------------

branchToIso :: [PhyloBranch] -> [PhyloBranch]
branchToIso :: [PhyloBranch] -> [PhyloBranch]
branchToIso [PhyloBranch]
branches =
    let steps :: [Double]
steps = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum
              ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [[Double]]
forall a. [a] -> [[a]]
inits
              ([Double] -> [[Double]]) -> [Double] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ ((PhyloBranch, Double) -> Double)
-> [(PhyloBranch, Double)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloBranch
b,Double
x) -> PhyloBranch
b PhyloBranch -> Getting Double PhyloBranch Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double PhyloBranch Double
Lens' PhyloBranch Double
branch_y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.05 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)
              ([(PhyloBranch, Double)] -> [Double])
-> [(PhyloBranch, Double)] -> [Double]
forall a b. (a -> b) -> a -> b
$ [PhyloBranch] -> [Double] -> [(PhyloBranch, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PhyloBranch]
branches 
              ([Double] -> [(PhyloBranch, Double)])
-> [Double] -> [(PhyloBranch, Double)]
forall a b. (a -> b) -> a -> b
$ ([Double
0] [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ (((PhyloBranch, PhyloBranch) -> Double)
-> [(PhyloBranch, PhyloBranch)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloBranch
b,PhyloBranch
b') -> 
                                 let idx :: Level
idx = [Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
commonPrefix (PhyloBranch
b PhyloBranch -> Getting [Level] PhyloBranch [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloBranch [Level]
Lens' PhyloBranch [Level]
branch_canonId) (PhyloBranch
b' PhyloBranch -> Getting [Level] PhyloBranch [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloBranch [Level]
Lens' PhyloBranch [Level]
branch_canonId) []
                                     lmin :: Level
lmin = Level -> Level -> Level
forall a. Ord a => a -> a -> a
min ([Double] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Double] -> Level) -> [Double] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch -> Getting [Double] PhyloBranch [Double] -> [Double]
forall s a. s -> Getting a s a -> a
^. Getting [Double] PhyloBranch [Double]
Lens' PhyloBranch [Double]
branch_seaLevel)  ([Double] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Double] -> Level) -> [Double] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b' PhyloBranch -> Getting [Double] PhyloBranch [Double] -> [Double]
forall s a. s -> Getting a s a -> a
^. Getting [Double] PhyloBranch [Double]
Lens' PhyloBranch [Double]
branch_seaLevel) 
                                  in 
                                    if ((Level
idx Level -> Level -> Level
forall a. Num a => a -> a -> a
- Level
1) Level -> Level -> Bool
forall a. Ord a => a -> a -> Bool
> (([Double] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Double] -> Level) -> [Double] -> Level
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b' PhyloBranch -> Getting [Double] PhyloBranch [Double] -> [Double]
forall s a. s -> Getting a s a -> a
^. Getting [Double] PhyloBranch [Double]
Lens' PhyloBranch [Double]
branch_seaLevel) Level -> Level -> Level
forall a. Num a => a -> a -> a
- Level
1))
                                      then (PhyloBranch
b' PhyloBranch -> Getting [Double] PhyloBranch [Double] -> [Double]
forall s a. s -> Getting a s a -> a
^. Getting [Double] PhyloBranch [Double]
Lens' PhyloBranch [Double]
branch_seaLevel) [Double] -> Level -> Double
forall a. [a] -> Level -> a
!! (Level
lmin Level -> Level -> Level
forall a. Num a => a -> a -> a
- Level
1)
                                      else (PhyloBranch
b' PhyloBranch -> Getting [Double] PhyloBranch [Double] -> [Double]
forall s a. s -> Getting a s a -> a
^. Getting [Double] PhyloBranch [Double]
Lens' PhyloBranch [Double]
branch_seaLevel) [Double] -> Level -> Double
forall a. [a] -> Level -> a
!! (Level
idx Level -> Level -> Level
forall a. Num a => a -> a -> a
- Level
1)
                                 ) ([(PhyloBranch, PhyloBranch)] -> [Double])
-> [(PhyloBranch, PhyloBranch)] -> [Double]
forall a b. (a -> b) -> a -> b
$ [PhyloBranch] -> [(PhyloBranch, PhyloBranch)]
forall a. Eq a => [a] -> [(a, a)]
listToSeq [PhyloBranch]
branches))
     in ((Double, PhyloBranch) -> PhyloBranch)
-> [(Double, PhyloBranch)] -> [PhyloBranch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Double
x,PhyloBranch
b) -> PhyloBranch
b PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch Double
branch_x ((Double -> Identity Double)
 -> PhyloBranch -> Identity PhyloBranch)
-> Double -> PhyloBranch -> PhyloBranch
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
x)
      ([(Double, PhyloBranch)] -> [PhyloBranch])
-> [(Double, PhyloBranch)] -> [PhyloBranch]
forall a b. (a -> b) -> a -> b
$ [Double] -> [PhyloBranch] -> [(Double, PhyloBranch)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
steps [PhyloBranch]
branches

branchToIso' :: Double -> Double -> [PhyloBranch] -> [PhyloBranch]
branchToIso' :: Double -> Double -> [PhyloBranch] -> [PhyloBranch]
branchToIso' Double
start Double
step [PhyloBranch]
branches = 
  let bx :: [Double]
bx = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[Double]
l -> ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum [Double]
l) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ((Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ [Double] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [Double]
l) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.5))
         ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [[Double]]
forall a. [a] -> [[a]]
inits
         ([Double] -> [[Double]]) -> [Double] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ ([Double
0] [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ (((PhyloBranch, PhyloBranch) -> Double)
-> [(PhyloBranch, PhyloBranch)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloBranch
b,PhyloBranch
b') -> 
                      let root :: Double
root = Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ [Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
commonPrefix (PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) (PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b' PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) []
                      in Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
step Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
root) ([(PhyloBranch, PhyloBranch)] -> [Double])
-> [(PhyloBranch, PhyloBranch)] -> [Double]
forall a b. (a -> b) -> a -> b
$ [PhyloBranch] -> [(PhyloBranch, PhyloBranch)]
forall a. Eq a => [a] -> [(a, a)]
listToSeq [PhyloBranch]
branches))
  in ((Double, PhyloBranch) -> PhyloBranch)
-> [(Double, PhyloBranch)] -> [PhyloBranch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Double
x,PhyloBranch
b) -> PhyloBranch
b PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch Double
branch_x ((Double -> Identity Double)
 -> PhyloBranch -> Identity PhyloBranch)
-> Double -> PhyloBranch -> PhyloBranch
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
x)
   ([(Double, PhyloBranch)] -> [PhyloBranch])
-> [(Double, PhyloBranch)] -> [PhyloBranch]
forall a b. (a -> b) -> a -> b
$ [Double] -> [PhyloBranch] -> [(Double, PhyloBranch)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
bx [PhyloBranch]
branches


sortByHierarchy :: Int -> [PhyloBranch] -> [PhyloBranch]
sortByHierarchy :: Level -> [PhyloBranch] -> [PhyloBranch]
sortByHierarchy Level
depth [PhyloBranch]
branches =
    if ([PhyloBranch] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [PhyloBranch]
branches Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
== Level
1)
        then [PhyloBranch]
branches
        else [[PhyloBranch]] -> [PhyloBranch]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 
           ([[PhyloBranch]] -> [PhyloBranch])
-> [[PhyloBranch]] -> [PhyloBranch]
forall a b. (a -> b) -> a -> b
$ ([PhyloBranch] -> [PhyloBranch])
-> [[PhyloBranch]] -> [[PhyloBranch]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[PhyloBranch]
branches' ->
                    let partitions :: ([PhyloBranch], [PhyloBranch])
partitions = (PhyloBranch -> Bool)
-> [PhyloBranch] -> ([PhyloBranch], [PhyloBranch])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\PhyloBranch
b -> Level
depth Level -> Level -> Level
forall a. Num a => a -> a -> a
+ Level
1 Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
== (([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level)
-> (PhyloBranchId -> [Level]) -> PhyloBranchId -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd) (PhyloBranchId -> Level) -> PhyloBranchId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id)) [PhyloBranch]
branches'
                    in  ((PhyloBranch -> [Double]) -> [PhyloBranch] -> [PhyloBranch]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\PhyloBranch
b -> (PhyloBranch
b PhyloBranch
-> Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
Lens' PhyloBranch (Map Text [Double])
branch_meta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"birth") (([PhyloBranch], [PhyloBranch]) -> [PhyloBranch]
forall a b. (a, b) -> a
fst ([PhyloBranch], [PhyloBranch])
partitions))
                    [PhyloBranch] -> [PhyloBranch] -> [PhyloBranch]
forall a. [a] -> [a] -> [a]
++  (Level -> [PhyloBranch] -> [PhyloBranch]
sortByHierarchy (Level
depth Level -> Level -> Level
forall a. Num a => a -> a -> a
+ Level
1) (([PhyloBranch], [PhyloBranch]) -> [PhyloBranch]
forall a b. (a, b) -> b
snd ([PhyloBranch], [PhyloBranch])
partitions))) 
            ([[PhyloBranch]] -> [[PhyloBranch]])
-> [[PhyloBranch]] -> [[PhyloBranch]]
forall a b. (a -> b) -> a -> b
$ (PhyloBranch -> PhyloBranch -> Bool)
-> [PhyloBranch] -> [[PhyloBranch]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\PhyloBranch
b PhyloBranch
b' -> ((Level -> [Level] -> [Level]
forall a. Level -> [a] -> [a]
take Level
depth ([Level] -> [Level])
-> (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd) (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) [Level] -> [Level] -> Bool
forall a. Eq a => a -> a -> Bool
== ((Level -> [Level] -> [Level]
forall a. Level -> [a] -> [a]
take Level
depth ([Level] -> [Level])
-> (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd) (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b' PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) )
            ([PhyloBranch] -> [[PhyloBranch]])
-> [PhyloBranch] -> [[PhyloBranch]]
forall a b. (a -> b) -> a -> b
$ (PhyloBranch -> [Level]) -> [PhyloBranch] -> [PhyloBranch]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\PhyloBranch
b -> (Level -> [Level] -> [Level]
forall a. Level -> [a] -> [a]
take Level
depth ([Level] -> [Level])
-> (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd) (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) [PhyloBranch]
branches


sortByBirthDate :: Order -> PhyloExport -> PhyloExport
sortByBirthDate :: Order -> PhyloExport -> PhyloExport
sortByBirthDate Order
order PhyloExport
export = 
    let branches :: [PhyloBranch]
branches  = (PhyloBranch -> [Double]) -> [PhyloBranch] -> [PhyloBranch]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\PhyloBranch
b -> (PhyloBranch
b PhyloBranch
-> Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloBranch (Map Text [Double])
Lens' PhyloBranch (Map Text [Double])
branch_meta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"birth") ([PhyloBranch] -> [PhyloBranch]) -> [PhyloBranch] -> [PhyloBranch]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches
        branches' :: [PhyloBranch]
branches' = case Order
order of
                    Order
Asc  -> [PhyloBranch]
branches
                    Order
Desc -> [PhyloBranch] -> [PhyloBranch]
forall a. [a] -> [a]
reverse [PhyloBranch]
branches
    in  PhyloExport
export PhyloExport -> (PhyloExport -> PhyloExport) -> PhyloExport
forall a b. a -> (a -> b) -> b
& ([PhyloBranch] -> Identity [PhyloBranch])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloBranch]
export_branches (([PhyloBranch] -> Identity [PhyloBranch])
 -> PhyloExport -> Identity PhyloExport)
-> [PhyloBranch] -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [PhyloBranch]
branches'

processSort :: Sort -> SeaElevation -> PhyloExport -> PhyloExport
processSort :: Sort -> SeaElevation -> PhyloExport -> PhyloExport
processSort Sort
sort' SeaElevation
elev PhyloExport
export = case Sort
sort' of
    ByBirthDate Order
o -> Order -> PhyloExport -> PhyloExport
sortByBirthDate Order
o PhyloExport
export 
    Sort
ByHierarchy   -> PhyloExport
export PhyloExport -> (PhyloExport -> PhyloExport) -> PhyloExport
forall a b. a -> (a -> b) -> b
& ([PhyloBranch] -> Identity [PhyloBranch])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloBranch]
export_branches (([PhyloBranch] -> Identity [PhyloBranch])
 -> PhyloExport -> Identity PhyloExport)
-> [PhyloBranch] -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Double -> [PhyloBranch] -> [PhyloBranch]
branchToIso' (SeaElevation -> Double
_cons_start SeaElevation
elev) (SeaElevation -> Double
_cons_step SeaElevation
elev) 
                       ([PhyloBranch] -> [PhyloBranch]) -> [PhyloBranch] -> [PhyloBranch]
forall a b. (a -> b) -> a -> b
$ Level -> [PhyloBranch] -> [PhyloBranch]
sortByHierarchy Level
0 (PhyloExport
export PhyloExport
-> Getting [PhyloBranch] PhyloExport [PhyloBranch] -> [PhyloBranch]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloBranch] PhyloExport [PhyloBranch]
Lens' PhyloExport [PhyloBranch]
export_branches))


-----------------
-- | Metrics | --
-----------------

-- | Return the conditional probability of i knowing j 
conditional :: Ord a => Map (a,a) Double -> a -> a -> Double
conditional :: Map (a, a) Double -> a -> a -> Double
conditional Map (a, a) Double
m a
i a
j = (Double -> (a, a) -> Map (a, a) Double -> Double
forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault Double
0 (a
i,a
j) Map (a, a) Double
m) 
                  Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Map (a, a) Double
m Map (a, a) Double -> (a, a) -> Double
forall k a. Ord k => Map k a -> k -> a
! (a
j,a
j))


-- | Return the genericity score of a given ngram
genericity :: Map (Int, Int) Double -> [Int] -> Int -> Double 
genericity :: Map PhyloPeriodId Double -> [Level] -> Level -> Double
genericity Map PhyloPeriodId Double
m [Level]
l Level
i = ( ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
j -> Map PhyloPeriodId Double -> Level -> Level -> Double
forall a. Ord a => Map (a, a) Double -> a -> a -> Double
conditional Map PhyloPeriodId Double
m Level
i Level
j) [Level]
l) 
                   Double -> Double -> Double
forall a. Num a => a -> a -> a
- ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
j -> Map PhyloPeriodId Double -> Level -> Level -> Double
forall a. Ord a => Map (a, a) Double -> a -> a -> Double
conditional Map PhyloPeriodId Double
m Level
j Level
i) [Level]
l)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ ([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [Level]
l) Level -> Level -> Level
forall a. Num a => a -> a -> a
+ Level
1)


-- | Return the specificity score of a given ngram
specificity :: Map (Int, Int) Double -> [Int] -> Int -> Double 
specificity :: Map PhyloPeriodId Double -> [Level] -> Level -> Double
specificity Map PhyloPeriodId Double
m [Level]
l Level
i = ( ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
j -> Map PhyloPeriodId Double -> Level -> Level -> Double
forall a. Ord a => Map (a, a) Double -> a -> a -> Double
conditional Map PhyloPeriodId Double
m Level
j Level
i) [Level]
l)
                    Double -> Double -> Double
forall a. Num a => a -> a -> a
- ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
j -> Map PhyloPeriodId Double -> Level -> Level -> Double
forall a. Ord a => Map (a, a) Double -> a -> a -> Double
conditional Map PhyloPeriodId Double
m Level
i Level
j) [Level]
l)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ ([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [Level]
l) Level -> Level -> Level
forall a. Num a => a -> a -> a
+ Level
1)                  


-- | Return the inclusion score of a given ngram
inclusion :: Map (Int, Int) Double -> [Int] -> Int -> Double 
inclusion :: Map PhyloPeriodId Double -> [Level] -> Level -> Double
inclusion Map PhyloPeriodId Double
m [Level]
l Level
i = ( ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
j -> Map PhyloPeriodId Double -> Level -> Level -> Double
forall a. Ord a => Map (a, a) Double -> a -> a -> Double
conditional Map PhyloPeriodId Double
m Level
j Level
i) [Level]
l)
                  Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ([Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
j -> Map PhyloPeriodId Double -> Level -> Level -> Double
forall a. Ord a => Map (a, a) Double -> a -> a -> Double
conditional Map PhyloPeriodId Double
m Level
i Level
j) [Level]
l)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ ([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [Level]
l) Level -> Level -> Level
forall a. Num a => a -> a -> a
+ Level
1)


ngramsMetrics :: Phylo -> PhyloExport -> PhyloExport
ngramsMetrics :: Phylo -> PhyloExport -> PhyloExport
ngramsMetrics Phylo
phylo PhyloExport
export =
    ASetter PhyloExport PhyloExport PhyloGroup PhyloGroup
-> (PhyloGroup -> PhyloGroup) -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ( ([PhyloGroup] -> Identity [PhyloGroup])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloGroup]
export_groups
         (([PhyloGroup] -> Identity [PhyloGroup])
 -> PhyloExport -> Identity PhyloExport)
-> ((PhyloGroup -> Identity PhyloGroup)
    -> [PhyloGroup] -> Identity [PhyloGroup])
-> ASetter PhyloExport PhyloExport PhyloGroup PhyloGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (PhyloGroup -> Identity PhyloGroup)
-> [PhyloGroup] -> Identity [PhyloGroup]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse )
    (\PhyloGroup
g -> PhyloGroup
g PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloGroup -> Identity PhyloGroup)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloGroup
-> PhyloGroup
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"genericity" 
                                  ((Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> Map PhyloPeriodId Double -> [Level] -> Level -> Double
genericity  (PhyloGroup
g PhyloGroup
-> Getting
     (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
-> Map PhyloPeriodId Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
Lens' PhyloGroup (Map PhyloPeriodId Double)
phylo_groupCooc) ((PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Level
n]) Level
n) ([Level] -> [Double]) -> [Level] -> [Double]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)
             PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloGroup -> Identity PhyloGroup)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloGroup
-> PhyloGroup
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"specificity" 
                                  ((Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> Map PhyloPeriodId Double -> [Level] -> Level -> Double
specificity (PhyloGroup
g PhyloGroup
-> Getting
     (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
-> Map PhyloPeriodId Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
Lens' PhyloGroup (Map PhyloPeriodId Double)
phylo_groupCooc) ((PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Level
n]) Level
n) ([Level] -> [Double]) -> [Level] -> [Double]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)
             PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloGroup -> Identity PhyloGroup)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloGroup
-> PhyloGroup
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"inclusion" 
                                  ((Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> Map PhyloPeriodId Double -> [Level] -> Level -> Double
inclusion   (PhyloGroup
g PhyloGroup
-> Getting
     (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
-> Map PhyloPeriodId Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
Lens' PhyloGroup (Map PhyloPeriodId Double)
phylo_groupCooc) ((PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Level
n]) Level
n) ([Level] -> [Double]) -> [Level] -> [Double]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)
             PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloGroup -> Identity PhyloGroup)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloGroup
-> PhyloGroup
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"frequence" 
                                  ((Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> Level -> Map Level Double -> Double
getInMap Level
n (Phylo
phylo Phylo
-> Getting (Map Level Double) Phylo (Map Level Double)
-> Map Level Double
forall s a. s -> Getting a s a -> a
^. Getting (Map Level Double) Phylo (Map Level Double)
Lens' Phylo (Map Level Double)
phylo_lastTermFreq)) ([Level] -> [Double]) -> [Level] -> [Double]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)                                  
        ) PhyloExport
export


branchDating :: PhyloExport -> PhyloExport
branchDating :: PhyloExport -> PhyloExport
branchDating PhyloExport
export =
    ASetter PhyloExport PhyloExport PhyloBranch PhyloBranch
-> (PhyloBranch -> PhyloBranch) -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ( ([PhyloBranch] -> Identity [PhyloBranch])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloBranch]
export_branches
         (([PhyloBranch] -> Identity [PhyloBranch])
 -> PhyloExport -> Identity PhyloExport)
-> ((PhyloBranch -> Identity PhyloBranch)
    -> [PhyloBranch] -> Identity [PhyloBranch])
-> ASetter PhyloExport PhyloExport PhyloBranch PhyloBranch
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (PhyloBranch -> Identity PhyloBranch)
-> [PhyloBranch] -> Identity [PhyloBranch]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse )
    (\PhyloBranch
b -> 
        let groups :: [PhyloPeriodId]
groups = (PhyloPeriodId -> Level) -> [PhyloPeriodId] -> [PhyloPeriodId]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst
                   ([PhyloPeriodId] -> [PhyloPeriodId])
-> [PhyloPeriodId] -> [PhyloPeriodId]
forall a b. (a -> b) -> a -> b
$ ([PhyloPeriodId] -> PhyloGroup -> [PhyloPeriodId])
-> [PhyloPeriodId] -> [PhyloGroup] -> [PhyloPeriodId]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[PhyloPeriodId]
acc PhyloGroup
g -> if (PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id)
                                      then [PhyloPeriodId]
acc [PhyloPeriodId] -> [PhyloPeriodId] -> [PhyloPeriodId]
forall a. [a] -> [a] -> [a]
++ [PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod]
                                      else [PhyloPeriodId]
acc ) [] ([PhyloGroup] -> [PhyloPeriodId])
-> [PhyloGroup] -> [PhyloPeriodId]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups
            periods :: [PhyloPeriodId]
periods = [PhyloPeriodId] -> [PhyloPeriodId]
forall a. Eq a => [a] -> [a]
nub [PhyloPeriodId]
groups
            birth :: Level
birth = PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ Text -> [PhyloPeriodId] -> PhyloPeriodId
forall a. Text -> [a] -> a
head' Text
"birth" [PhyloPeriodId]
groups
            age :: Level
age   = (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ Text -> [PhyloPeriodId] -> PhyloPeriodId
forall a. Text -> [a] -> a
last' Text
"age"  [PhyloPeriodId]
groups) Level -> Level -> Level
forall a. Num a => a -> a -> a
- Level
birth 
        in PhyloBranch
b PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch (Map Text [Double])
branch_meta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloBranch -> Identity PhyloBranch)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloBranch
-> PhyloBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"birth" [Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Level
birth] 
             PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch (Map Text [Double])
branch_meta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloBranch -> Identity PhyloBranch)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloBranch
-> PhyloBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"age"   [Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Level
age]
             PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch (Map Text [Double])
branch_meta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloBranch -> Identity PhyloBranch)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloBranch
-> PhyloBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"size"  [Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ [PhyloPeriodId] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [PhyloPeriodId]
periods] ) PhyloExport
export

processMetrics :: Phylo -> PhyloExport -> PhyloExport
processMetrics :: Phylo -> PhyloExport -> PhyloExport
processMetrics Phylo
phylo PhyloExport
export = Phylo -> PhyloExport -> PhyloExport
ngramsMetrics Phylo
phylo
                            (PhyloExport -> PhyloExport) -> PhyloExport -> PhyloExport
forall a b. (a -> b) -> a -> b
$ PhyloExport -> PhyloExport
branchDating PhyloExport
export 


-----------------
-- | Taggers | --
----------------- 

nk :: Int -> [[Int]] -> Int
nk :: Level -> [[Level]] -> Level
nk Level
n [[Level]]
groups = [Level] -> Level
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum
            ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ ([Level] -> Level) -> [[Level]] -> [Level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[Level]
g -> if (Level -> [Level] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Level
n [Level]
g)
                          then Level
1
                          else Level
0) [[Level]]
groups 


tf :: Int -> [[Int]] -> Double
tf :: Level -> [[Level]] -> Double
tf Level
n [[Level]]
groups = (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ Level -> [[Level]] -> Level
nk Level
n [[Level]]
groups) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ [Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [Level]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Level]]
groups)


idf :: Int -> [[Int]] -> Double
idf :: Level -> [[Level]] -> Double
idf Level
n [[Level]]
groups = Double -> Double
forall a. Floating a => a -> a
log ((Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ [[Level]] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [[Level]]
groups) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Level -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Level -> Double) -> Level -> Double
forall a b. (a -> b) -> a -> b
$ Level -> [[Level]] -> Level
nk Level
n [[Level]]
groups))


findTfIdf :: [[Int]] -> [(Int,Double)]
findTfIdf :: [[Level]] -> [(Level, Double)]
findTfIdf [[Level]]
groups = [(Level, Double)] -> [(Level, Double)]
forall a. [a] -> [a]
reverse ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ ((Level, Double) -> Double)
-> [(Level, Double)] -> [(Level, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Level, Double) -> Double
forall a b. (a, b) -> b
snd ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ (Level -> (Level, Double)) -> [Level] -> [(Level, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> (Level
n,(Level -> [[Level]] -> Double
tf Level
n [[Level]]
groups) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Level -> [[Level]] -> Double
idf Level
n [[Level]]
groups))) ([Level] -> [(Level, Double)]) -> [Level] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level]
forall a. Ord a => [a] -> [a]
sort ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level]
forall a. Eq a => [a] -> [a]
nub ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [Level]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Level]]
groups


findEmergences :: [PhyloGroup] -> Map Int Double -> [(Int,Double)]
findEmergences :: [PhyloGroup] -> Map Level Double -> [(Level, Double)]
findEmergences [PhyloGroup]
groups Map Level Double
freq =
  let ngrams :: [[Level]]
ngrams = (PhyloGroup -> [Level]) -> [PhyloGroup] -> [[Level]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PhyloGroup -> [Level]
_phylo_groupNgrams [PhyloGroup]
groups
      dynamics :: [[Double]]
dynamics = (PhyloGroup -> [Double]) -> [PhyloGroup] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> (PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"dynamics") [PhyloGroup]
groups
      emerging :: [(Level, Double)]
emerging = ((Level, Double) -> (Level, Double) -> Bool)
-> [(Level, Double)] -> [(Level, Double)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(Level, Double)
n1 (Level, Double)
n2 -> (Level, Double) -> Level
forall a b. (a, b) -> a
fst (Level, Double)
n1 Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
== (Level, Double) -> Level
forall a b. (a, b) -> a
fst (Level, Double)
n2) 
               ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ [[(Level, Double)]] -> [(Level, Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Level, Double)]] -> [(Level, Double)])
-> [[(Level, Double)]] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ (([Level], [Double]) -> [(Level, Double)])
-> [([Level], [Double])] -> [[(Level, Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\([Level], [Double])
g -> ((Level, Double) -> Bool) -> [(Level, Double)] -> [(Level, Double)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Level
_,Double
d) -> Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ [Level] -> [Double] -> [(Level, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Level], [Double]) -> [Level]
forall a b. (a, b) -> a
fst ([Level], [Double])
g) (([Level], [Double]) -> [Double]
forall a b. (a, b) -> b
snd ([Level], [Double])
g)) ([([Level], [Double])] -> [[(Level, Double)]])
-> [([Level], [Double])] -> [[(Level, Double)]]
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [[Double]] -> [([Level], [Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Level]]
ngrams [[Double]]
dynamics
  in [(Level, Double)] -> [(Level, Double)]
forall a. [a] -> [a]
reverse ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ ((Level, Double) -> Double)
-> [(Level, Double)] -> [(Level, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Level, Double) -> Double
forall a b. (a, b) -> b
snd
   ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ ((Level, Double) -> (Level, Double))
-> [(Level, Double)] -> [(Level, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Level
n,Double
_) -> if (Level -> Map Level Double -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member Level
n Map Level Double
freq)
                      then (Level
n,Map Level Double
freq Map Level Double -> Level -> Double
forall k a. Ord k => Map k a -> k -> a
! Level
n)
                      else (Level
n,Double
0)) [(Level, Double)]
emerging


mostEmergentTfIdf :: Int -> Map Int Double -> Vector Ngrams -> PhyloExport -> PhyloExport 
mostEmergentTfIdf :: Level
-> Map Level Double -> Vector Text -> PhyloExport -> PhyloExport
mostEmergentTfIdf Level
nth Map Level Double
freq Vector Text
foundations PhyloExport
export = 
    ASetter PhyloExport PhyloExport PhyloBranch PhyloBranch
-> (PhyloBranch -> PhyloBranch) -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ( ([PhyloBranch] -> Identity [PhyloBranch])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloBranch]
export_branches
         (([PhyloBranch] -> Identity [PhyloBranch])
 -> PhyloExport -> Identity PhyloExport)
-> ((PhyloBranch -> Identity PhyloBranch)
    -> [PhyloBranch] -> Identity [PhyloBranch])
-> ASetter PhyloExport PhyloExport PhyloBranch PhyloBranch
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (PhyloBranch -> Identity PhyloBranch)
-> [PhyloBranch] -> Identity [PhyloBranch]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse )
         (\PhyloBranch
b -> 
            let groups :: [PhyloGroup]
groups = (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups
                tfidf :: [(Level, Double)]
tfidf  = [[Level]] -> [(Level, Double)]
findTfIdf ((PhyloGroup -> [Level]) -> [PhyloGroup] -> [[Level]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PhyloGroup -> [Level]
_phylo_groupNgrams [PhyloGroup]
groups)
                emergences :: [(Level, Double)]
emergences = [PhyloGroup] -> Map Level Double -> [(Level, Double)]
findEmergences [PhyloGroup]
groups Map Level Double
freq
                selected :: [Level]
selected = if ([(Level, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Level, Double)]
emergences)
                            then ((Level, Double) -> Level) -> [(Level, Double)] -> [Level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Level, Double) -> Level
forall a b. (a, b) -> a
fst ([(Level, Double)] -> [Level]) -> [(Level, Double)] -> [Level]
forall a b. (a -> b) -> a -> b
$ Level -> [(Level, Double)] -> [(Level, Double)]
forall a. Level -> [a] -> [a]
take Level
nth [(Level, Double)]
tfidf
                            else [(Level, Double) -> Level
forall a b. (a, b) -> a
fst ((Level, Double) -> Level) -> (Level, Double) -> Level
forall a b. (a -> b) -> a -> b
$ Text -> [(Level, Double)] -> (Level, Double)
forall a. Text -> [a] -> a
head' Text
"mostEmergentTfIdf" [(Level, Double)]
emergences] 
                              [Level] -> [Level] -> [Level]
forall a. [a] -> [a] -> [a]
++ (((Level, Double) -> Level) -> [(Level, Double)] -> [Level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Level, Double) -> Level
forall a b. (a, b) -> a
fst ([(Level, Double)] -> [Level]) -> [(Level, Double)] -> [Level]
forall a b. (a -> b) -> a -> b
$ Level -> [(Level, Double)] -> [(Level, Double)]
forall a. Level -> [a] -> [a]
take (Level
nth Level -> Level -> Level
forall a. Num a => a -> a -> a
- Level
1) ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ ((Level, Double) -> Bool) -> [(Level, Double)] -> [(Level, Double)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Level
n,Double
_) -> Level
n Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
/= ((Level, Double) -> Level
forall a b. (a, b) -> a
fst ((Level, Double) -> Level) -> (Level, Double) -> Level
forall a b. (a -> b) -> a -> b
$ Text -> [(Level, Double)] -> (Level, Double)
forall a. Text -> [a] -> a
head' Text
"mostEmergentTfIdf" [(Level, Double)]
emergences)) [(Level, Double)]
tfidf) 
            in PhyloBranch
b PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch Text
branch_label ((Text -> Identity Text) -> PhyloBranch -> Identity PhyloBranch)
-> Text -> PhyloBranch -> PhyloBranch
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Vector Text -> [Level] -> Text
ngramsToLabel Vector Text
foundations [Level]
selected)) PhyloExport
export


getNthMostMeta :: Int -> [Double] -> [Int] -> [Int]
getNthMostMeta :: Level -> [Double] -> [Level] -> [Level]
getNthMostMeta Level
nth [Double]
meta [Level]
ns = ((Level, Double) -> Level) -> [(Level, Double)] -> [Level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Level
idx,Double
_) -> ([Level]
ns [Level] -> Level -> Level
forall a. [a] -> Level -> a
!! Level
idx))
                           ([(Level, Double)] -> [Level]) -> [(Level, Double)] -> [Level]
forall a b. (a -> b) -> a -> b
$ Level -> [(Level, Double)] -> [(Level, Double)]
forall a. Level -> [a] -> [a]
take Level
nth
                           ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ [(Level, Double)] -> [(Level, Double)]
forall a. [a] -> [a]
reverse
                           ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ ((Level, Double) -> Double)
-> [(Level, Double)] -> [(Level, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Level, Double) -> Double
forall a b. (a, b) -> b
snd ([(Level, Double)] -> [(Level, Double)])
-> [(Level, Double)] -> [(Level, Double)]
forall a b. (a -> b) -> a -> b
$ [Level] -> [Double] -> [(Level, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Level
0..] [Double]
meta 


mostInclusive :: Int -> Vector Ngrams -> PhyloExport -> PhyloExport
mostInclusive :: Level -> Vector Text -> PhyloExport -> PhyloExport
mostInclusive Level
nth Vector Text
foundations PhyloExport
export =
    ASetter PhyloExport PhyloExport PhyloBranch PhyloBranch
-> (PhyloBranch -> PhyloBranch) -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ( ([PhyloBranch] -> Identity [PhyloBranch])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloBranch]
export_branches
         (([PhyloBranch] -> Identity [PhyloBranch])
 -> PhyloExport -> Identity PhyloExport)
-> ((PhyloBranch -> Identity PhyloBranch)
    -> [PhyloBranch] -> Identity [PhyloBranch])
-> ASetter PhyloExport PhyloExport PhyloBranch PhyloBranch
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (PhyloBranch -> Identity PhyloBranch)
-> [PhyloBranch] -> Identity [PhyloBranch]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse )
         (\PhyloBranch
b -> 
            let groups :: [PhyloGroup]
groups = (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloBranch
b PhyloBranch
-> Getting PhyloBranchId PhyloBranch PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloBranch PhyloBranchId
Lens' PhyloBranch PhyloBranchId
branch_id) ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ PhyloExport
export PhyloExport
-> Getting [PhyloGroup] PhyloExport [PhyloGroup] -> [PhyloGroup]
forall s a. s -> Getting a s a -> a
^. Getting [PhyloGroup] PhyloExport [PhyloGroup]
Lens' PhyloExport [PhyloGroup]
export_groups
                cooc :: Map PhyloPeriodId Double
cooc   = (Map PhyloPeriodId Double
 -> PhyloGroup -> Map PhyloPeriodId Double)
-> Map PhyloPeriodId Double
-> [PhyloGroup]
-> Map PhyloPeriodId Double
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map PhyloPeriodId Double
acc PhyloGroup
g -> (Double -> Double -> Double)
-> Map PhyloPeriodId Double
-> Map PhyloPeriodId Double
-> Map PhyloPeriodId Double
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Map PhyloPeriodId Double
acc (PhyloGroup
g PhyloGroup
-> Getting
     (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
-> Map PhyloPeriodId Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map PhyloPeriodId Double) PhyloGroup (Map PhyloPeriodId Double)
Lens' PhyloGroup (Map PhyloPeriodId Double)
phylo_groupCooc)) Map PhyloPeriodId Double
forall k a. Map k a
empty [PhyloGroup]
groups
                ngrams :: [Level]
ngrams = [Level] -> [Level]
forall a. Ord a => [a] -> [a]
sort ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ ([Level] -> PhyloGroup -> [Level])
-> [Level] -> [PhyloGroup] -> [Level]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[Level]
acc PhyloGroup
g -> [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a]
union [Level]
acc (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)) [] [PhyloGroup]
groups
                inc :: [Double]
inc    = (Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> Map PhyloPeriodId Double -> [Level] -> Level -> Double
inclusion Map PhyloPeriodId Double
cooc ([Level]
ngrams [Level] -> [Level] -> [Level]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Level
n]) Level
n) [Level]
ngrams
                lbl :: Text
lbl    = Vector Text -> [Level] -> Text
ngramsToLabel Vector Text
foundations ([Level] -> Text) -> [Level] -> Text
forall a b. (a -> b) -> a -> b
$ Level -> [Double] -> [Level] -> [Level]
getNthMostMeta Level
nth [Double]
inc [Level]
ngrams
            in PhyloBranch
b PhyloBranch -> (PhyloBranch -> PhyloBranch) -> PhyloBranch
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> PhyloBranch -> Identity PhyloBranch
Lens' PhyloBranch Text
branch_label ((Text -> Identity Text) -> PhyloBranch -> Identity PhyloBranch)
-> Text -> PhyloBranch -> PhyloBranch
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
lbl ) PhyloExport
export


mostEmergentInclusive :: Int -> Vector Ngrams -> PhyloExport -> PhyloExport
mostEmergentInclusive :: Level -> Vector Text -> PhyloExport -> PhyloExport
mostEmergentInclusive Level
nth Vector Text
foundations PhyloExport
export =
    ASetter PhyloExport PhyloExport PhyloGroup PhyloGroup
-> (PhyloGroup -> PhyloGroup) -> PhyloExport -> PhyloExport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ( ([PhyloGroup] -> Identity [PhyloGroup])
-> PhyloExport -> Identity PhyloExport
Lens' PhyloExport [PhyloGroup]
export_groups
         (([PhyloGroup] -> Identity [PhyloGroup])
 -> PhyloExport -> Identity PhyloExport)
-> ((PhyloGroup -> Identity PhyloGroup)
    -> [PhyloGroup] -> Identity [PhyloGroup])
-> ASetter PhyloExport PhyloExport PhyloGroup PhyloGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (PhyloGroup -> Identity PhyloGroup)
-> [PhyloGroup] -> Identity [PhyloGroup]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ) 
         (\PhyloGroup
g -> 
            let lbl :: Text
lbl = Vector Text -> [Level] -> Text
ngramsToLabel Vector Text
foundations
                    ([Level] -> Text) -> [Level] -> Text
forall a b. (a -> b) -> a -> b
$ Level -> [Level] -> [Level]
forall a. Level -> [a] -> [a]
take Level
nth 
                    ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ ((Double, (Double, Level)) -> Level)
-> [(Double, (Double, Level))] -> [Level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Double
_,(Double
_,Level
idx)) -> Level
idx)
                    ([(Double, (Double, Level))] -> [Level])
-> [(Double, (Double, Level))] -> [Level]
forall a b. (a -> b) -> a -> b
$ [[(Double, (Double, Level))]] -> [(Double, (Double, Level))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    ([[(Double, (Double, Level))]] -> [(Double, (Double, Level))])
-> [[(Double, (Double, Level))]] -> [(Double, (Double, Level))]
forall a b. (a -> b) -> a -> b
$ ([(Double, (Double, Level))] -> [(Double, (Double, Level))])
-> [[(Double, (Double, Level))]] -> [[(Double, (Double, Level))]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[(Double, (Double, Level))]
groups -> ((Double, (Double, Level)) -> Double)
-> [(Double, (Double, Level))] -> [(Double, (Double, Level))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Double, Level) -> Double
forall a b. (a, b) -> a
fst ((Double, Level) -> Double)
-> ((Double, (Double, Level)) -> (Double, Level))
-> (Double, (Double, Level))
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, (Double, Level)) -> (Double, Level)
forall a b. (a, b) -> b
snd) [(Double, (Double, Level))]
groups)
                    ([[(Double, (Double, Level))]] -> [[(Double, (Double, Level))]])
-> [[(Double, (Double, Level))]] -> [[(Double, (Double, Level))]]
forall a b. (a -> b) -> a -> b
$ ((Double, (Double, Level)) -> (Double, (Double, Level)) -> Bool)
-> [(Double, (Double, Level))] -> [[(Double, (Double, Level))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Double -> Double -> Bool)
-> ((Double, (Double, Level)) -> Double)
-> (Double, (Double, Level))
-> (Double, (Double, Level))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Double, (Double, Level)) -> Double
forall a b. (a, b) -> a
fst) ([(Double, (Double, Level))] -> [[(Double, (Double, Level))]])
-> [(Double, (Double, Level))] -> [[(Double, (Double, Level))]]
forall a b. (a -> b) -> a -> b
$ [(Double, (Double, Level))] -> [(Double, (Double, Level))]
forall a. [a] -> [a]
reverse ([(Double, (Double, Level))] -> [(Double, (Double, Level))])
-> [(Double, (Double, Level))] -> [(Double, (Double, Level))]
forall a b. (a -> b) -> a -> b
$ ((Double, (Double, Level)) -> Double)
-> [(Double, (Double, Level))] -> [(Double, (Double, Level))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Double, (Double, Level)) -> Double
forall a b. (a, b) -> a
fst                
                    ([(Double, (Double, Level))] -> [(Double, (Double, Level))])
-> [(Double, (Double, Level))] -> [(Double, (Double, Level))]
forall a b. (a -> b) -> a -> b
$ [Double] -> [(Double, Level)] -> [(Double, (Double, Level))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"inclusion")
                    ([(Double, Level)] -> [(Double, (Double, Level))])
-> [(Double, Level)] -> [(Double, (Double, Level))]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Level] -> [(Double, Level)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"dynamics") (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams)
            in PhyloGroup
g PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup Text
phylo_groupLabel ((Text -> Identity Text) -> PhyloGroup -> Identity PhyloGroup)
-> Text -> PhyloGroup -> PhyloGroup
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
lbl ) PhyloExport
export


processLabels :: [PhyloLabel] -> Vector Ngrams -> Map Int Double -> PhyloExport -> PhyloExport
processLabels :: [PhyloLabel]
-> Vector Text -> Map Level Double -> PhyloExport -> PhyloExport
processLabels [PhyloLabel]
labels Vector Text
foundations Map Level Double
freq PhyloExport
export =
    (PhyloExport -> PhyloLabel -> PhyloExport)
-> PhyloExport -> [PhyloLabel] -> PhyloExport
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PhyloExport
export' PhyloLabel
label -> 
                case PhyloLabel
label of
                    GroupLabel  Tagger
tagger Level
nth -> 
                        case Tagger
tagger of
                            Tagger
MostEmergentInclusive -> Level -> Vector Text -> PhyloExport -> PhyloExport
mostEmergentInclusive Level
nth Vector Text
foundations PhyloExport
export' 
                            Tagger
_ -> Text -> PhyloExport
forall a. HasCallStack => Text -> a
panic Text
"[ERR][Viz.Phylo.PhyloExport] unknown tagger"
                    BranchLabel Tagger
tagger Level
nth ->
                        case Tagger
tagger of
                            Tagger
MostInclusive -> Level -> Vector Text -> PhyloExport -> PhyloExport
mostInclusive Level
nth Vector Text
foundations PhyloExport
export'
                            Tagger
MostEmergentTfIdf -> Level
-> Map Level Double -> Vector Text -> PhyloExport -> PhyloExport
mostEmergentTfIdf Level
nth Map Level Double
freq Vector Text
foundations PhyloExport
export'
                            Tagger
_ -> Text -> PhyloExport
forall a. HasCallStack => Text -> a
panic Text
"[ERR][Viz.Phylo.PhyloExport] unknown tagger" ) PhyloExport
export [PhyloLabel]
labels 


------------------
-- | Dynamics | --
------------------ 


toDynamics :: Int -> [PhyloGroup] -> PhyloGroup -> Map Int (Date,Date) -> Double
toDynamics :: Level
-> [PhyloGroup] -> PhyloGroup -> Map Level PhyloPeriodId -> Double
toDynamics Level
n [PhyloGroup]
parents PhyloGroup
g Map Level PhyloPeriodId
m = 
    let prd :: PhyloPeriodId
prd = PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod
        end :: Level
end = Text -> [Level] -> Level
forall a. Text -> [a] -> a
last' Text
"dynamics" ([Level] -> [Level]
forall a. Ord a => [a] -> [a]
sort ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ (PhyloPeriodId -> Level) -> [PhyloPeriodId] -> [Level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd ([PhyloPeriodId] -> [Level]) -> [PhyloPeriodId] -> [Level]
forall a b. (a -> b) -> a -> b
$ Map Level PhyloPeriodId -> [PhyloPeriodId]
forall k a. Map k a -> [a]
elems Map Level PhyloPeriodId
m)
    in  if (((PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd PhyloPeriodId
prd) Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
== (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ Map Level PhyloPeriodId
m Map Level PhyloPeriodId -> Level -> PhyloPeriodId
forall k a. Ord k => Map k a -> k -> a
! Level
n)) Bool -> Bool -> Bool
&& (PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd PhyloPeriodId
prd Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
/= Level
end))
            {- decrease -}
            then Double
2
        else if ((PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst PhyloPeriodId
prd) Level -> Level -> Bool
forall a. Eq a => a -> a -> Bool
== (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ Map Level PhyloPeriodId
m Map Level PhyloPeriodId -> Level -> PhyloPeriodId
forall k a. Ord k => Map k a -> k -> a
! Level
n))
            {- emerging -}
            then Double
0
        else if Bool
isNew
            {- emergence -}
            then Double
1
        else Double
3
    where
        -------------------------------------- 
        isNew :: Bool
        isNew :: Bool
isNew = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Level -> [Level] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Level
n ([Level] -> Bool) -> [Level] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [Level]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Level]] -> [Level]) -> [[Level]] -> [Level]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [Level]) -> [PhyloGroup] -> [[Level]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PhyloGroup -> [Level]
_phylo_groupNgrams [PhyloGroup]
parents


processDynamics :: [PhyloGroup] -> [PhyloGroup]
processDynamics :: [PhyloGroup] -> [PhyloGroup]
processDynamics [PhyloGroup]
groups =
    (PhyloGroup -> PhyloGroup) -> [PhyloGroup] -> [PhyloGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g ->
        let parents :: [PhyloGroup]
parents = (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g' -> (PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloGroup
g' PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId)
                                  Bool -> Bool -> Bool
&& ((PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod) Level -> Level -> Bool
forall a. Ord a => a -> a -> Bool
> (PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g' PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod))) [PhyloGroup]
groups
        in  PhyloGroup
g PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& (Map Text [Double] -> Identity (Map Text [Double]))
-> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta ((Map Text [Double] -> Identity (Map Text [Double]))
 -> PhyloGroup -> Identity PhyloGroup)
-> (Map Text [Double] -> Map Text [Double])
-> PhyloGroup
-> PhyloGroup
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> [Double] -> Map Text [Double] -> Map Text [Double]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
"dynamics" ((Level -> Double) -> [Level] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> Level
-> [PhyloGroup] -> PhyloGroup -> Map Level PhyloPeriodId -> Double
toDynamics Level
n [PhyloGroup]
parents PhyloGroup
g Map Level PhyloPeriodId
mapNgrams) ([Level] -> [Double]) -> [Level] -> [Double]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) ) [PhyloGroup]
groups
    where
        --------------------------------------
        mapNgrams :: Map Int (Date,Date)
        mapNgrams :: Map Level PhyloPeriodId
mapNgrams = ([Level] -> PhyloPeriodId)
-> Map Level [Level] -> Map Level PhyloPeriodId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[Level]
dates -> 
                        let dates' :: [Level]
dates' = [Level] -> [Level]
forall a. Ord a => [a] -> [a]
sort [Level]
dates
                        in (Text -> [Level] -> Level
forall a. Text -> [a] -> a
head' Text
"dynamics" [Level]
dates', Text -> [Level] -> Level
forall a. Text -> [a] -> a
last' Text
"dynamics" [Level]
dates'))
                  (Map Level [Level] -> Map Level PhyloPeriodId)
-> Map Level [Level] -> Map Level PhyloPeriodId
forall a b. (a -> b) -> a -> b
$ ([Level] -> [Level] -> [Level])
-> [PhyloBranchId] -> Map Level [Level]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith [Level] -> [Level] -> [Level]
forall a. [a] -> [a] -> [a]
(++)
                  ([PhyloBranchId] -> Map Level [Level])
-> [PhyloBranchId] -> Map Level [Level]
forall a b. (a -> b) -> a -> b
$ ([PhyloBranchId] -> PhyloGroup -> [PhyloBranchId])
-> [PhyloBranchId] -> [PhyloGroup] -> [PhyloBranchId]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[PhyloBranchId]
acc PhyloGroup
g -> [PhyloBranchId]
acc [PhyloBranchId] -> [PhyloBranchId] -> [PhyloBranchId]
forall a. [a] -> [a] -> [a]
++ ( (Level -> PhyloBranchId) -> [Level] -> [PhyloBranchId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Level
n -> (Level
n,[PhyloPeriodId -> Level
forall a b. (a, b) -> a
fst (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod, PhyloPeriodId -> Level
forall a b. (a, b) -> b
snd (PhyloPeriodId -> Level) -> PhyloPeriodId -> Level
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloPeriodId PhyloGroup PhyloPeriodId -> PhyloPeriodId
forall s a. s -> Getting a s a -> a
^. Getting PhyloPeriodId PhyloGroup PhyloPeriodId
Lens' PhyloGroup PhyloPeriodId
phylo_groupPeriod])) 
                                            ([Level] -> [PhyloBranchId]) -> [Level] -> [PhyloBranchId]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams))) [] [PhyloGroup]
groups


-----------------
-- | horizon | --
-----------------

getGroupThr :: Double -> PhyloGroup -> Double
getGroupThr :: Double -> PhyloGroup -> Double
getGroupThr Double
step PhyloGroup
g = 
    let seaLvl :: [Double]
seaLvl = (PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"seaLevels"
        breaks :: [Double]
breaks = (PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"breaks"
     in (Text -> [Double] -> Double
forall a. Text -> [a] -> a
last' Text
"export" (Level -> [Double] -> [Double]
forall a. Level -> [a] -> [a]
take (Double -> Level
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Level) -> Double -> Level
forall a b. (a -> b) -> a -> b
$ (Text -> [Double] -> Double
forall a. Text -> [a] -> a
last' Text
"export" [Double]
breaks) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) [Double]
seaLvl)) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
step

toAncestor :: Double -> Map Int Double -> Proximity -> Double -> [PhyloGroup] -> PhyloGroup -> PhyloGroup
toAncestor :: Double
-> Map Level Double
-> Proximity
-> Double
-> [PhyloGroup]
-> PhyloGroup
-> PhyloGroup
toAncestor Double
nbDocs Map Level Double
diago Proximity
proximity Double
step [PhyloGroup]
candidates PhyloGroup
ego =
  let curr :: [(PhyloGroupId, Double)]
curr = PhyloGroup
ego PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupAncestors 
   in PhyloGroup
ego PhyloGroup -> (PhyloGroup -> PhyloGroup) -> PhyloGroup
forall a b. a -> (a -> b) -> b
& ([(PhyloGroupId, Double)] -> Identity [(PhyloGroupId, Double)])
-> PhyloGroup -> Identity PhyloGroup
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupAncestors (([(PhyloGroupId, Double)] -> Identity [(PhyloGroupId, Double)])
 -> PhyloGroup -> Identity PhyloGroup)
-> [(PhyloGroupId, Double)] -> PhyloGroup -> PhyloGroup
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([(PhyloGroupId, Double)]
curr [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)] -> [(PhyloGroupId, Double)]
forall a. [a] -> [a] -> [a]
++ (((PhyloGroup, Double) -> (PhyloGroupId, Double))
-> [(PhyloGroup, Double)] -> [(PhyloGroupId, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(PhyloGroup
g,Double
w) -> (PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g,Double
w))
         ([(PhyloGroup, Double)] -> [(PhyloGroupId, Double)])
-> [(PhyloGroup, Double)] -> [(PhyloGroupId, Double)]
forall a b. (a -> b) -> a -> b
$ ((PhyloGroup, Double) -> Bool)
-> [(PhyloGroup, Double)] -> [(PhyloGroup, Double)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PhyloGroup
g,Double
w) -> (Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) Bool -> Bool -> Bool
&& (Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double -> PhyloGroup -> Double
getGroupThr Double
step PhyloGroup
ego) (Double -> PhyloGroup -> Double
getGroupThr Double
step PhyloGroup
g))))
         ([(PhyloGroup, Double)] -> [(PhyloGroup, Double)])
-> [(PhyloGroup, Double)] -> [(PhyloGroup, Double)]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> (PhyloGroup, Double))
-> [PhyloGroup] -> [(PhyloGroup, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> (PhyloGroup
g, Double
-> Map Level Double
-> Proximity
-> [Level]
-> [Level]
-> [Level]
-> Double
toProximity Double
nbDocs Map Level Double
diago Proximity
proximity (PhyloGroup
ego PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) (PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams))) 
         ([PhyloGroup] -> [(PhyloGroup, Double)])
-> [PhyloGroup] -> [(PhyloGroup, Double)]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
/= PhyloGroup
ego PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId ) [PhyloGroup]
candidates))


headsToAncestors :: Double -> Map Int Double -> Proximity -> Double -> [PhyloGroup] -> [PhyloGroup] -> [PhyloGroup]
headsToAncestors :: Double
-> Map Level Double
-> Proximity
-> Double
-> [PhyloGroup]
-> [PhyloGroup]
-> [PhyloGroup]
headsToAncestors Double
nbDocs Map Level Double
diago Proximity
proximity Double
step [PhyloGroup]
heads [PhyloGroup]
acc =
  if ([PhyloGroup] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PhyloGroup]
heads)
    then [PhyloGroup]
acc
    else 
      let ego :: PhyloGroup
ego    = Text -> [PhyloGroup] -> PhyloGroup
forall a. Text -> [a] -> a
head' Text
"headsToAncestors" [PhyloGroup]
heads
          heads' :: [PhyloGroup]
heads' = Text -> [PhyloGroup] -> [PhyloGroup]
forall a. Text -> [a] -> [a]
tail' Text
"headsToAncestors" [PhyloGroup]
heads
       in Double
-> Map Level Double
-> Proximity
-> Double
-> [PhyloGroup]
-> [PhyloGroup]
-> [PhyloGroup]
headsToAncestors Double
nbDocs Map Level Double
diago Proximity
proximity Double
step [PhyloGroup]
heads' ([PhyloGroup]
acc [PhyloGroup] -> [PhyloGroup] -> [PhyloGroup]
forall a. [a] -> [a] -> [a]
++ [Double
-> Map Level Double
-> Proximity
-> Double
-> [PhyloGroup]
-> PhyloGroup
-> PhyloGroup
toAncestor Double
nbDocs Map Level Double
diago Proximity
proximity Double
step [PhyloGroup]
heads' PhyloGroup
ego])


toHorizon :: Phylo -> Phylo
toHorizon :: Phylo -> Phylo
toHorizon Phylo
phylo = 
  let phyloAncestor :: Phylo
phyloAncestor = Level -> Map PhyloGroupId PhyloGroup -> Phylo -> Phylo
updatePhyloGroups 
                    Level
level 
                    ([(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup)
-> [(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> (PhyloGroupId, PhyloGroup))
-> [PhyloGroup] -> [(PhyloGroupId, PhyloGroup)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> (PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g, PhyloGroup
g)) 
                              ([PhyloGroup] -> [(PhyloGroupId, PhyloGroup)])
-> [PhyloGroup] -> [(PhyloGroupId, PhyloGroup)]
forall a b. (a -> b) -> a -> b
$ [[PhyloGroup]] -> [PhyloGroup]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 
                              ([[PhyloGroup]] -> [PhyloGroup]) -> [[PhyloGroup]] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ [[PhyloGroup]] -> [[PhyloGroup]]
tracePhyloAncestors [[PhyloGroup]]
newGroups) Phylo
phylo
      reBranched :: Map PhyloGroupId PhyloGroup
reBranched = [(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup)
-> [(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> (PhyloGroupId, PhyloGroup))
-> [PhyloGroup] -> [(PhyloGroupId, PhyloGroup)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> (PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g, PhyloGroup
g)) ([PhyloGroup] -> [(PhyloGroupId, PhyloGroup)])
-> [PhyloGroup] -> [(PhyloGroupId, PhyloGroup)]
forall a b. (a -> b) -> a -> b
$ [[PhyloGroup]] -> [PhyloGroup]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                 ([[PhyloGroup]] -> [PhyloGroup]) -> [[PhyloGroup]] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
groupsToBranches (Map PhyloGroupId PhyloGroup -> [[PhyloGroup]])
-> Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
forall a b. (a -> b) -> a -> b
$ [(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup)
-> [(PhyloGroupId, PhyloGroup)] -> Map PhyloGroupId PhyloGroup
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> (PhyloGroupId, PhyloGroup))
-> [PhyloGroup] -> [(PhyloGroupId, PhyloGroup)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> (PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g, PhyloGroup
g)) ([PhyloGroup] -> [(PhyloGroupId, PhyloGroup)])
-> [PhyloGroup] -> [(PhyloGroupId, PhyloGroup)]
forall a b. (a -> b) -> a -> b
$ Level -> Phylo -> [PhyloGroup]
getGroupsFromLevel Level
level Phylo
phyloAncestor
   in Level -> Map PhyloGroupId PhyloGroup -> Phylo -> Phylo
updatePhyloGroups Level
level Map PhyloGroupId PhyloGroup
reBranched Phylo
phylo
  where
    -- | 1) for each periods 
    periods :: [PhyloPeriodId]
    periods :: [PhyloPeriodId]
periods = Phylo -> [PhyloPeriodId]
getPeriodIds Phylo
phylo
    -- --
    level :: Level
    level :: Level
level = Phylo -> Level
getLastLevel Phylo
phylo
    -- --
    frame :: Int
    frame :: Level
frame = TimeUnit -> Level
getTimeFrame (TimeUnit -> Level) -> TimeUnit -> Level
forall a b. (a -> b) -> a -> b
$ Config -> TimeUnit
timeUnit (Config -> TimeUnit) -> Config -> TimeUnit
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo
    -- | 2) find ancestors between groups without parents
    mapGroups :: [[PhyloGroup]]
    mapGroups :: [[PhyloGroup]]
mapGroups = (PhyloPeriodId -> [PhyloGroup])
-> [PhyloPeriodId] -> [[PhyloGroup]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloPeriodId
prd -> 
      let groups :: [PhyloGroup]
groups  = Level -> [PhyloPeriodId] -> Phylo -> [PhyloGroup]
getGroupsFromLevelPeriods Level
level [PhyloPeriodId
prd] Phylo
phylo
          childs :: [PhyloGroupId]
childs  = Level
-> Level
-> PhyloPeriodId
-> [PhyloPeriodId]
-> Phylo
-> [PhyloGroupId]
getPreviousChildIds Level
level Level
frame PhyloPeriodId
prd [PhyloPeriodId]
periods Phylo
phylo 
              -- maybe add a better filter for non isolated  ancestors
          heads :: [PhyloGroup]
heads   = (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> (Bool -> Bool
not (Bool -> Bool)
-> ([(PhyloGroupId, Double)] -> Bool)
-> [(PhyloGroupId, Double)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PhyloGroupId, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([(PhyloGroupId, Double)] -> Bool)
-> [(PhyloGroupId, Double)] -> Bool
forall a b. (a -> b) -> a -> b
$ (PhyloGroup
g PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupPeriodChilds))
                  ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> Bool) -> [PhyloGroup] -> [PhyloGroup]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhyloGroup
g -> [(PhyloGroupId, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PhyloGroup
g PhyloGroup
-> Getting
     [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
-> [(PhyloGroupId, Double)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(PhyloGroupId, Double)] PhyloGroup [(PhyloGroupId, Double)]
Lens' PhyloGroup [(PhyloGroupId, Double)]
phylo_groupPeriodParents) Bool -> Bool -> Bool
&& (PhyloGroupId -> [PhyloGroupId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (PhyloGroup -> PhyloGroupId
getGroupId PhyloGroup
g) [PhyloGroupId]
childs)) [PhyloGroup]
groups
          noHeads :: [PhyloGroup]
noHeads = [PhyloGroup]
groups [PhyloGroup] -> [PhyloGroup] -> [PhyloGroup]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PhyloGroup]
heads 
          nbDocs :: Double
nbDocs  = [Double] -> Double
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Map Level Double -> [Double]
forall k a. Map k a -> [a]
elems  (Map Level Double -> [Double]) -> Map Level Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Map Level Double -> [PhyloPeriodId] -> Map Level Double
filterDocs  (Phylo
phylo Phylo
-> Getting (Map Level Double) Phylo (Map Level Double)
-> Map Level Double
forall s a. s -> Getting a s a -> a
^. Getting (Map Level Double) Phylo (Map Level Double)
Lens' Phylo (Map Level Double)
phylo_timeDocs) [PhyloPeriodId
prd]
          diago :: Map Level Double
diago   = Map Level (Map PhyloPeriodId Double) -> Map Level Double
reduceDiagos (Map Level (Map PhyloPeriodId Double) -> Map Level Double)
-> Map Level (Map PhyloPeriodId Double) -> Map Level Double
forall a b. (a -> b) -> a -> b
$ Map Level (Map PhyloPeriodId Double)
-> [PhyloPeriodId] -> Map Level (Map PhyloPeriodId Double)
filterDiago (Phylo
phylo Phylo
-> Getting
     (Map Level (Map PhyloPeriodId Double))
     Phylo
     (Map Level (Map PhyloPeriodId Double))
-> Map Level (Map PhyloPeriodId Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Level (Map PhyloPeriodId Double))
  Phylo
  (Map Level (Map PhyloPeriodId Double))
Lens' Phylo (Map Level (Map PhyloPeriodId Double))
phylo_timeCooc) [PhyloPeriodId
prd]
          proximity :: Proximity
proximity = (Config -> Proximity
phyloProximity (Config -> Proximity) -> Config -> Proximity
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo)
          step :: Double
step = case Phylo -> SeaElevation
getSeaElevation Phylo
phylo of
            Constante  Double
_ Double
s -> Double
s 
            Adaptative Double
_ -> Double
forall a. HasCallStack => a
undefined
       -- in headsToAncestors nbDocs diago proximity heads groups []
       in (PhyloGroup -> PhyloGroup) -> [PhyloGroup] -> [PhyloGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
ego -> Double
-> Map Level Double
-> Proximity
-> Double
-> [PhyloGroup]
-> PhyloGroup
-> PhyloGroup
toAncestor Double
nbDocs Map Level Double
diago Proximity
proximity Double
step [PhyloGroup]
noHeads PhyloGroup
ego) 
        ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ Double
-> Map Level Double
-> Proximity
-> Double
-> [PhyloGroup]
-> [PhyloGroup]
-> [PhyloGroup]
headsToAncestors Double
nbDocs Map Level Double
diago Proximity
proximity Double
step [PhyloGroup]
heads []
      ) [PhyloPeriodId]
periods
    -- | 3) process this task concurrently
    newGroups :: [[PhyloGroup]]
    newGroups :: [[PhyloGroup]]
newGroups = [[PhyloGroup]]
mapGroups [[PhyloGroup]] -> Strategy [[PhyloGroup]] -> [[PhyloGroup]]
forall a. a -> Strategy a -> a
`using` Strategy [PhyloGroup] -> Strategy [[PhyloGroup]]
forall a. Strategy a -> Strategy [a]
parList Strategy [PhyloGroup]
forall a. NFData a => Strategy a
rdeepseq 
    --------------------------------------

getPreviousChildIds :: Level -> Int -> PhyloPeriodId -> [PhyloPeriodId] -> Phylo -> [PhyloGroupId]
getPreviousChildIds :: Level
-> Level
-> PhyloPeriodId
-> [PhyloPeriodId]
-> Phylo
-> [PhyloGroupId]
getPreviousChildIds Level
lvl Level
frame PhyloPeriodId
curr [PhyloPeriodId]
prds Phylo
phylo = 
    [[PhyloGroupId]] -> [PhyloGroupId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PhyloGroupId]] -> [PhyloGroupId])
-> [[PhyloGroupId]] -> [PhyloGroupId]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [PhyloGroupId]) -> [PhyloGroup] -> [[PhyloGroupId]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((((PhyloGroupId, Double) -> PhyloGroupId)
-> [(PhyloGroupId, Double)] -> [PhyloGroupId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (PhyloGroupId, Double) -> PhyloGroupId
forall a b. (a, b) -> a
fst) ([(PhyloGroupId, Double)] -> [PhyloGroupId])
-> (PhyloGroup -> [(PhyloGroupId, Double)])
-> PhyloGroup
-> [PhyloGroupId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhyloGroup -> [(PhyloGroupId, Double)]
_phylo_groupPeriodChilds)
           ([PhyloGroup] -> [[PhyloGroupId]])
-> [PhyloGroup] -> [[PhyloGroupId]]
forall a b. (a -> b) -> a -> b
$ Level -> [PhyloPeriodId] -> Phylo -> [PhyloGroup]
getGroupsFromLevelPeriods Level
lvl (Filiation
-> Level -> PhyloPeriodId -> [PhyloPeriodId] -> [PhyloPeriodId]
getNextPeriods Filiation
ToParents Level
frame PhyloPeriodId
curr [PhyloPeriodId]
prds) Phylo
phylo

---------------------
-- | phyloExport | --
---------------------   

toPhyloExport :: Phylo -> DotGraph DotId
toPhyloExport :: Phylo -> DotGraph DotId
toPhyloExport Phylo
phylo = Phylo -> PhyloExport -> DotGraph DotId
exportToDot Phylo
phylo
                    (PhyloExport -> DotGraph DotId) -> PhyloExport -> DotGraph DotId
forall a b. (a -> b) -> a -> b
$ [Filter] -> Quality -> PhyloExport -> PhyloExport
processFilters (Config -> [Filter]
exportFilter (Config -> [Filter]) -> Config -> [Filter]
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo) (Config -> Quality
phyloQuality (Config -> Quality) -> Config -> Quality
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo)
                    (PhyloExport -> PhyloExport) -> PhyloExport -> PhyloExport
forall a b. (a -> b) -> a -> b
$ Sort -> SeaElevation -> PhyloExport -> PhyloExport
processSort    (Config -> Sort
exportSort   (Config -> Sort) -> Config -> Sort
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo) (Phylo -> SeaElevation
getSeaElevation Phylo
phylo)
                    (PhyloExport -> PhyloExport) -> PhyloExport -> PhyloExport
forall a b. (a -> b) -> a -> b
$ [PhyloLabel]
-> Vector Text -> Map Level Double -> PhyloExport -> PhyloExport
processLabels  (Config -> [PhyloLabel]
exportLabel  (Config -> [PhyloLabel]) -> Config -> [PhyloLabel]
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo) (Phylo -> Vector Text
getRoots Phylo
phylo) (Phylo -> Map Level Double
_phylo_lastTermFreq Phylo
phylo)
                    (PhyloExport -> PhyloExport) -> PhyloExport -> PhyloExport
forall a b. (a -> b) -> a -> b
$ Phylo -> PhyloExport -> PhyloExport
processMetrics Phylo
phylo PhyloExport
export           
    where
        export :: PhyloExport
        export :: PhyloExport
export = [PhyloGroup] -> [PhyloBranch] -> PhyloExport
PhyloExport [PhyloGroup]
groups [PhyloBranch]
branches     
        --------------------------------------
        branches :: [PhyloBranch]
        branches :: [PhyloBranch]
branches = (PhyloGroup -> PhyloBranch) -> [PhyloGroup] -> [PhyloBranch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> 
                      let seaLvl :: [Double]
seaLvl = (PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"seaLevels"
                          breaks :: [Double]
breaks = (PhyloGroup
g PhyloGroup
-> Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
-> Map Text [Double]
forall s a. s -> Getting a s a -> a
^. Getting (Map Text [Double]) PhyloGroup (Map Text [Double])
Lens' PhyloGroup (Map Text [Double])
phylo_groupMeta) Map Text [Double] -> Text -> [Double]
forall k a. Ord k => Map k a -> k -> a
! Text
"breaks"
                          canonId :: [Level]
canonId = Level -> [Level] -> [Level]
forall a. Level -> [a] -> [a]
take (Double -> Level
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Level) -> Double -> Level
forall a b. (a -> b) -> a -> b
$ (Text -> [Double] -> Double
forall a. Text -> [a] -> a
last' Text
"export" [Double]
breaks) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2) (PhyloBranchId -> [Level]
forall a b. (a, b) -> b
snd (PhyloBranchId -> [Level]) -> PhyloBranchId -> [Level]
forall a b. (a -> b) -> a -> b
$ PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId)
                       in PhyloBranchId
-> [Level]
-> [Double]
-> Double
-> Double
-> Double
-> Double
-> Text
-> Map Text [Double]
-> PhyloBranch
PhyloBranch (PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId) 
                                      [Level]
canonId
                                      [Double]
seaLvl
                                      Double
0 
                                      (Text -> [Double] -> Double
forall a. Text -> [a] -> a
last' Text
"export" (Level -> [Double] -> [Double]
forall a. Level -> [a] -> [a]
take (Double -> Level
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Level) -> Double -> Level
forall a b. (a -> b) -> a -> b
$ (Text -> [Double] -> Double
forall a. Text -> [a] -> a
last' Text
"export" [Double]
breaks) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) [Double]
seaLvl))
                                      Double
0
                                      Double
0
                                      Text
"" Map Text [Double]
forall k a. Map k a
empty)  
                  ([PhyloGroup] -> [PhyloBranch]) -> [PhyloGroup] -> [PhyloBranch]
forall a b. (a -> b) -> a -> b
$ ([PhyloGroup] -> PhyloGroup) -> [[PhyloGroup]] -> [PhyloGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[PhyloGroup]
gs -> Text -> [PhyloGroup] -> PhyloGroup
forall a. Text -> [a] -> a
head' Text
"export" [PhyloGroup]
gs)
                  ([[PhyloGroup]] -> [PhyloGroup]) -> [[PhyloGroup]] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> PhyloGroup -> Bool)
-> [PhyloGroup] -> [[PhyloGroup]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\PhyloGroup
g PhyloGroup
g' -> PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId PhyloBranchId -> PhyloBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== PhyloGroup
g' PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId)
                  ([PhyloGroup] -> [[PhyloGroup]]) -> [PhyloGroup] -> [[PhyloGroup]]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> PhyloBranchId) -> [PhyloGroup] -> [PhyloGroup]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\PhyloGroup
g -> PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId) [PhyloGroup]
groups
        --------------------------------------    
        groups :: [PhyloGroup]
        groups :: [PhyloGroup]
groups = [PhyloGroup] -> [PhyloGroup]
traceExportGroups
               ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ [PhyloGroup] -> [PhyloGroup]
processDynamics
               ([PhyloGroup] -> [PhyloGroup]) -> [PhyloGroup] -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ Level -> Phylo -> [PhyloGroup]
getGroupsFromLevel (Config -> Level
phyloLevel (Config -> Level) -> Config -> Level
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo)
               (Phylo -> [PhyloGroup]) -> Phylo -> [PhyloGroup]
forall a b. (a -> b) -> a -> b
$ Phylo -> Phylo
tracePhyloInfo Phylo
phylo
               -- \$ toHorizon phylo


traceExportBranches :: [PhyloBranch] -> [PhyloBranch]
traceExportBranches :: [PhyloBranch] -> [PhyloBranch]
traceExportBranches [PhyloBranch]
branches = FilePath -> [PhyloBranch] -> [PhyloBranch]
forall a. FilePath -> a -> a
trace (FilePath
"\n"
  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-- | Export " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([PhyloBranch] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [PhyloBranch]
branches) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" branches") [PhyloBranch]
branches

tracePhyloAncestors :: [[PhyloGroup]] -> [[PhyloGroup]]
tracePhyloAncestors :: [[PhyloGroup]] -> [[PhyloGroup]]
tracePhyloAncestors [[PhyloGroup]]
groups = FilePath -> [[PhyloGroup]] -> [[PhyloGroup]]
forall a. FilePath -> a -> a
trace ( FilePath
"-- | Found " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([(PhyloGroupId, Double)] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([(PhyloGroupId, Double)] -> Level)
-> [(PhyloGroupId, Double)] -> Level
forall a b. (a -> b) -> a -> b
$ [[(PhyloGroupId, Double)]] -> [(PhyloGroupId, Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(PhyloGroupId, Double)]] -> [(PhyloGroupId, Double)])
-> [[(PhyloGroupId, Double)]] -> [(PhyloGroupId, Double)]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [(PhyloGroupId, Double)])
-> [PhyloGroup] -> [[(PhyloGroupId, Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PhyloGroup -> [(PhyloGroupId, Double)]
_phylo_groupAncestors ([PhyloGroup] -> [[(PhyloGroupId, Double)]])
-> [PhyloGroup] -> [[(PhyloGroupId, Double)]]
forall a b. (a -> b) -> a -> b
$ [[PhyloGroup]] -> [PhyloGroup]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PhyloGroup]]
groups) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" ancestors") [[PhyloGroup]]
groups

tracePhyloInfo :: Phylo -> Phylo
tracePhyloInfo :: Phylo -> Phylo
tracePhyloInfo Phylo
phylo = FilePath -> Phylo -> Phylo
forall a. FilePath -> a -> a
trace (FilePath
"\n"  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"##########################" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n\n" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-- | Phylo with λ = "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Double -> FilePath
forall a. Show a => a -> FilePath
show(Quality -> Double
_qua_granularity (Quality -> Double) -> Quality -> Double
forall a b. (a -> b) -> a -> b
$ Config -> Quality
phyloQuality (Config -> Quality) -> Config -> Quality
forall a b. (a -> b) -> a -> b
$ Phylo -> Config
getConfig Phylo
phylo) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" applied to "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([Text] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Text] -> Level) -> [Text] -> Level
forall a b. (a -> b) -> a -> b
$ Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Phylo -> Vector Text
getRoots Phylo
phylo) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" foundations"
  ) Phylo
phylo


traceExportGroups :: [PhyloGroup] -> [PhyloGroup]
traceExportGroups :: [PhyloGroup] -> [PhyloGroup]
traceExportGroups [PhyloGroup]
groups = FilePath -> [PhyloGroup] -> [PhyloGroup]
forall a. FilePath -> a -> a
trace (FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-- | Export "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([PhyloBranchId] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([PhyloBranchId] -> Level) -> [PhyloBranchId] -> Level
forall a b. (a -> b) -> a -> b
$ [PhyloBranchId] -> [PhyloBranchId]
forall a. Eq a => [a] -> [a]
nub ([PhyloBranchId] -> [PhyloBranchId])
-> [PhyloBranchId] -> [PhyloBranchId]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> PhyloBranchId) -> [PhyloGroup] -> [PhyloBranchId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> PhyloGroup
g PhyloGroup
-> Getting PhyloBranchId PhyloGroup PhyloBranchId -> PhyloBranchId
forall s a. s -> Getting a s a -> a
^. Getting PhyloBranchId PhyloGroup PhyloBranchId
Lens' PhyloGroup PhyloBranchId
phylo_groupBranchId) [PhyloGroup]
groups) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" branches, "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([PhyloGroup] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length [PhyloGroup]
groups) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" groups and "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Level -> FilePath
forall a. Show a => a -> FilePath
show([Level] -> Level
forall (t :: * -> *) a. Foldable t => t a -> Level
length ([Level] -> Level) -> [Level] -> Level
forall a b. (a -> b) -> a -> b
$ [Level] -> [Level]
forall a. Eq a => [a] -> [a]
nub ([Level] -> [Level]) -> [Level] -> [Level]
forall a b. (a -> b) -> a -> b
$ [[Level]] -> [Level]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Level]] -> [Level]) -> [[Level]] -> [Level]
forall a b. (a -> b) -> a -> b
$ (PhyloGroup -> [Level]) -> [PhyloGroup] -> [[Level]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\PhyloGroup
g -> PhyloGroup
g PhyloGroup -> Getting [Level] PhyloGroup [Level] -> [Level]
forall s a. s -> Getting a s a -> a
^. Getting [Level] PhyloGroup [Level]
Lens' PhyloGroup [Level]
phylo_groupNgrams) [PhyloGroup]
groups) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" terms"
  ) [PhyloGroup]
groups