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

[PHYLO.API] Adding REST functions.

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