Skip to content

H
haskell-gargantext
Commit 24958659 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[PHYLO.API] Adding REST functions.

parent 242f56d2
Hide whitespace changes
Inline Side-by-side
Showing with 98 additions and 89 deletions
src/Gargantext/API/Node.hs
View file @ 24958659
......@@ -63,6 +63,8 @@ import Gargantext.API.Settings
import Gargantext.Text.Metrics (Scored(..))
import Gargantext.Viz.Graph hiding (Node)-- (Graph(_graph_metadata),LegendField(..), GraphMetadata(..),readGraphFromJson,defaultGraph)
import Gargantext.Viz.Graph.Tools (cooc2graph)
import Gargantext.Viz.Phylo.API (getPhylo)
import Gargantext.Viz.Phylo hiding (Tree)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
......
src/Gargantext/Database/Types/Node.hs
View file @ 24958659
......@@ -82,7 +82,6 @@ instance Arbitrary NodeId where
arbitrary = NodeId <$> arbitrary
type ParentId = NodeId
type GraphId = NodeId
type CorpusId = NodeId
type ListId = NodeId
type DocumentId = NodeId
......@@ -91,6 +90,8 @@ type RootId = NodeId
type MasterCorpusId = CorpusId
type UserCorpusId = CorpusId
type GraphId = NodeId
type PhyloId = NodeId
type AnnuaireId = NodeId
type ContactId = NodeId
......
src/Gargantext/Viz/Phylo.hs
View file @ 24958659
......@@ -52,7 +52,7 @@ import Gargantext.Prelude
data PhyloParam =
PhyloParam { _phyloParam_version :: Text -- Double ?
, _phyloParam_software :: Software
, _phyloParam_query :: PhyloQuery
, _phyloParam_query :: PhyloQueryBuild
} deriving (Generic, Show, Eq)
......@@ -326,7 +326,7 @@ data Order = Asc | Desc deriving (Show)
-- | A Phyloquery describes a phylomemic reconstruction
data PhyloQuery = PhyloQuery
data PhyloQueryBuild = PhyloQueryBuild
{ _q_phyloTitle :: Text
, _q_phyloDesc :: Text
......@@ -352,7 +352,6 @@ data PhyloQuery = PhyloQuery
data Filiation = Ascendant | Descendant | Merge | Complete deriving (Show)
data EdgeType = PeriodEdge | LevelEdge deriving (Show)
-------------------
-- | PhyloView | --
-------------------
......@@ -360,39 +359,39 @@ data EdgeType = PeriodEdge | LevelEdge deriving (Show)
-- | A PhyloView is the output type of a Phylo
data PhyloView = PhyloView
{ _phylo_viewParam :: PhyloParam
, _phylo_viewTitle :: Text
, _phylo_viewDescription :: Text
, _phylo_viewFiliation :: Filiation
, _phylo_viewMetrics :: Map Text [Double]
, _phylo_viewBranches :: [PhyloBranch]
, _phylo_viewNodes :: [PhyloNode]
, _phylo_viewEdges :: [PhyloEdge]
{ _pv_param :: PhyloParam
, _pv_title :: Text
, _pv_description :: Text
, _pv_filiation :: Filiation
, _pv_metrics :: Map Text [Double]
, _pv_branches :: [PhyloBranch]
, _pv_nodes :: [PhyloNode]
, _pv_edges :: [PhyloEdge]
} deriving (Show)
-- | A phyloview is made of PhyloBranches, edges and nodes
data PhyloBranch = PhyloBranch
{ _phylo_branchId :: PhyloBranchId
, _phylo_branchLabel :: Text
, _phylo_branchMetrics :: Map Text [Double]
{ _pb_id :: PhyloBranchId
, _pb_label :: Text
, _pb_metrics :: Map Text [Double]
} deriving (Show)
data PhyloEdge = PhyloEdge
{ _phylo_edgeSource :: PhyloGroupId
, _phylo_edgeTarget :: PhyloGroupId
, _phylo_edgeType :: EdgeType
, _phylo_edgeWeight :: Weight
{ _pe_source :: PhyloGroupId
, _pe_target :: PhyloGroupId
, _pe_type :: EdgeType
, _pe_weight :: Weight
} deriving (Show)
data PhyloNode = PhyloNode
{ _phylo_nodeId :: PhyloGroupId
, _phylo_nodeBranchId :: Maybe PhyloBranchId
, _phylo_nodeLabel :: Text
, _phylo_nodeNgramsIdx :: [Int]
, _phylo_nodeNgrams :: Maybe [Ngrams]
, _phylo_nodeMetrics :: Map Text [Double]
, _phylo_nodeLevelParents :: Maybe [PhyloGroupId]
, _phylo_nodeLevelChilds :: [PhyloNode]
{ _pn_id :: PhyloGroupId
, _pn_bid :: Maybe PhyloBranchId
, _pn_label :: Text
, _pn_idx :: [Int]
, _pn_ngrams :: Maybe [Ngrams]
, _pn_metrics :: Map Text [Double]
, _pn_parents :: Maybe [PhyloGroupId]
, _pn_childs :: [PhyloNode]
} deriving (Show)
......@@ -448,7 +447,7 @@ makeLenses ''Proximity
makeLenses ''Cluster
makeLenses ''Filter
--
makeLenses ''PhyloQuery
makeLenses ''PhyloQueryBuild
makeLenses ''PhyloQueryView
--
makeLenses ''PhyloView
......@@ -485,7 +484,14 @@ $(deriveJSON (unPrefix "_rc_" ) ''RCParams )
$(deriveJSON (unPrefix "_wlj_" ) ''WLJParams )
$(deriveJSON (unPrefix "_sb_" ) ''SBParams )
--
$(deriveJSON (unPrefix "_q_" ) ''PhyloQuery )
$(deriveJSON (unPrefix "_q_" ) ''PhyloQueryBuild )
$(deriveJSON (unPrefix "_pv_" ) ''PhyloView )
$(deriveJSON (unPrefix "_pb_" ) ''PhyloBranch )
$(deriveJSON (unPrefix "_pe_" ) ''PhyloEdge )
$(deriveJSON (unPrefix "_pn_" ) ''PhyloNode )
$(deriveJSON defaultOptions ''Filiation )
$(deriveJSON defaultOptions ''EdgeType )
----------------------------
......
src/Gargantext/Viz/Phylo/Example.hs
View file @ 24958659
......@@ -81,7 +81,7 @@ phyloFromQuery :: Phylo
phyloFromQuery = toPhylo (queryParser queryEx) corpus actants actantsTrees
-- | To do : create a request handler and a query parser
queryParser :: [Char] -> PhyloQuery
queryParser :: [Char] -> PhyloQueryBuild
queryParser _q = phyloQuery
queryEx :: [Char]
......@@ -94,8 +94,8 @@ queryEx = "title=Cesar et Cleôpatre"
++ "nthCluster=RelatedComponents"
++ "nthProximity=Filiation"
phyloQuery :: PhyloQuery
phyloQuery = PhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
phyloQuery :: PhyloQueryBuild
phyloQuery = PhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
5 3 defaultFis [] [] defaultWeightedLogJaccard 3 defaultRelatedComponents
......
src/Gargantext/Viz/Phylo/LevelMaker.hs
View file @ 24958659
......@@ -25,7 +25,7 @@ import Data.Map (Map, (!), empty, restrictKeys, filterWithKe
import Data.Text (Text)
import Data.Tuple.Extra
import Data.Vector (Vector)
import Gargantext.Prelude hiding (head)
import Gargantext.Prelude hiding (head)
import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Aggregates.Cluster
import Gargantext.Viz.Phylo.Aggregates.Cooc
......@@ -145,8 +145,8 @@ toNthLevel lvlMax prox clus p
| lvl >= lvlMax = p
| otherwise = toNthLevel lvlMax prox clus
$ setPhyloBranches (lvl + 1)
$ interTempoMatching Descendant (lvl + 1) prox
$ interTempoMatching Ascendant (lvl + 1) prox
$ interTempoMatching Descendant (lvl + 1) prox
$ interTempoMatching Ascendant (lvl + 1) prox
$ setLevelLinks (lvl, lvl + 1)
$ addPhyloLevel (lvl + 1)
(phyloToClusters lvl (getProximity clus) clus p) p
......@@ -162,7 +162,7 @@ toPhylo1 :: Cluster -> Proximity -> [Metric] -> [Filter] -> Map (Date, Date) [Do
toPhylo1 clus prox metrics filters d p = case clus of
Fis (FisParams k s) -> setPhyloBranches 1
$ interTempoMatching Descendant 1 prox
$ interTempoMatching Ascendant 1 prox
$ interTempoMatching Ascendant 1 prox
$ setLevelLinks (0,1)
$ setLevelLinks (1,0)
$ addPhyloLevel 1 phyloFis p
......@@ -181,7 +181,7 @@ toPhylo0 d p = addPhyloLevel 0 d p
-- | To reconstruct the Base of a Phylo
toPhyloBase :: PhyloQuery -> PhyloParam -> [(Date, Text)] -> [Ngrams] -> [Tree Ngrams] -> Phylo
toPhyloBase :: PhyloQueryBuild -> PhyloParam -> [(Date, Text)] -> [Ngrams] -> [Tree Ngrams] -> Phylo
toPhyloBase q p c a ts = initPhyloBase periods foundations peaks p
where
--------------------------------------
......@@ -197,8 +197,8 @@ toPhyloBase q p c a ts = initPhyloBase periods foundations peaks p
--------------------------------------
-- | To reconstruct a Phylomemy from a PhyloQuery, a Corpus and a list of actants
toPhylo :: PhyloQuery -> [(Date, Text)] -> [Ngrams] -> [Tree Ngrams] -> Phylo
-- | To reconstruct a Phylomemy from a PhyloQueryBuild, a Corpus and a list of actants
toPhylo :: PhyloQueryBuild -> [(Date, Text)] -> [Ngrams] -> [Tree Ngrams] -> Phylo
toPhylo q c a ts = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthCluster q) phylo1
where
--------------------------------------
......
src/Gargantext/Viz/Phylo/Tools.hs
View file @ 24958659
......@@ -145,7 +145,7 @@ initPhyloBase :: [(Date, Date)] -> Vector Ngrams -> PhyloPeaks -> PhyloParam ->
initPhyloBase pds fds pks prm = Phylo ((fst . head) pds, (snd . last) pds) fds pks (map (\pd -> initPhyloPeriod pd []) pds) prm
-- | To init the param of a Phylo
initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQuery -> PhyloParam
initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQueryBuild -> PhyloParam
initPhyloParam (def defaultPhyloVersion -> v) (def defaultSoftware -> s) (def defaultQuery -> q) = PhyloParam v s q
-- | To get the foundations of a Phylo
......@@ -495,14 +495,14 @@ getNeighbours directed g e = case directed of
-- | To get the PhyloBranchId of PhyloNode if it exists
getNodeBranchId :: PhyloNode -> PhyloBranchId
getNodeBranchId n = case n ^. phylo_nodeBranchId of
getNodeBranchId n = case n ^. pn_bid of
Nothing -> panic "[ERR][Viz.Phylo.Tools.getNodeBranchId] branchId not found"
Just i -> i
-- | To get the PhyloGroupId of a PhyloNode
getNodeId :: PhyloNode -> PhyloGroupId
getNodeId n = n ^. phylo_nodeId
getNodeId n = n ^. pn_id
-- | To get the Level of a PhyloNode
......@@ -513,12 +513,12 @@ getNodeLevel n = (snd . fst) $ getNodeId n
-- | To get the Parent Node of a PhyloNode in a PhyloView
getNodeParent :: PhyloNode -> PhyloView -> [PhyloNode]
getNodeParent n v = filter (\n' -> elem (getNodeId n') (getNodeParentsId n))
$ v ^. phylo_viewNodes
$ v ^. pv_nodes
-- | To get the Parent Node id of a PhyloNode if it exists
getNodeParentsId :: PhyloNode -> [PhyloGroupId]
getNodeParentsId n = case n ^. phylo_nodeLevelParents of
getNodeParentsId n = case n ^. pn_parents of
Nothing -> panic "[ERR][Viz.Phylo.Tools.getNodeParentsId] node parent not found"
Just ids -> ids
......@@ -536,18 +536,18 @@ getNodesByBranches v = zip bIds $ map (\id -> filter (\n -> (getNodeBranchId n)
-- | To get a list of PhyloNodes owned by any PhyloBranches in a PhyloView
getNodesInBranches :: PhyloView -> [PhyloNode]
getNodesInBranches v = filter (\n -> isJust $ n ^. phylo_nodeBranchId)
$ v ^. phylo_viewNodes
getNodesInBranches v = filter (\n -> isJust $ n ^. pn_bid)
$ v ^. pv_nodes
-- | To get the PhyloGroupId of the Source of a PhyloEdge
getSourceId :: PhyloEdge -> PhyloGroupId
getSourceId e = e ^. phylo_edgeSource
getSourceId e = e ^. pe_source
-- | To get the PhyloGroupId of the Target of a PhyloEdge
getTargetId :: PhyloEdge -> PhyloGroupId
getTargetId e = e ^. phylo_edgeTarget
getTargetId e = e ^. pe_target
---------------------
......@@ -557,7 +557,7 @@ getTargetId e = e ^. phylo_edgeTarget
-- | To get the PhyloBranchId of a PhyloBranch
getBranchId :: PhyloBranch -> PhyloBranchId
getBranchId b = b ^. phylo_branchId
getBranchId b = b ^. pb_id
-- | To get a list of PhyloBranchIds given a Level in a Phylo
......@@ -569,12 +569,12 @@ getBranchIdsWith lvl p = sortOn snd
-- | To get the Meta value of a PhyloBranch
getBranchMeta :: Text -> PhyloBranch -> [Double]
getBranchMeta k b = (b ^. phylo_branchMetrics) ! k
getBranchMeta k b = (b ^. pb_metrics) ! k
-- | To get all the PhyloBranchIds of a PhyloView
getViewBranchIds :: PhyloView -> [PhyloBranchId]
getViewBranchIds v = map getBranchId $ v ^. phylo_viewBranches
getViewBranchIds v = map getBranchId $ v ^. pv_branches
--------------------------------
......@@ -582,47 +582,47 @@ getViewBranchIds v = map getBranchId $ v ^. phylo_viewBranches
--------------------------------
-- | To get the first clustering method to apply to get the contextual units of a Phylo
getContextualUnit :: PhyloQuery -> Cluster
getContextualUnit :: PhyloQueryBuild -> Cluster
getContextualUnit q = q ^. q_contextualUnit
-- | To get the metrics to apply to contextual units
getContextualUnitMetrics :: PhyloQuery -> [Metric]
getContextualUnitMetrics :: PhyloQueryBuild -> [Metric]
getContextualUnitMetrics q = q ^. q_contextualUnitMetrics
-- | To get the filters to apply to contextual units
getContextualUnitFilters :: PhyloQuery -> [Filter]
getContextualUnitFilters :: PhyloQueryBuild -> [Filter]
getContextualUnitFilters q = q ^. q_contextualUnitFilters
-- | To get the cluster methods to apply to the Nths levels of a Phylo
getNthCluster :: PhyloQuery -> Cluster
getNthCluster :: PhyloQueryBuild -> Cluster
getNthCluster q = q ^. q_nthCluster
-- | To get the Sup Level of a reconstruction of a Phylo from a PhyloQuery
getNthLevel :: PhyloQuery -> Level
getNthLevel :: PhyloQueryBuild -> Level
getNthLevel q = q ^. q_nthLevel
-- | To get the Grain of the PhyloPeriods from a PhyloQuery
getPeriodGrain :: PhyloQuery -> Int
getPeriodGrain :: PhyloQueryBuild -> Int
getPeriodGrain q = q ^. q_periodGrain
-- | To get the intertemporal matching strategy to apply to a Phylo from a PhyloQuery
getInterTemporalMatching :: PhyloQuery -> Proximity
getInterTemporalMatching :: PhyloQueryBuild -> Proximity
getInterTemporalMatching q = q ^. q_interTemporalMatching
-- | To get the Steps of the PhyloPeriods from a PhyloQuery
getPeriodSteps :: PhyloQuery -> Int
getPeriodSteps :: PhyloQueryBuild -> Int
getPeriodSteps q = q ^. q_periodSteps
--------------------------------------------------
-- | PhyloQuery & PhyloQueryView Constructors | --
-- | PhyloQueryBuild & PhyloQueryView Constructors | --
--------------------------------------------------
......@@ -655,10 +655,10 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
-- | To initialize a PhyloQuery from given and default parameters
initPhyloQuery :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQuery
initPhyloQuery :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
(def defaultWeightedLogJaccard -> matching') (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
PhyloQuery name desc grain steps cluster metrics filters matching' nthLevel nthCluster
PhyloQueryBuild name desc grain steps cluster metrics filters matching' nthLevel nthCluster
-- | To initialize a PhyloQueryView default parameters
......@@ -706,7 +706,7 @@ defaultWeightedLogJaccard = WeightedLogJaccard (initWeightedLogJaccard Nothing N
-- Queries
defaultQuery :: PhyloQuery
defaultQuery :: PhyloQueryBuild
defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
......
src/Gargantext/Viz/Phylo/View/Display.hs
View file @ 24958659
......@@ -38,7 +38,7 @@ toNestedView ns ns'
nested :: [PhyloNode]
nested = foldl (\ns'' n -> let nIds' = getNodeParentsId n
in map (\n' -> if elem (getNodeId n') nIds'
then n' & phylo_nodeLevelChilds %~ (++ [n])
then n' & pn_childs %~ (++ [n])
else n') ns'') ns' ns
--------------------------------------
......@@ -47,8 +47,8 @@ toNestedView ns ns'
processDisplay :: DisplayMode -> PhyloView -> PhyloView
processDisplay d v = case d of
Flat -> v
Nested -> let ns = sortOn getNodeLevel $ v ^. phylo_viewNodes
Nested -> let ns = sortOn getNodeLevel $ v ^. pv_nodes
lvl = getNodeLevel $ head ns
in v & phylo_viewNodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
(filter (\n -> lvl < getNodeLevel n) ns)
--_ -> panic "[ERR][Viz.Phylo.Example.processDisplay] display not found"
src/Gargantext/Viz/Phylo/View/Filters.hs
View file @ 24958659
......@@ -28,13 +28,13 @@ import Gargantext.Viz.Phylo.Tools
-- | To clean a PhyloView list of Nodes, Edges, etc after having filtered its Branches
cleanNodesEdges :: PhyloView -> PhyloView -> PhyloView
cleanNodesEdges v v' = v' & phylo_viewNodes %~ (filter (\n -> not $ elem (getNodeId n) nIds))
& phylo_viewNodes %~ (map (\n -> if isNothing (n ^. phylo_nodeLevelParents)
cleanNodesEdges v v' = v' & pv_nodes %~ (filter (\n -> not $ elem (getNodeId n) nIds))
& pv_nodes %~ (map (\n -> if isNothing (n ^. pn_parents)
then n
else if (not .null) $ (getNodeParentsId n) `intersect` nIds
then n & phylo_nodeLevelParents .~ Nothing
then n & pn_parents .~ Nothing
else n ))
& phylo_viewEdges %~ (filter (\e -> (not $ elem (getSourceId e) nIds)
& pv_edges %~ (filter (\e -> (not $ elem (getSourceId e) nIds)
&& (not $ elem (getTargetId e) nIds)))
where
--------------------------------------
......@@ -54,9 +54,9 @@ filterSmallBranch inf sup min' prds v = cleanNodesEdges v v'
where
--------------------------------------
v' :: PhyloView
v' = v & phylo_viewBranches %~ (filter (\b -> let ns = filter (\n -> (getBranchId b) == (getNodeBranchId n))
$ getNodesInBranches v
prds' = nub $ map (\n -> (fst . fst) $ getNodeId n) ns
v' = v & pv_branches %~ (filter (\b -> let
ns = filter (\n -> (getBranchId b) == (getNodeBranchId n)) $ getNodesInBranches v
prds' = nub $ map (\n -> (fst . fst) $ getNodeId n) ns
in not (isLone ns prds')))
--------------------------------------
isLone :: [PhyloNode] -> [PhyloPeriodId] -> Bool
......
src/Gargantext/Viz/Phylo/View/Metrics.hs
View file @ 24958659
......@@ -29,10 +29,10 @@ import Gargantext.Viz.Phylo.Tools
-- | To add a new meta Metric to a PhyloBranch
addBranchMetrics :: PhyloBranchId -> Text -> Double -> PhyloView -> PhyloView
addBranchMetrics id lbl val v = over (phylo_viewBranches
addBranchMetrics id lbl val v = over (pv_branches
. traverse)
(\b -> if getBranchId b == id
then b & phylo_branchMetrics %~ insert lbl [val]
then b & pb_metrics %~ insert lbl [val]
else b) v
......
src/Gargantext/Viz/Phylo/View/Sort.hs
View file @ 24958659
......@@ -27,7 +27,7 @@ import Gargantext.Viz.Phylo.Tools
-- | To sort a PhyloView by Age
sortBranchByAge :: Order -> PhyloView -> PhyloView
sortBranchByAge o v = v & phylo_viewBranches %~ f
sortBranchByAge o v = v & pv_branches %~ f
where
--------------------------------------
f :: [PhyloBranch] -> [PhyloBranch]
......
src/Gargantext/Viz/Phylo/View/Taggers.hs
View file @ 24958659
......@@ -66,10 +66,10 @@ mostOccNgrams thr group = (nub . concat )
-- | To alter the label of a PhyloBranch
alterBranchLabel :: (PhyloBranchId,Text) -> PhyloView -> PhyloView
alterBranchLabel (id,lbl) v = over (phylo_viewBranches
alterBranchLabel (id,lbl) v = over (pv_branches
. traverse)
(\b -> if getBranchId b == id
then b & phylo_branchLabel .~ lbl
then b & pb_label .~ lbl
else b) v
......@@ -83,12 +83,12 @@ branchLabelFreq v thr p = foldl (\v' (id,lbl) -> alterBranchLabel (id,lbl) v') v
-- | To set the label of a PhyloNode as the nth most coocurent terms of its PhyloNodes
nodeLabelCooc :: PhyloView -> Int -> Phylo -> PhyloView
nodeLabelCooc v thr p = over (phylo_viewNodes
nodeLabelCooc v thr p = over (pv_nodes
. traverse)
(\n -> let lbl = ngramsToLabel (getPeaksLabels p)
$ mostOccNgrams thr
$ head $ getGroupsFromIds [getNodeId n] p
in n & phylo_nodeLabel .~ lbl) v
in n & pn_label .~ lbl) v
-- | To process a sorted list of Taggers to a PhyloView
......
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
View file @ 24958659
......@@ -76,16 +76,16 @@ groupsToNodes isR isV ns gs = map (\g -> let idxs = getGroupNgrams g
mergeEdges :: [PhyloEdge] -> [PhyloEdge] -> [PhyloEdge]
mergeEdges lAsc lDes = elems
$ unionWithKey (\_k vAsc vDes -> vDes & phylo_edgeWeight .~ (max (vAsc ^. phylo_edgeWeight) (vDes ^. phylo_edgeWeight))) mAsc mDes
$ unionWithKey (\_k vAsc vDes -> vDes & pe_weight .~ (max (vAsc ^. pe_weight) (vDes ^. pe_weight))) mAsc mDes
where
--------------------------------------
mAsc :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
mAsc = fromList
$ zip (map (\e -> (e ^. phylo_edgeTarget,e ^. phylo_edgeSource)) lAsc) lAsc
$ zip (map (\e -> (e ^. pe_target,e ^. pe_source)) lAsc) lAsc
--------------------------------------
mDes :: Map (PhyloGroupId,PhyloGroupId) PhyloEdge
mDes = fromList
$ zip (map (\e -> (e ^. phylo_edgeSource,e ^. phylo_edgeTarget)) lDes) lDes
$ zip (map (\e -> (e ^. pe_source,e ^. pe_target)) lDes) lDes
--------------------------------------
......@@ -117,11 +117,11 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
if (not shouldDo) || (lvl == lvlMin)
then v
else addChildNodes shouldDo (lvl - 1) lvlMin vb fl p
$ v & phylo_viewBranches %~ (++ (phyloToBranches (lvl - 1) p))
& phylo_viewNodes %~ (++ (groupsToNodes False vb (getPeaksLabels p) gs'))
& phylo_viewEdges %~ (++ (groupsToEdges fl PeriodEdge gs'))
& phylo_viewEdges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
& phylo_viewEdges %~ (++ (groupsToEdges Ascendant LevelEdge gs'))
$ v & pv_branches %~ (++ (phyloToBranches (lvl - 1) p))
& pv_nodes %~ (++ (groupsToNodes False vb (getPeaksLabels p) gs'))
& pv_edges %~ (++ (groupsToEdges fl PeriodEdge gs'))
& pv_edges %~ (++ (groupsToEdges Descendant LevelEdge gs ))
& pv_edges %~ (++ (groupsToEdges Ascendant LevelEdge gs'))
where
--------------------------------------
gs :: [PhyloGroup]
......@@ -135,7 +135,7 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
-- | To transform a PhyloQuery into a PhyloView
toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
toPhyloView q p = processDisplay (q ^. qv_display)
$ processSort (q ^. qv_sort) p
$ processSort (q ^. qv_sort ) p
$ processTaggers (q ^. qv_taggers) p
$ processFilters (q ^. qv_filters) p
$ processMetrics (q ^. qv_metrics) p
......
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