Commit d5ae1fc2 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Phylo] Clean

parent e1d48283
...@@ -44,7 +44,6 @@ import Numeric.Statistics (percentile) ...@@ -44,7 +44,6 @@ import Numeric.Statistics (percentile)
-- | PhyloLevelMaker | -- -- | PhyloLevelMaker | --
------------------------- -------------------------
-- | A typeClass for polymorphic PhyloLevel functions -- | A typeClass for polymorphic PhyloLevel functions
class PhyloLevelMaker aggregate class PhyloLevelMaker aggregate
where where
...@@ -105,11 +104,15 @@ instance PhyloLevelMaker Document ...@@ -105,11 +104,15 @@ instance PhyloLevelMaker Document
addPhyloLevel' :: PhyloLevelMaker a => Level -> Map (Date, Date) [a] -> Phylo -> Phylo addPhyloLevel' :: PhyloLevelMaker a => Level -> Map (Date, Date) [a] -> Phylo -> Phylo
addPhyloLevel' lvl m p = alterPhyloPeriods addPhyloLevel' lvl m p = alterPhyloPeriods
(\period -> let pId = _phylo_periodId period (\period -> let pId = _phylo_periodId period
in over (phylo_periodLevels) in over phylo_periodLevels
(\phyloLevels -> (\phyloLevels ->
let groups = toPhyloGroups lvl pId (m ! pId) m p let groups = toPhyloGroups lvl pId (m ! pId) m p
in trace (show (length groups) <> " groups for " <> show (pId) ) $ phyloLevels ++ [PhyloLevel (pId, lvl) groups] in trace (show (length groups)
) period) p <> " groups for "
<> show (pId) )
$ phyloLevels ++ [PhyloLevel (pId, lvl) groups]
) period
) p
---------------------- ----------------------
...@@ -118,7 +121,14 @@ addPhyloLevel' lvl m p = alterPhyloPeriods ...@@ -118,7 +121,14 @@ addPhyloLevel' lvl m p = alterPhyloPeriods
-- | To transform a Clique into a PhyloGroup -- | To transform a Clique into a PhyloGroup
cliqueToGroup :: PhyloPeriodId -> Level -> Int -> Text -> PhyloFis -> Map Date (Map (Int,Int) Double) -> Vector Ngrams -> PhyloGroup cliqueToGroup :: PhyloPeriodId
-> Level
-> Int
-> Text
-> PhyloFis
-> Map Date (Map (Int,Int) Double)
-> Vector Ngrams
-> PhyloGroup
cliqueToGroup prd lvl idx lbl fis cooc' root = PhyloGroup ((prd, lvl), idx) lbl ngrams cliqueToGroup prd lvl idx lbl fis cooc' root = PhyloGroup ((prd, lvl), idx) lbl ngrams
(getNgramsMeta cooc ngrams) (getNgramsMeta cooc ngrams)
-- empty -- empty
...@@ -142,7 +152,14 @@ cliqueToGroup prd lvl idx lbl fis cooc' root = PhyloGroup ((prd, lvl), idx) lbl ...@@ -142,7 +152,14 @@ cliqueToGroup prd lvl idx lbl fis cooc' root = PhyloGroup ((prd, lvl), idx) lbl
-- | To transform a Cluster into a Phylogroup -- | To transform a Cluster into a Phylogroup
clusterToGroup :: PhyloPeriodId -> Level -> Int -> Text -> PhyloCluster -> Map (Date,Date) [PhyloCluster]-> Phylo-> PhyloGroup clusterToGroup :: PhyloPeriodId
-> Level
-> Int
-> Text
-> PhyloCluster
-> Map (Date,Date) [PhyloCluster]
-> Phylo
-> PhyloGroup
clusterToGroup prd lvl idx lbl groups _m p = clusterToGroup prd lvl idx lbl groups _m p =
PhyloGroup ((prd, lvl), idx) lbl ngrams PhyloGroup ((prd, lvl), idx) lbl ngrams
(getNgramsMeta cooc ngrams) (getNgramsMeta cooc ngrams)
...@@ -154,7 +171,9 @@ clusterToGroup prd lvl idx lbl groups _m p = ...@@ -154,7 +171,9 @@ clusterToGroup prd lvl idx lbl groups _m p =
where where
-------------------------------------- --------------------------------------
cooc :: Map (Int, Int) Double cooc :: Map (Int, Int) Double
cooc = getMiniCooc (listToFullCombi ngrams) (periodsToYears [prd]) (getPhyloCooc p) cooc = getMiniCooc (listToFullCombi ngrams)
(periodsToYears [prd] )
(getPhyloCooc p )
-------------------------------------- --------------------------------------
childs :: [Pointer] childs :: [Pointer]
childs = map (\g -> (getGroupId g, 1)) groups childs = map (\g -> (getGroupId g, 1)) groups
......
...@@ -121,7 +121,3 @@ writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp ...@@ -121,7 +121,3 @@ writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
viewPhylo2Svg :: PhyloView -> IO DB.ByteString viewPhylo2Svg :: PhyloView -> IO DB.ByteString
viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
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