Skip to content

haskell-gargantext
haskell-gargantext
Commit 2da4252e authored by qlobbe's avatar qlobbe
Browse files
Options

add the ancestors

parent 04aa2d5c
Pipeline #938 failed with stage
    Expand all Hide whitespace changes
    Inline Side-by-side
    Showing with 169 additions and 111 deletions
    src/Gargantext/Viz/AdaptativePhylo.hs
    View file @ 2da4252e
    ...@@ -143,7 +143,7 @@ defaultConfig = ...@@ -143,7 +143,7 @@ defaultConfig =
    , phyloName = pack "Default Phylo" , phyloName = pack "Default Phylo"
    , phyloLevel = 2 , phyloLevel = 2
    , phyloProximity = WeightedLogJaccard 10 , phyloProximity = WeightedLogJaccard 10
    , seaElevation = Constante 0.6 1 , seaElevation = Constante 0.1 0.1
    , phyloSynchrony = ByProximityThreshold 0.5 10 SiblingBranches MergeAllGroups , phyloSynchrony = ByProximityThreshold 0.5 10 SiblingBranches MergeAllGroups
    , phyloQuality = Quality 100 1 , phyloQuality = Quality 100 1
    , timeUnit = Year 3 1 5 , timeUnit = Year 3 1 5
    ...@@ -326,6 +326,7 @@ data PhyloGroup = ...@@ -326,6 +326,7 @@ data PhyloGroup =
    , _phylo_groupLevelChilds :: [Pointer] , _phylo_groupLevelChilds :: [Pointer]
    , _phylo_groupPeriodParents :: [Pointer] , _phylo_groupPeriodParents :: [Pointer]
    , _phylo_groupPeriodChilds :: [Pointer] , _phylo_groupPeriodChilds :: [Pointer]
    , _phylo_groupAncestors :: [Pointer]
    } }
    deriving (Generic, Show, Eq, NFData) deriving (Generic, Show, Eq, NFData)
    ...@@ -352,24 +353,13 @@ data PhyloClique = PhyloClique ...@@ -352,24 +353,13 @@ data PhyloClique = PhyloClique
    , _phyloClique_period :: (Date,Date) , _phyloClique_period :: (Date,Date)
    } deriving (Generic,NFData,Show,Eq) } deriving (Generic,NFData,Show,Eq)
    ------------------------
    -- | Phylo Ancestor | --
    ------------------------
    data PhyloAncestor = PhyloAncestor
    { _phyloAncestor_id :: Int
    , _phyloAncestor_ngrams :: [Int]
    , _phyloAncestor_groups :: [PhyloGroupId]
    } deriving (Generic,NFData,Show,Eq)
    ---------------- ----------------
    -- | Export | -- -- | Export | --
    ---------------- ----------------
    type DotId = TextLazy.Text type DotId = TextLazy.Text
    data EdgeType = GroupToGroup | BranchToGroup | BranchToBranch | PeriodToPeriod deriving (Show,Generic,Eq) data EdgeType = GroupToGroup | BranchToGroup | BranchToBranch | GroupToAncestor | PeriodToPeriod deriving (Show,Generic,Eq)
    data Filter = ByBranchSize { _branch_size :: Double } deriving (Show,Generic,Eq) data Filter = ByBranchSize { _branch_size :: Double } deriving (Show,Generic,Eq)
    ...@@ -405,7 +395,6 @@ data PhyloExport = ...@@ -405,7 +395,6 @@ data PhyloExport =
    PhyloExport PhyloExport
    { _export_groups :: [PhyloGroup] { _export_groups :: [PhyloGroup]
    , _export_branches :: [PhyloBranch] , _export_branches :: [PhyloBranch]
    , _export_ancestors :: [PhyloAncestor]
    } deriving (Generic, Show) } deriving (Generic, Show)
    ---------------- ----------------
    ......
    src/Gargantext/Viz/Phylo/PhyloExample.hs
    View file @ 2da4252e
    ...@@ -137,9 +137,9 @@ actants = [ "Cleopatre" , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV", "Ptolem ...@@ -137,9 +137,9 @@ actants = [ "Cleopatre" , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV", "Ptolem
    corpus :: [(Date, Text)] corpus :: [(Date, Text)]
    corpus = sortOn fst [ corpus = sortOn fst [
    (-101,"La tutelle de sa mère lui étant difficile à endurer, en septembre 101 av. J.-C., Ptolemee-X la fait assassiner et peut enfin régner presque seul puisqu'il partage le pouvoir avec son épouse Berenice-III Cléopâtre Philopator."), (-101,"La tutelle Cesar Caesar-III de sa mère lui étant difficile à endurer, en septembre 101 av. J.-C., Ptolemee-X la fait assassiner et peut enfin régner presque seul puisqu'il partage le pouvoir avec son épouse Berenice-III Cléopâtre Philopator."),
    (-99,"Caesar-III est questeur en 99 av. J.-C. ou 98 av. J.-C., et préteur en 92 av. J.-C.."), (-99,"Caesar-III est questeur en 99 av. J.-C. ou 98 av. J.-C., et préteur en 92 av. J.-C.."),
    (-100,"Caius Julius Caesar-IV — dit Jules Cesar — naît vers 100 av. J.-C., il est le fils de Caius Julius Caesar-III et de Aurelia-Cotta"), (-100,"Caius Julius Caesar-IV — dit Jules Cesar Ptolemee-X — naît vers 100 av. J.-C., il est le fils de Caius Julius Caesar-III et de Aurelia-Cotta"),
    (-85,"Caesar-III meurt à Pisae de cause naturelle en 85 av. J.-C. : selon Pline l'Ancien, il décède brusquement en mettant ses chaussures"), (-85,"Caesar-III meurt à Pisae de cause naturelle en 85 av. J.-C. : selon Pline l'Ancien, il décède brusquement en mettant ses chaussures"),
    (-53,"Aurelia-Cotta décède peu de temps avant le meurtre de Clodius Pulcher, vers 53 av. J.-C."), (-53,"Aurelia-Cotta décède peu de temps avant le meurtre de Clodius Pulcher, vers 53 av. J.-C."),
    (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."), (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."),
    ......
    src/Gargantext/Viz/Phylo/PhyloExport.hs
    View file @ 2da4252e
    This diff is collapsed.
    src/Gargantext/Viz/Phylo/PhyloMaker.hs
    View file @ 2da4252e
    ...@@ -36,7 +36,6 @@ import Control.Lens hiding (Level) ...@@ -36,7 +36,6 @@ import Control.Lens hiding (Level)
    import qualified Data.Vector as Vector import qualified Data.Vector as Vector
    import qualified Data.Set as Set import qualified Data.Set as Set
    ------------------ ------------------
    -- | To Phylo | -- -- | To Phylo | --
    ------------------ ------------------
    ...@@ -119,7 +118,7 @@ cliqueToGroup fis pId lvl idx coocs = PhyloGroup pId lvl idx "" ...@@ -119,7 +118,7 @@ cliqueToGroup fis pId lvl idx coocs = PhyloGroup pId lvl idx ""
    (ngramsToCooc (fis ^. phyloClique_nodes) coocs) (ngramsToCooc (fis ^. phyloClique_nodes) coocs)
    (1,[0]) -- | branchid (lvl,[path in the branching tree]) (1,[0]) -- | branchid (lvl,[path in the branching tree])
    (fromList [("breaks",[0]),("seaLevels",[0])]) (fromList [("breaks",[0]),("seaLevels",[0])])
    [] [] [] [] [] [] [] [] []
    toPhylo1 :: [Document] -> Phylo -> Phylo toPhylo1 :: [Document] -> Phylo -> Phylo
    ......
    src/Gargantext/Viz/Phylo/PhyloTools.hs
    View file @ 2da4252e
    ...@@ -17,9 +17,9 @@ Portability : POSIX ...@@ -17,9 +17,9 @@ Portability : POSIX
    module Gargantext.Viz.Phylo.PhyloTools where module Gargantext.Viz.Phylo.PhyloTools where
    import Data.Vector (Vector, elemIndex) import Data.Vector (Vector, elemIndex)
    import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy) import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, maximum, group)
    import Data.Set (Set, disjoint) import Data.Set (Set, disjoint)
    import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty) import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
    import Data.String (String) import Data.String (String)
    import Data.Text (Text, unwords) import Data.Text (Text, unwords)
    ...@@ -257,22 +257,19 @@ ngramsToCooc ngrams coocs = ...@@ -257,22 +257,19 @@ ngramsToCooc ngrams coocs =
    -------------------- --------------------
    getGroupId :: PhyloGroup -> PhyloGroupId getGroupId :: PhyloGroup -> PhyloGroupId
    getGroupId group = ((group ^. phylo_groupPeriod, group ^. phylo_groupLevel), group ^. phylo_groupIndex) getGroupId g = ((g ^. phylo_groupPeriod, g ^. phylo_groupLevel), g ^. phylo_groupIndex)
    idToPrd :: PhyloGroupId -> PhyloPeriodId idToPrd :: PhyloGroupId -> PhyloPeriodId
    idToPrd id = (fst . fst) id idToPrd id = (fst . fst) id
    getGroupThr :: PhyloGroup -> Double
    getGroupThr group = last' "getGroupThr" ((group ^. phylo_groupMeta) ! "breaks")
    groupByField :: Ord a => (PhyloGroup -> a) -> [PhyloGroup] -> Map a [PhyloGroup] groupByField :: Ord a => (PhyloGroup -> a) -> [PhyloGroup] -> Map a [PhyloGroup]
    groupByField toField groups = fromListWith (++) $ map (\g -> (toField g, [g])) groups groupByField toField groups = fromListWith (++) $ map (\g -> (toField g, [g])) groups
    getPeriodPointers :: Filiation -> PhyloGroup -> [Pointer] getPeriodPointers :: Filiation -> PhyloGroup -> [Pointer]
    getPeriodPointers fil group = getPeriodPointers fil g =
    case fil of case fil of
    ToChilds -> group ^. phylo_groupPeriodChilds ToChilds -> g ^. phylo_groupPeriodChilds
    ToParents -> group ^. phylo_groupPeriodParents ToParents -> g ^. phylo_groupPeriodParents
    filterProximity :: Proximity -> Double -> Double -> Bool filterProximity :: Proximity -> Double -> Double -> Bool
    filterProximity proximity thr local = filterProximity proximity thr local =
    ...@@ -291,14 +288,14 @@ getProximityName proximity = ...@@ -291,14 +288,14 @@ getProximityName proximity =
    --------------- ---------------
    addPointers :: Filiation -> PointerType -> [Pointer] -> PhyloGroup -> PhyloGroup addPointers :: Filiation -> PointerType -> [Pointer] -> PhyloGroup -> PhyloGroup
    addPointers fil pty pointers group = addPointers fil pty pointers g =
    case pty of case pty of
    TemporalPointer -> case fil of TemporalPointer -> case fil of
    ToChilds -> group & phylo_groupPeriodChilds .~ pointers ToChilds -> g & phylo_groupPeriodChilds .~ pointers
    ToParents -> group & phylo_groupPeriodParents .~ pointers ToParents -> g & phylo_groupPeriodParents .~ pointers
    LevelPointer -> case fil of LevelPointer -> case fil of
    ToChilds -> group & phylo_groupLevelChilds .~ pointers ToChilds -> g & phylo_groupLevelChilds .~ pointers
    ToParents -> group & phylo_groupLevelParents .~ pointers ToParents -> g & phylo_groupLevelParents .~ pointers
    getPeriodIds :: Phylo -> [(Date,Date)] getPeriodIds :: Phylo -> [(Date,Date)]
    ...@@ -375,12 +372,12 @@ updatePhyloGroups lvl m phylo = ...@@ -375,12 +372,12 @@ updatePhyloGroups lvl m phylo =
    . filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl) . filtered (\phyloLvl -> phyloLvl ^. phylo_levelLevel == lvl)
    . phylo_levelGroups . phylo_levelGroups
    . traverse . traverse
    ) (\group -> ) (\g ->
    let id = getGroupId group let id = getGroupId g
    in in
    if member id m if member id m
    then m ! id then m ! id
    else group ) phylo else g ) phylo
    traceToPhylo :: Level -> Phylo -> Phylo traceToPhylo :: Level -> Phylo -> Phylo
    ...@@ -393,6 +390,43 @@ traceToPhylo lvl phylo = ...@@ -393,6 +390,43 @@ traceToPhylo lvl phylo =
    -- | Clustering | -- -- | Clustering | --
    -------------------- --------------------
    mergeBranchIds :: [[Int]] -> [Int]
    mergeBranchIds ids = (head' "mergeBranchIds" . sort . mostFreq') ids
    where
    -- | 2) find the most Up Left ids in the hierarchy of similarity
    -- mostUpLeft :: [[Int]] -> [[Int]]
    -- mostUpLeft ids' =
    -- let groupIds = (map (\gIds -> (length $ head' "gIds" gIds, head' "gIds" gIds)) . groupBy (\id id' -> length id == length id') . sortOn length) ids'
    -- inf = (fst . minimum) groupIds
    -- in map snd $ filter (\gIds -> fst gIds == inf) groupIds
    -- | 1) find the most frequent ids
    mostFreq' :: [[Int]] -> [[Int]]
    mostFreq' ids' =
    let groupIds = (map (\gIds -> (length gIds, head' "gIds" gIds)) . group . sort) ids'
    sup = (fst . maximum) groupIds
    in map snd $ filter (\gIds -> fst gIds == sup) groupIds
    mergeMeta :: [Int] -> [PhyloGroup] -> Map Text [Double]
    mergeMeta bId groups =
    let ego = head' "mergeMeta" $ filter (\g -> (snd (g ^. phylo_groupBranchId)) == bId) groups
    in fromList [("breaks",(ego ^. phylo_groupMeta) ! "breaks"),("seaLevels",(ego ^. phylo_groupMeta) ! "seaLevels")]
    groupsToBranches :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
    groupsToBranches groups =
    -- | run the related component algorithm
    let egos = map (\g -> [getGroupId g]
    ++ (map fst $ g ^. phylo_groupPeriodParents)
    ++ (map fst $ g ^. phylo_groupPeriodChilds)
    ++ (map fst $ g ^. phylo_groupAncestors)) $ elems groups
    graph = relatedComponents egos
    -- | update each group's branch id
    in map (\ids ->
    let groups' = elems $ restrictKeys groups (Set.fromList ids)
    bId = mergeBranchIds $ map (\g -> snd $ g ^. phylo_groupBranchId) groups'
    in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph
    relatedComponents :: Ord a => [[a]] -> [[a]] relatedComponents :: Ord a => [[a]] -> [[a]]
    relatedComponents graph = foldl' (\acc groups -> relatedComponents graph = foldl' (\acc groups ->
    if (null acc) if (null acc)
    ......
    src/Gargantext/Viz/Phylo/SynchronicClustering.hs
    View file @ 2da4252e
    ...@@ -21,57 +21,19 @@ import Gargantext.Viz.Phylo.PhyloTools ...@@ -21,57 +21,19 @@ import Gargantext.Viz.Phylo.PhyloTools
    import Gargantext.Viz.Phylo.TemporalMatching (weightedLogJaccard', filterDiago, reduceDiagos) import Gargantext.Viz.Phylo.TemporalMatching (weightedLogJaccard', filterDiago, reduceDiagos)
    import Gargantext.Viz.Phylo.PhyloExport (processDynamics) import Gargantext.Viz.Phylo.PhyloExport (processDynamics)
    import Data.List ((++), null, intersect, nub, concat, sort, sortOn, all, groupBy, group, maximum) import Data.List ((++), null, intersect, nub, concat, sort, sortOn, all, groupBy)
    import Data.Map (Map, fromList, fromListWith, foldlWithKey, (!), insert, empty, restrictKeys, elems, mapWithKey, member) import Data.Map (Map, fromList, fromListWith, foldlWithKey, (!), insert, empty, restrictKeys, elems, mapWithKey, member)
    import Data.Text (Text)
    import Control.Lens hiding (Level) import Control.Lens hiding (Level)
    import Control.Parallel.Strategies (parList, rdeepseq, using) import Control.Parallel.Strategies (parList, rdeepseq, using)
    -- import Debug.Trace (trace) -- import Debug.Trace (trace)
    import qualified Data.Map as Map import qualified Data.Map as Map
    import qualified Data.Set as Set
    ------------------------- -------------------------
    -- | New Level Maker | -- -- | New Level Maker | --
    ------------------------- -------------------------
    mergeBranchIds :: [[Int]] -> [Int]
    mergeBranchIds ids = (head' "mergeBranchIds" . sort . mostFreq') ids
    where
    -- | 2) find the most Up Left ids in the hierarchy of similarity
    -- mostUpLeft :: [[Int]] -> [[Int]]
    -- mostUpLeft ids' =
    -- let groupIds = (map (\gIds -> (length $ head' "gIds" gIds, head' "gIds" gIds)) . groupBy (\id id' -> length id == length id') . sortOn length) ids'
    -- inf = (fst . minimum) groupIds
    -- in map snd $ filter (\gIds -> fst gIds == inf) groupIds
    -- | 1) find the most frequent ids
    mostFreq' :: [[Int]] -> [[Int]]
    mostFreq' ids' =
    let groupIds = (map (\gIds -> (length gIds, head' "gIds" gIds)) . group . sort) ids'
    sup = (fst . maximum) groupIds
    in map snd $ filter (\gIds -> fst gIds == sup) groupIds
    mergeMeta :: [Int] -> [PhyloGroup] -> Map Text [Double]
    mergeMeta bId groups =
    let ego = head' "mergeMeta" $ filter (\g -> (snd (g ^. phylo_groupBranchId)) == bId) groups
    in fromList [("breaks",(ego ^. phylo_groupMeta) ! "breaks"),("seaLevels",(ego ^. phylo_groupMeta) ! "seaLevels")]
    groupsToBranches' :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
    groupsToBranches' groups =
    -- | run the related component algorithm
    let egos = map (\g -> [getGroupId g]
    ++ (map fst $ g ^. phylo_groupPeriodParents)
    ++ (map fst $ g ^. phylo_groupPeriodChilds) ) $ elems groups
    graph = relatedComponents egos
    -- | update each group's branch id
    in map (\ids ->
    let groups' = elems $ restrictKeys groups (Set.fromList ids)
    bId = mergeBranchIds $ map (\g -> snd $ g ^. phylo_groupBranchId) groups'
    in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph
    mergeGroups :: [Cooc] -> PhyloGroupId -> Map PhyloGroupId PhyloGroupId -> [PhyloGroup] -> PhyloGroup mergeGroups :: [Cooc] -> PhyloGroupId -> Map PhyloGroupId PhyloGroupId -> [PhyloGroup] -> PhyloGroup
    ...@@ -84,6 +46,7 @@ mergeGroups coocs id mapIds childs = ...@@ -84,6 +46,7 @@ mergeGroups coocs id mapIds childs =
    (mergeMeta bId childs) [] (map (\g -> (getGroupId g, 1)) childs) (mergeMeta bId childs) [] (map (\g -> (getGroupId g, 1)) childs)
    (updatePointers $ concat $ map _phylo_groupPeriodParents childs) (updatePointers $ concat $ map _phylo_groupPeriodParents childs)
    (updatePointers $ concat $ map _phylo_groupPeriodChilds childs) (updatePointers $ concat $ map _phylo_groupPeriodChilds childs)
    []
    where where
    -------------------- --------------------
    bId :: [Int] bId :: [Int]
    ...@@ -104,7 +67,7 @@ toNextLevel' :: Phylo -> [PhyloGroup] -> Phylo ...@@ -104,7 +67,7 @@ toNextLevel' :: Phylo -> [PhyloGroup] -> Phylo
    toNextLevel' phylo groups = toNextLevel' phylo groups =
    let curLvl = getLastLevel phylo let curLvl = getLastLevel phylo
    oldGroups = fromList $ map (\g -> (getGroupId g, getLevelParentId g)) groups oldGroups = fromList $ map (\g -> (getGroupId g, getLevelParentId g)) groups
    newGroups = concat $ groupsToBranches' newGroups = concat $ groupsToBranches
    $ fromList $ map (\g -> (getGroupId g, g)) $ fromList $ map (\g -> (getGroupId g, g))
    $ foldlWithKey (\acc id groups' -> $ foldlWithKey (\acc id groups' ->
    -- | 4) create the parent group -- | 4) create the parent group
    ......
    src/Gargantext/Viz/Phylo/TemporalMatching.hs
    View file @ 2da4252e
    ...@@ -345,8 +345,8 @@ toPhyloQuality beta freq branches = ...@@ -345,8 +345,8 @@ toPhyloQuality beta freq branches =
    ------------------------------------ ------------------------------------
    groupsToBranches :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]] groupsToBranches' :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
    groupsToBranches groups = groupsToBranches' groups =
    -- | run the related component algorithm -- | run the related component algorithm
    let egos = groupBy (\gs gs' -> (fst $ fst $ head' "egos" gs) == (fst $ fst $ head' "egos" gs')) let egos = groupBy (\gs gs' -> (fst $ fst $ head' "egos" gs) == (fst $ fst $ head' "egos" gs'))
    $ sortOn (\gs -> fst $ fst $ head' "egos" gs) $ sortOn (\gs -> fst $ fst $ head' "egos" gs)
    ...@@ -413,7 +413,7 @@ breakBranches proximity beta frequency minBranch thr depth elevation frame docs ...@@ -413,7 +413,7 @@ breakBranches proximity beta frequency minBranch thr depth elevation frame docs
    -------------------------------------- --------------------------------------
    ego' :: ([[PhyloGroup]],[[PhyloGroup]]) ego' :: ([[PhyloGroup]],[[PhyloGroup]])
    ego' = ego' =
    let branches = groupsToBranches $ fromList $ map (\g -> (getGroupId g, g)) let branches = groupsToBranches' $ fromList $ map (\g -> (getGroupId g, g))
    $ matchGroupsToGroups frame periods proximity thr docs coocs (fst ego) $ matchGroupsToGroups frame periods proximity thr docs coocs (fst ego)
    branches' = branches `using` parList rdeepseq branches' = branches `using` parList rdeepseq
    in partition (\b -> (length $ nub $ map _phylo_groupPeriod b) >= minBranch) in partition (\b -> (length $ nub $ map _phylo_groupPeriod b) >= minBranch)
    ...@@ -470,7 +470,7 @@ constanteTemporalMatching start step phylo = updatePhyloGroups 1 ...@@ -470,7 +470,7 @@ constanteTemporalMatching start step phylo = updatePhyloGroups 1
    -- | here we suppose that all the groups of level 1 are part of the same big branch -- | here we suppose that all the groups of level 1 are part of the same big branch
    groups :: [([PhyloGroup],Bool)] groups :: [([PhyloGroup],Bool)]
    groups = map (\b -> (b,(length $ nub $ map _phylo_groupPeriod b) >= (_qua_minBranch $ phyloQuality $ getConfig phylo))) groups = map (\b -> (b,(length $ nub $ map _phylo_groupPeriod b) >= (_qua_minBranch $ phyloQuality $ getConfig phylo)))
    $ groupsToBranches $ fromList $ map (\g -> (getGroupId g, g)) $ groupsToBranches' $ fromList $ map (\g -> (getGroupId g, g))
    $ matchGroupsToGroups (getTimeFrame $ timeUnit $ getConfig phylo) $ matchGroupsToGroups (getTimeFrame $ timeUnit $ getConfig phylo)
    (getPeriodIds phylo) (phyloProximity $ getConfig phylo) (getPeriodIds phylo) (phyloProximity $ getConfig phylo)
    start start
    ...@@ -569,7 +569,7 @@ adaptativeBreakBranches proxiConf depth elevation groupsProxi beta frequency min ...@@ -569,7 +569,7 @@ adaptativeBreakBranches proxiConf depth elevation groupsProxi beta frequency min
    -------------------------------------- --------------------------------------
    ego' :: ([[PhyloGroup]],[[PhyloGroup]]) ego' :: ([[PhyloGroup]],[[PhyloGroup]])
    ego' = ego' =
    let branches = groupsToBranches $ fromList $ map (\g -> (getGroupId g, g)) let branches = groupsToBranches' $ fromList $ map (\g -> (getGroupId g, g))
    $ matchGroupsToGroups frame periods proxiConf thr docs coocs (fst ego) $ matchGroupsToGroups frame periods proxiConf thr docs coocs (fst ego)
    branches' = branches `using` parList rdeepseq branches' = branches `using` parList rdeepseq
    in partition (\b -> (length $ nub $ map _phylo_groupPeriod b) > minBranch) in partition (\b -> (length $ nub $ map _phylo_groupPeriod b) > minBranch)
    ...@@ -627,7 +627,7 @@ adaptativeTemporalMatching elevation phylo = updatePhyloGroups 1 ...@@ -627,7 +627,7 @@ adaptativeTemporalMatching elevation phylo = updatePhyloGroups 1
    -- | here we suppose that all the groups of level 1 are part of the same big branch -- | here we suppose that all the groups of level 1 are part of the same big branch
    groups :: [([PhyloGroup],(Bool,[Double]))] groups :: [([PhyloGroup],(Bool,[Double]))]
    groups = map (\b -> (b,((length $ nub $ map _phylo_groupPeriod b) >= (_qua_minBranch $ phyloQuality $ getConfig phylo),[thr]))) groups = map (\b -> (b,((length $ nub $ map _phylo_groupPeriod b) >= (_qua_minBranch $ phyloQuality $ getConfig phylo),[thr])))
    $ groupsToBranches $ fromList $ map (\g -> (getGroupId g, g)) $ groupsToBranches' $ fromList $ map (\g -> (getGroupId g, g))
    $ matchGroupsToGroups (getTimeFrame $ timeUnit $ getConfig phylo) $ matchGroupsToGroups (getTimeFrame $ timeUnit $ getConfig phylo)
    (getPeriodIds phylo) (phyloProximity $ getConfig phylo) (getPeriodIds phylo) (phyloProximity $ getConfig phylo)
    thr thr
    ......
    Markdown is supported
    0% or
    You are about to add 0 people to the discussion. Proceed with caution.
    Finish editing this message first!
    Please register or to comment