From 6b56631798e14e8a17e7a31995cf95ec6d33c62a Mon Sep 17 00:00:00 2001
From: qlobbe <quentin.lobbe@gmail.com>
Date: Tue, 2 Apr 2019 12:21:41 +0200
Subject: [PATCH] Add the PhyloParam to the Phylo constructor
---
src/Gargantext/Viz/Phylo.hs | 80 ++-
src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs | 6 +-
src/Gargantext/Viz/Phylo/Example.hs | 129 +++--
src/Gargantext/Viz/Phylo/LevelMaker.hs | 16 +-
src/Gargantext/Viz/Phylo/Tools.hs | 512 ++++++++++++--------
src/Gargantext/Viz/Phylo/View/ViewMaker.hs | 22 +-
6 files changed, 444 insertions(+), 321 deletions(-)
diff --git a/src/Gargantext/Viz/Phylo.hs b/src/Gargantext/Viz/Phylo.hs
index 453ecab0..74793ef2 100644
--- a/src/Gargantext/Viz/Phylo.hs
+++ b/src/Gargantext/Viz/Phylo.hs
@@ -42,30 +42,31 @@ import Gargantext.Database.Schema.Ngrams (NgramsId)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Prelude
-------------------------------------------------------------------------
-data PhyloExport =
- PhyloExport { _phyloExport_param :: PhyloParam
- , _phyloExport_data :: Phylo
- } deriving (Generic, Show)
--- | .phylo parameters
+--------------------
+-- | PhyloParam | --
+--------------------
+
+
+-- | Global parameters of a Phylo
data PhyloParam =
- PhyloParam { _phyloParam_version :: Text -- Double ?
- , _phyloParam_software :: Software
- , _phyloParam_params :: Hash
- , _phyloParam_query :: Maybe PhyloQuery
+ PhyloParam { _phyloParam_version :: Text -- Double ?
+ , _phyloParam_software :: Software
+ , _phyloParam_query :: PhyloQuery
} deriving (Generic, Show)
-type Hash = Text
--- | Software
--- TODO move somewhere since it is generic
+-- | Software parameters
data Software =
Software { _software_name :: Text
, _software_version :: Text
} deriving (Generic, Show)
-------------------------------------------------------------------------
+
+---------------
+-- | Phylo | --
+---------------
+
-- | Phylo datatype of a phylomemy
-- Duration : time Segment of the whole Phylo
@@ -75,6 +76,7 @@ data Phylo =
Phylo { _phylo_duration :: (Start, End)
, _phylo_foundations :: Vector Ngrams
, _phylo_periods :: [PhyloPeriod]
+ , _phylo_param :: PhyloParam
}
deriving (Generic, Show)
@@ -88,6 +90,12 @@ type Date = Int
type Start = Date
type End = Date
+
+---------------------
+-- | PhyloPeriod | --
+---------------------
+
+
-- | PhyloStep : steps of phylomemy on temporal axis
-- Period: tuple (start date, end date) of the step of the phylomemy
-- Levels: levels of granularity
@@ -98,6 +106,11 @@ data PhyloPeriod =
deriving (Generic, Show)
+--------------------
+-- | PhyloLevel | --
+--------------------
+
+
-- | PhyloLevel : levels of phylomemy on level axis
-- Levels description:
-- Level -1: Ngram equals itself (by identity) == _phylo_Ngrams
@@ -111,6 +124,11 @@ data PhyloLevel =
deriving (Generic, Show)
+--------------------
+-- | PhyloGroup | --
+--------------------
+
+
-- | PhyloGroup : group of ngrams at each level and step
-- Label : maybe has a label as text
-- Ngrams: set of terms that build the group
@@ -155,7 +173,9 @@ type Pointer = (PhyloGroupId, Weight)
type Ngrams = Text
+--------------------
-- | Aggregates | --
+--------------------
-- | Document : a piece of Text linked to a Date
@@ -189,14 +209,17 @@ type GroupGraph = (GroupNodes,GroupEdges)
-- | Error | --
---------------
+
data PhyloError = LevelDoesNotExist
| LevelUnassigned
deriving (Show)
+
-----------------
-- | Cluster | --
-----------------
+
-- | Cluster constructors
data Cluster = Fis FisParams
| RelatedComponents RCParams
@@ -218,10 +241,12 @@ data RCParams = RCParams
data LouvainParams = LouvainParams
{ _louvain_proximity :: Proximity } deriving (Show)
+
-------------------
-- | Proximity | --
-------------------
+
-- | Proximity constructors
data Proximity = WeightedLogJaccard WLJParams
| Hamming HammingParams
@@ -238,10 +263,12 @@ data WLJParams = WLJParams
data HammingParams = HammingParams
{ _hamming_threshold :: Double } deriving (Show)
+
----------------
-- | Filter | --
----------------
+
-- | Filter constructors
data Filter = LonelyBranch LBParams deriving (Show)
@@ -251,36 +278,44 @@ data LBParams = LBParams
, _lb_periodsSup :: Int
, _lb_minNodes :: Int } deriving (Show)
+
----------------
-- | Metric | --
----------------
+
-- | Metric constructors
data Metric = BranchAge deriving (Show)
+
----------------
-- | Tagger | --
----------------
+
-- | Tagger constructors
data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
+
--------------
-- | Sort | --
--------------
+
-- | Sort constructors
data Sort = ByBranchAge deriving (Show)
data Order = Asc | Desc deriving (Show)
+
--------------------
-- | PhyloQuery | --
--------------------
+
-- | A Phyloquery describes a phylomemic reconstruction
data PhyloQuery = PhyloQuery
- { _q_phyloName :: Text
- , _q_phyloDesc :: Text
+ { _q_phyloTitle :: Text
+ , _q_phyloDesc :: Text
-- Grain and Steps for the PhyloPeriods
, _q_periodGrain :: Int
@@ -301,14 +336,16 @@ data PhyloQuery = PhyloQuery
data Filiation = Ascendant | Descendant | Complete deriving (Show)
data EdgeType = PeriodEdge | LevelEdge deriving (Show)
+
-------------------
-- | PhyloView | --
-------------------
+
-- | A PhyloView is the output type of a Phylo
data PhyloView = PhyloView
{ _phylo_viewParam :: PhyloParam
- , _phylo_viewLabel :: Text
+ , _phylo_viewTitle :: Text
, _phylo_viewDescription :: Text
, _phylo_viewFiliation :: Filiation
, _phylo_viewMeta :: Map Text Double
@@ -342,10 +379,12 @@ data PhyloNode = PhyloNode
, _phylo_nodeChilds :: [PhyloNode]
} deriving (Show)
+
------------------------
-- | PhyloQueryView | --
------------------------
+
data DisplayMode = Flat | Nested
-- | A PhyloQueryView describes a Phylo as an output view
@@ -373,12 +412,13 @@ data PhyloQueryView = PhyloQueryView
, _qv_verbose :: Bool
}
+
----------------
-- | Lenses | --
----------------
+
makeLenses ''PhyloParam
-makeLenses ''PhyloExport
makeLenses ''Software
--
makeLenses ''Phylo
@@ -398,10 +438,12 @@ makeLenses ''PhyloBranch
makeLenses ''PhyloNode
makeLenses ''PhyloEdge
+
------------------------
-- | JSON instances | --
------------------------
+
$(deriveJSON (unPrefix "_phylo_" ) ''Phylo )
$(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
$(deriveJSON (unPrefix "_phylo_level" ) ''PhyloLevel )
@@ -409,7 +451,6 @@ $(deriveJSON (unPrefix "_phylo_group" ) ''PhyloGroup )
--
$(deriveJSON (unPrefix "_software_" ) ''Software )
$(deriveJSON (unPrefix "_phyloParam_" ) ''PhyloParam )
-$(deriveJSON (unPrefix "_phyloExport_" ) ''PhyloExport )
--
$(deriveJSON defaultOptions ''Cluster )
$(deriveJSON defaultOptions ''Proximity )
@@ -422,6 +463,7 @@ $(deriveJSON (unPrefix "_wlj_" ) ''WLJParams )
--
$(deriveJSON (unPrefix "_q_" ) ''PhyloQuery )
+
----------------------------
-- | TODO XML instances | --
----------------------------
diff --git a/src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs b/src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs
index 50b5ce4f..f6579842 100644
--- a/src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs
+++ b/src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs
@@ -49,4 +49,8 @@ fisToCooc m p = map (/docs)
--------------------------------------
cooc :: Map (Int, Int) (Double)
cooc = Map.fromList $ map (\x -> (x,0)) (listToUnDirectedCombiWith (\x -> getIdxInFoundations x p) fisNgrams)
- --------------------------------------
\ No newline at end of file
+ --------------------------------------
+
+
+-- phyloCooc :: Map (Int, Int) Double
+-- phyloCooc = fisToCooc phyloFis phylo1_0_1
\ No newline at end of file
diff --git a/src/Gargantext/Viz/Phylo/Example.hs b/src/Gargantext/Viz/Phylo/Example.hs
index 9abee1ff..1faa373c 100644
--- a/src/Gargantext/Viz/Phylo/Example.hs
+++ b/src/Gargantext/Viz/Phylo/Example.hs
@@ -74,62 +74,62 @@ import qualified Data.Tuple as Tuple
import qualified Data.Vector as Vector
-------------------------------------------------------------------------
--- | STEP 13 | -- Create a Phylo from a Rest request
-
-
-phylo' :: Phylo
-phylo' = toPhylo phyloQuery corpus actants
-
+------------------------------------------------------
+-- | STEP 12 | -- Create a PhyloView from a user Query
+------------------------------------------------------
-urlPhyloQuery :: [Char]
-urlPhyloQuery = "title=Cesar et Cleôpatre&description=An example of Phylomemy (french without accent)"
- ++ "grain=5&step=3"
- ++ "fstCluster=FrequentItemSet&fstClusterParam=supportInf:1&fstClusterParam=filterFis:True&fstClusterParam=emptyFis:False"
- ++ "timeMatching=WeightedLogJaccard&timeMatchingParam=sensibility:0&timeMatchingThreshold:0.01"
- ++ "levelMax=2"
- ++ "cluster=RelatedComponents&clusterProximity=Filiation"
+phyloView :: PhyloView
+phyloView = toPhyloView (queryParser' queryViewEx) phyloFromQuery
-phyloQuery :: PhyloQuery
-phyloQuery = PhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
- 5 3
- defaultFis
- defaultWeightedLogJaccard
- 2
- defaultRelatedComponents
+-- | To do : create an other request handler and an other query parser
+queryParser' :: [Char] -> PhyloQueryView
+queryParser' q = phyloQueryView
-
-------------------------------------------------------------------------
--- | STEP 12 | -- Return a Phylo as a View for upcomming visiualization tasks
+queryViewEx :: [Char]
+queryViewEx = "level=3"
+ ++ "&childs=false"
+ ++ "&filter=LonelyBranchFilter"
+ ++ "&metric=BranchAge"
+ ++ "&tagger=BranchLabelFreq"
+ ++ "&tagger=GroupLabelCooc"
--- | To do : add a queryParser from an URL and then update the defaultQuery
-urlToQuery :: Text -> PhyloQueryView
-urlToQuery url = defaultQuery
- & qv_metrics %~ (++ [BranchAge])
- & qv_filters %~ (++ [defaultLonelyBranch])
- & qv_taggers %~ (++ [BranchLabelFreq,GroupLabelCooc])
+phyloQueryView :: PhyloQueryView
+phyloQueryView = PhyloQueryView 3 Descendant False 1 [BranchAge] [defaultLonelyBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Flat True
-defaultQuery :: PhyloQueryView
-defaultQuery = PhyloQueryView 3 Descendant False 1 [] [] [] (Just (ByBranchAge,Asc)) Flat True
+--------------------------------------------------
+-- | STEP 11 | -- Create a Phylo from a user Query
+--------------------------------------------------
-urlQuery :: Text
-urlQuery = "level=3&childs=false&filter=LonelyBranchFilter(2,2,1):true&metric=BranchAge&tagger=BranchLabelFreq&tagger=GroupLabelCooc"
+phyloFromQuery :: Phylo
+phyloFromQuery = toPhylo (queryParser queryEx) corpus actants
+-- | To do : create a request handler and a query parser
+queryParser :: [Char] -> PhyloQuery
+queryParser q = phyloQuery
-toPhyloView :: Text -> Phylo -> PhyloView
-toPhyloView url p = queryToView (urlToQuery url) p
+queryEx :: [Char]
+queryEx = "title=Cesar et Cleôpatre"
+ ++ "&desc=An example of Phylomemy (french without accent)"
+ ++ "grain=5&steps=3"
+ ++ "cluster=FrequentItemSet"
+ ++ "interTemporalMatching=WeightedLogJaccard"
+ ++ "nthLevel=2"
+ ++ "nthCluster=RelatedComponents"
+ ++ "nthProximity=Filiation"
+phyloQuery :: PhyloQuery
+phyloQuery = PhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
+ 5 3 defaultFis defaultWeightedLogJaccard 3 defaultRelatedComponents
-phyloView :: PhyloView
-phyloView = toPhyloView urlQuery phylo6
-------------------------------------------------------------------------
--- | STEP 11 | -- Incrementaly cluster the PhyloGroups n times, link them through the Periods and build level n of the Phylo
+----------------------------------------------------------------------------------------------------------------------------
+-- | STEP 10 | -- Incrementaly cluster the PhyloGroups n times, link them through the Periods and build level n of the Phylo
+----------------------------------------------------------------------------------------------------------------------------
phylo6 :: Phylo
@@ -146,8 +146,10 @@ phylo3 = setPhyloBranches 3
phyloBranch2
-------------------------------------------------------------------------
--- | STEP 10 | -- Cluster the Fis
+--------------------------------
+-- | STEP 9 | -- Cluster the Fis
+--------------------------------
+
phyloBranch2 :: Phylo
phyloBranch2 = setPhyloBranches 2 phylo2_c
@@ -174,16 +176,18 @@ phyloCluster :: Map (Date,Date) [PhyloCluster]
phyloCluster = phyloToClusters 1 defaultWeightedLogJaccard defaultRelatedComponents phyloBranch1
-------------------------------------------------------------------------
--- | STEP 9 | -- Find the Branches
+----------------------------------
+-- | STEP 8 | -- Find the Branches
+----------------------------------
phyloBranch1 :: Phylo
phyloBranch1 = setPhyloBranches 1 phylo1_c
-------------------------------------------------------------------------
--- | STEP 8 | -- Link the PhyloGroups of level 1 through the Periods
+--------------------------------------------------------------------
+-- | STEP 7 | -- Link the PhyloGroups of level 1 through the Periods
+--------------------------------------------------------------------
phylo1_c :: Phylo
@@ -194,16 +198,9 @@ phylo1_p :: Phylo
phylo1_p = interTempoMatching Ascendant 1 defaultWeightedLogJaccard phylo1_0_1
-------------------------------------------------------------------------
--- | STEP 7 | -- Build the coocurency Matrix of the Phylo
-
-
-phyloCooc :: Map (Int, Int) Double
-phyloCooc = fisToCooc phyloFis phylo1_0_1
-
-
-------------------------------------------------------------------------
--- | STEP 6 | -- Build the level 1 of the Phylo
+-----------------------------------------------
+-- | STEP 6 | -- Build the level 1 of the Phylo
+-----------------------------------------------
phylo1_0_1 :: Phylo
@@ -218,20 +215,18 @@ phylo1 :: Phylo
phylo1 = addPhyloLevel (1) phyloFis phylo
-------------------------------------------------------------------------
+-------------------------------------------------------------------
-- | STEP 5 | -- Create lists of Frequent Items Set and filter them
+-------------------------------------------------------------------
phyloFis :: Map (Date, Date) [PhyloFis]
phyloFis = filterFisBySupport False 1 (filterFisByNested (docsToFis phyloDocs))
-------------------------------------------------------------------------
+----------------------------------------
-- | STEP 2 | -- Init a Phylo of level 0
-
-
--- phylo' :: Phylo
--- phylo' = initPhylo 5 3 corpus actants groupNgramsWithTrees
+----------------------------------------
phylo :: Phylo
@@ -244,10 +239,11 @@ phyloDocs = corpusToDocs groupNgramsWithTrees corpus phyloBase
------------------------------------------------------------------------
-- | STEP 1 | -- Init the Base of the Phylo from Periods and Foundations
+------------------------------------------------------------------------
phyloBase :: Phylo
-phyloBase = initPhyloBase periods foundations
+phyloBase = initPhyloBase periods foundations defaultPhyloParam
periods :: [(Date,Date)]
@@ -259,8 +255,9 @@ foundations :: Vector Ngrams
foundations = initFoundations actants
-------------------------------------------------------------------------
+--------------------------------------------
-- | STEP 0 | -- Let's start with an example
+--------------------------------------------
actants :: [Ngrams]
@@ -270,4 +267,6 @@ actants = [ "Cleopatre" , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV"
corpus :: [(Date, Text)]
-corpus = List.sortOn fst [ (-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."), (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII. Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]
\ No newline at end of file
+corpus = List.sortOn fst [ (-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."), (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII. Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]
+
+
diff --git a/src/Gargantext/Viz/Phylo/LevelMaker.hs b/src/Gargantext/Viz/Phylo/LevelMaker.hs
index 83cec1dd..e7d8a4d0 100644
--- a/src/Gargantext/Viz/Phylo/LevelMaker.hs
+++ b/src/Gargantext/Viz/Phylo/LevelMaker.hs
@@ -144,16 +144,6 @@ toPhyloLevel lvl m p = alterPhyloPeriods
) period) p
--- | To init a Phylo
-initPhylo :: Grain -> Step -> [(Date,Text)] -> [Ngrams] -> (Ngrams -> Ngrams) -> Phylo
-initPhylo g s c a f = addPhyloLevel 0 (corpusToDocs f c base) base
- where
- --------------------------------------
- base :: Phylo
- base = initPhyloBase (initPeriods g s $ both fst (head c,last c)) (initFoundations a)
- --------------------------------------
-
-
-- | To incrementally add new Levels to a Phylo by making all the linking and aggregation tasks
toNthLevel :: Level -> Proximity -> Cluster -> Phylo -> Phylo
toNthLevel lvlMax prox clus p
@@ -198,8 +188,8 @@ toPhylo0 d p = addPhyloLevel 0 d p
-- | To reconstruct the Base of a Phylo
-toPhyloBase :: PhyloQuery -> [(Date, Text)] -> [Ngrams] -> Phylo
-toPhyloBase q c a = initPhyloBase periods foundations
+toPhyloBase :: PhyloQuery -> PhyloParam -> [(Date, Text)] -> [Ngrams] -> Phylo
+toPhyloBase q p c a = initPhyloBase periods foundations p
where
--------------------------------------
periods :: [(Date,Date)]
@@ -226,5 +216,5 @@ toPhylo q c a = toNthLevel (getNthLevel q) (getInterTemporalMatching q) (getNthC
phyloDocs = corpusToDocs groupNgramsWithTrees c phyloBase
--------------------------------------
phyloBase :: Phylo
- phyloBase = toPhyloBase q c a
+ phyloBase = toPhyloBase q (initPhyloParam (Just defaultPhyloVersion) (Just defaultSoftware) (Just q)) c a
--------------------------------------
\ No newline at end of file
diff --git a/src/Gargantext/Viz/Phylo/Tools.hs b/src/Gargantext/Viz/Phylo/Tools.hs
index 81c57bf0..2d490e5b 100644
--- a/src/Gargantext/Viz/Phylo/Tools.hs
+++ b/src/Gargantext/Viz/Phylo/Tools.hs
@@ -35,49 +35,14 @@ import qualified Data.Set as Set
import qualified Data.Vector as Vector
-------------------------------------------------------------------------
--- | Tools | --
+--------------
+-- | Misc | --
+--------------
--- | To alter a PhyloGroup matching a given Level
-alterGroupWithLevel :: (PhyloGroup -> PhyloGroup) -> Level -> Phylo -> Phylo
-alterGroupWithLevel f lvl p = over ( phylo_periods
- . traverse
- . phylo_periodLevels
- . traverse
- . phylo_levelGroups
- . traverse
- ) (\g -> if getGroupLevel g == lvl
- then f g
- else g ) p
-
-
--- | To alter each list of PhyloGroups following a given function
-alterPhyloGroups :: ([PhyloGroup] -> [PhyloGroup]) -> Phylo -> Phylo
-alterPhyloGroups f p = over ( phylo_periods
- . traverse
- . phylo_periodLevels
- . traverse
- . phylo_levelGroups
- ) f p
-
-
--- | To alter each PhyloPeriod of a Phylo following a given function
-alterPhyloPeriods :: (PhyloPeriod -> PhyloPeriod) -> Phylo -> Phylo
-alterPhyloPeriods f p = over ( phylo_periods
- . traverse) f p
-
-
--- | To alter a list of PhyloLevels following a given function
-alterPhyloLevels :: ([PhyloLevel] -> [PhyloLevel]) -> Phylo -> Phylo
-alterPhyloLevels f p = over ( phylo_periods
- . traverse
- . phylo_periodLevels) f p
-
-
--- | To append a list of PhyloPeriod to a Phylo
-appendToPhyloPeriods :: [PhyloPeriod] -> Phylo -> Phylo
-appendToPhyloPeriods l p = over (phylo_periods) (++ l) p
+-- | Define a default value
+def :: a -> Maybe a -> a
+def = fromMaybe
-- | Does a List of Sets contains at least one Set of an other List
@@ -103,11 +68,6 @@ doesContainsOrd l l'
| otherwise = doesContainsOrd l (tail l')
- -- | To filter the PhyloGroup of a Phylo according to a function and a value
-filterGroups :: Eq a => (PhyloGroup -> a) -> a -> [PhyloGroup] -> [PhyloGroup]
-filterGroups f x l = filter (\g -> (f g) == x) l
-
-
-- | To filter nested Sets of a
filterNestedSets :: Eq a => Set a -> [Set a] -> [Set a] -> [Set a]
filterNestedSets h l l'
@@ -115,34 +75,75 @@ filterNestedSets h l l'
then l'
else h : l'
| doesAnySetContains h l l' = filterNestedSets (head l) (tail l) l'
- | otherwise = filterNestedSets (head l) (tail l) (h : l')
+ | otherwise = filterNestedSets (head l) (tail l) (h : l')
--- | To filter some GroupEdges with a given threshold
-filterGroupEdges :: Double -> GroupEdges -> GroupEdges
-filterGroupEdges thr edges = filter (\((s,t),w) -> w > thr) edges
+
+-- | To get the good pair of keys (x,y) or (y,x) in a given Map (a,b) c
+getKeyPair :: (Int,Int) -> Map (Int,Int) a -> (Int,Int)
+getKeyPair (x,y) m = case findPair (x,y) m of
+ Nothing -> panic "[ERR][Viz.Phylo.Example.getKeyPair] Nothing"
+ Just i -> i
+ where
+ --------------------------------------
+ findPair :: (Int,Int) -> Map (Int,Int) a -> Maybe (Int,Int)
+ findPair (x,y) m
+ | member (x,y) m = Just (x,y)
+ | member (y,x) m = Just (y,x)
+ | otherwise = Nothing
+ --------------------------------------
--- | To get the PhyloBranchId of a PhyloBranch
-getBranchId :: PhyloBranch -> PhyloBranchId
-getBranchId b = b ^. phylo_branchId
+-- | To filter Fis with small Support but by keeping non empty Periods
+keepFilled :: (Int -> [a] -> [a]) -> Int -> [a] -> [a]
+keepFilled f thr l = if (null $ f thr l) && (not $ null l)
+ then keepFilled f (thr - 1) l
+ else f thr l
--- | To get a list of PhyloBranchIds given a Level in a Phylo
-getBranchIdsWith :: Level -> Phylo -> [PhyloBranchId]
-getBranchIdsWith lvl p = sortOn snd
- $ mapMaybe getGroupBranchId
- $ getGroupsWithLevel lvl p
+-- | To get all combinations of a list
+listToDirectedCombi :: Eq a => [a] -> [(a,a)]
+listToDirectedCombi l = [(x,y) | x <- l, y <- l, x /= y]
--- | To get the Meta value of a PhyloBranch
-getBranchMeta :: Text -> PhyloBranch -> Double
-getBranchMeta k b = (b ^. phylo_branchMeta) ! k
+-- | To get all combinations of a list and apply a function to the resulting list of pairs
+listToDirectedCombiWith :: Eq a => forall b. (a -> b) -> [a] -> [(b,b)]
+listToDirectedCombiWith f l = [(f x,f y) | x <- l, y <- l, x /= y]
--- | To get the first clustering method to apply to get the level 1 of a Phylo
-getFstCluster :: PhyloQuery -> Cluster
-getFstCluster q = q ^. q_cluster
+-- | To get all combinations of a list with no repetition
+listToUnDirectedCombi :: [a] -> [(a,a)]
+listToUnDirectedCombi l = [ (x,y) | (x:rest) <- tails l, y <- rest ]
+
+
+-- | To get all combinations of a list with no repetition and apply a function to the resulting list of pairs
+listToUnDirectedCombiWith :: forall a b. (a -> b) -> [a] -> [(b,b)]
+listToUnDirectedCombiWith f l = [ (f x, f y) | (x:rest) <- tails l, y <- rest ]
+
+
+-- | To unify the keys (x,y) that Map 1 share with Map 2 such as: (x,y) <=> (y,x)
+unifySharedKeys :: Eq a => Ord a => Map (a,a) b -> Map (a,a) b -> Map (a,a) b
+unifySharedKeys m1 m2 = mapKeys (\(x,y) -> if member (y,x) m2
+ then (y,x)
+ else (x,y) ) m1
+
+
+---------------
+-- | Phylo | --
+---------------
+
+
+-- | To init the foundation of the Phylo as a Vector of Ngrams
+initFoundations :: [Ngrams] -> Vector Ngrams
+initFoundations l = Vector.fromList $ map toLower l
+
+-- | To init the base of a Phylo from a List of Periods and Foundations
+initPhyloBase :: [(Date, Date)] -> Vector Ngrams -> PhyloParam -> Phylo
+initPhyloBase pds fds prm = Phylo ((fst . head) pds, (snd . last) pds) fds (map (\pd -> initPhyloPeriod pd []) pds) prm
+
+-- | To init the param of a Phylo
+initPhyloParam :: Maybe Text -> Maybe Software -> Maybe PhyloQuery -> PhyloParam
+initPhyloParam (def defaultPhyloVersion -> v) (def defaultSoftware -> s) (def defaultQuery -> q) = PhyloParam v s q
-- | To get the foundations of a Phylo
@@ -157,6 +158,48 @@ getIdxInFoundations n p = case (elemIndex n (getFoundations p)) of
Just idx -> idx
+-- | To get the last computed Level in a Phylo
+getLastLevel :: Phylo -> Level
+getLastLevel p = (last . sort)
+ $ map (snd . getPhyloLevelId)
+ $ view ( phylo_periods
+ . traverse
+ . phylo_periodLevels ) p
+
+
+--------------------
+-- | PhyloGroup | --
+--------------------
+
+
+-- | To alter a PhyloGroup matching a given Level
+alterGroupWithLevel :: (PhyloGroup -> PhyloGroup) -> Level -> Phylo -> Phylo
+alterGroupWithLevel f lvl p = over ( phylo_periods
+ . traverse
+ . phylo_periodLevels
+ . traverse
+ . phylo_levelGroups
+ . traverse
+ ) (\g -> if getGroupLevel g == lvl
+ then f g
+ else g ) p
+
+
+-- | To alter each list of PhyloGroups following a given function
+alterPhyloGroups :: ([PhyloGroup] -> [PhyloGroup]) -> Phylo -> Phylo
+alterPhyloGroups f p = over ( phylo_periods
+ . traverse
+ . phylo_periodLevels
+ . traverse
+ . phylo_levelGroups
+ ) f p
+
+
+-- | To filter the PhyloGroup of a Phylo according to a function and a value
+filterGroups :: Eq a => (PhyloGroup -> a) -> a -> [PhyloGroup] -> [PhyloGroup]
+filterGroups f x l = filter (\g -> (f g) == x) l
+
+
-- | To maybe get the PhyloBranchId of a PhyloGroup
getGroupBranchId :: PhyloGroup -> Maybe PhyloBranchId
getGroupBranchId = _phylo_groupBranchId
@@ -277,32 +320,96 @@ getGroupsWithLevel lvl p = filterGroups getGroupLevel lvl (getGroups p)
-- | To get all the PhyloGroup of a Phylo with a given Period
getGroupsWithPeriod :: (Date,Date) -> Phylo -> [PhyloGroup]
getGroupsWithPeriod prd p = filterGroups getGroupPeriod prd (getGroups p)
-
--- | To get the good pair of keys (x,y) or (y,x) in a given Map (a,b) c
-getKeyPair :: (Int,Int) -> Map (Int,Int) a -> (Int,Int)
-getKeyPair (x,y) m = case findPair (x,y) m of
- Nothing -> panic "[ERR][Viz.Phylo.Example.getKeyPair] Nothing"
- Just i -> i
- where
- --------------------------------------
- findPair :: (Int,Int) -> Map (Int,Int) a -> Maybe (Int,Int)
- findPair (x,y) m
- | member (x,y) m = Just (x,y)
- | member (y,x) m = Just (y,x)
- | otherwise = Nothing
- --------------------------------------
+-- | To create a PhyloGroup in a Phylo out of a list of Ngrams and a set of parameters
+initGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> Phylo -> PhyloGroup
+initGroup ngrams lbl idx lvl from to p = PhyloGroup
+ (((from, to), lvl), idx)
+ lbl
+ (sort $ map (\x -> getIdxInFoundations x p) ngrams)
+ (Map.empty)
+ (Map.empty)
+ Nothing
+ [] [] [] []
--- | To get the last computed Level in a Phylo
-getLastLevel :: Phylo -> Level
-getLastLevel p = (last . sort)
- $ map (snd . getPhyloLevelId)
- $ view ( phylo_periods
- . traverse
- . phylo_periodLevels ) p
+
+---------------------
+-- | PhyloPeriod | --
+---------------------
+-- | To alter each PhyloPeriod of a Phylo following a given function
+alterPhyloPeriods :: (PhyloPeriod -> PhyloPeriod) -> Phylo -> Phylo
+alterPhyloPeriods f p = over ( phylo_periods
+ . traverse) f p
+
+
+-- | To append a list of PhyloPeriod to a Phylo
+appendToPhyloPeriods :: [PhyloPeriod] -> Phylo -> Phylo
+appendToPhyloPeriods l p = over (phylo_periods) (++ l) p
+
+
+-- | To get all the PhyloPeriodIds of a Phylo
+getPhyloPeriods :: Phylo -> [PhyloPeriodId]
+getPhyloPeriods p = map _phylo_periodId
+ $ view (phylo_periods) p
+
+
+-- | To get the id of a given PhyloPeriod
+getPhyloPeriodId :: PhyloPeriod -> PhyloPeriodId
+getPhyloPeriodId prd = _phylo_periodId prd
+
+
+-- | To create a PhyloPeriod
+initPhyloPeriod :: PhyloPeriodId -> [PhyloLevel] -> PhyloPeriod
+initPhyloPeriod id l = PhyloPeriod id l
+
+
+--------------------
+-- | PhyloLevel | --
+--------------------
+
+
+-- | To alter a list of PhyloLevels following a given function
+alterPhyloLevels :: ([PhyloLevel] -> [PhyloLevel]) -> Phylo -> Phylo
+alterPhyloLevels f p = over ( phylo_periods
+ . traverse
+ . phylo_periodLevels) f p
+
+
+-- | To get the PhylolevelId of a given PhyloLevel
+getPhyloLevelId :: PhyloLevel -> PhyloLevelId
+getPhyloLevelId = _phylo_levelId
+
+
+-- | To get all the Phylolevels of a given PhyloPeriod
+getPhyloLevels :: PhyloPeriod -> [PhyloLevel]
+getPhyloLevels = view (phylo_periodLevels)
+
+
+-- | To create a PhyloLevel
+initPhyloLevel :: PhyloLevelId -> [PhyloGroup] -> PhyloLevel
+initPhyloLevel id groups = PhyloLevel id groups
+
+
+-- | To set the LevelId of a PhyloLevel and of all its PhyloGroups
+setPhyloLevelId :: Int -> PhyloLevel -> PhyloLevel
+setPhyloLevelId lvl' (PhyloLevel (id, lvl) groups)
+ = PhyloLevel (id, lvl') groups'
+ where
+ groups' = over (traverse . phylo_groupId) (\((period, lvl), idx) -> ((period, lvl'), idx)) groups
+
+
+----------------------------
+-- | PhyloNodes & Edges | --
+----------------------------
+
+
+-- | To filter some GroupEdges with a given threshold
+filterGroupEdges :: Double -> GroupEdges -> GroupEdges
+filterGroupEdges thr edges = filter (\((s,t),w) -> w > thr) edges
+
-- | To get the neighbours (directed/undirected) of a PhyloGroup from a list of GroupEdges
getNeighbours :: Bool -> PhyloGroup -> GroupEdges -> [PhyloGroup]
@@ -361,45 +468,61 @@ getNodesInBranches v = filter (\n -> isJust $ n ^. phylo_nodeBranchId)
$ v ^. phylo_viewNodes
--- | To get the cluster methods to apply to the Nths levels of a Phylo
-getNthCluster :: PhyloQuery -> Cluster
-getNthCluster q = q ^. q_nthCluster
+-- | To get the PhyloGroupId of the Source of a PhyloEdge
+getSourceId :: PhyloEdge -> PhyloGroupId
+getSourceId e = e ^. phylo_edgeSource
--- | To get the Sup Level of a reconstruction of a Phylo from a PhyloQuery
-getNthLevel :: PhyloQuery -> Level
-getNthLevel q = q ^. q_nthLevel
+-- | To get the PhyloGroupId of the Target of a PhyloEdge
+getTargetId :: PhyloEdge -> PhyloGroupId
+getTargetId e = e ^. phylo_edgeTarget
--- | To get the PhylolevelId of a given PhyloLevel
-getPhyloLevelId :: PhyloLevel -> PhyloLevelId
-getPhyloLevelId = _phylo_levelId
+---------------------
+-- | PhyloBranch | --
+---------------------
--- | To get all the Phylolevels of a given PhyloPeriod
-getPhyloLevels :: PhyloPeriod -> [PhyloLevel]
-getPhyloLevels = view (phylo_periodLevels)
+-- | To get the PhyloBranchId of a PhyloBranch
+getBranchId :: PhyloBranch -> PhyloBranchId
+getBranchId b = b ^. phylo_branchId
--- | To get all the PhyloPeriodIds of a Phylo
-getPhyloPeriods :: Phylo -> [PhyloPeriodId]
-getPhyloPeriods p = map _phylo_periodId
- $ view (phylo_periods) p
+-- | To get a list of PhyloBranchIds given a Level in a Phylo
+getBranchIdsWith :: Level -> Phylo -> [PhyloBranchId]
+getBranchIdsWith lvl p = sortOn snd
+ $ mapMaybe getGroupBranchId
+ $ getGroupsWithLevel lvl p
--- | To get the id of a given PhyloPeriod
-getPhyloPeriodId :: PhyloPeriod -> PhyloPeriodId
-getPhyloPeriodId prd = _phylo_periodId prd
+-- | To get the Meta value of a PhyloBranch
+getBranchMeta :: Text -> PhyloBranch -> Double
+getBranchMeta k b = (b ^. phylo_branchMeta) ! k
--- | To get the PhyloGroupId of the Source of a PhyloEdge
-getSourceId :: PhyloEdge -> PhyloGroupId
-getSourceId e = e ^. phylo_edgeSource
+-- | To get all the PhyloBranchIds of a PhyloView
+getViewBranchIds :: PhyloView -> [PhyloBranchId]
+getViewBranchIds v = map getBranchId $ v ^. phylo_viewBranches
--- | To get the PhyloGroupId of the Target of a PhyloEdge
-getTargetId :: PhyloEdge -> PhyloGroupId
-getTargetId e = e ^. phylo_edgeTarget
+--------------------------------
+-- | PhyloQuery & QueryView | --
+--------------------------------
+
+
+-- | To get the first clustering method to apply to get the level 1 of a Phylo
+getFstCluster :: PhyloQuery -> Cluster
+getFstCluster q = q ^. q_cluster
+
+
+-- | To get the cluster methods to apply to the Nths levels of a Phylo
+getNthCluster :: PhyloQuery -> Cluster
+getNthCluster q = q ^. q_nthCluster
+
+
+-- | To get the Sup Level of a reconstruction of a Phylo from a PhyloQuery
+getNthLevel :: PhyloQuery -> Level
+getNthLevel q = q ^. q_nthLevel
-- | To get the Grain of the PhyloPeriods from a PhyloQuery
@@ -417,150 +540,111 @@ getPeriodSteps :: PhyloQuery -> Int
getPeriodSteps q = q ^. q_periodSteps
--- | To get all the PhyloBranchIds of a PhyloView
-getViewBranchIds :: PhyloView -> [PhyloBranchId]
-getViewBranchIds v = map getBranchId $ v ^. phylo_viewBranches
-
-
--- | To init the foundation of the Phylo as a Vector of Ngrams
-initFoundations :: [Ngrams] -> Vector Ngrams
-initFoundations l = Vector.fromList $ map toLower l
-
-
--- | To create a PhyloGroup in a Phylo out of a list of Ngrams and a set of parameters
-initGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> Phylo -> PhyloGroup
-initGroup ngrams lbl idx lvl from to p = PhyloGroup
- (((from, to), lvl), idx)
- lbl
- (sort $ map (\x -> getIdxInFoundations x p) ngrams)
- (Map.empty)
- (Map.empty)
- Nothing
- [] [] [] []
+--------------------------------------------------
+-- | PhyloQuery & PhyloQueryView Constructors | --
+--------------------------------------------------
--- | To init the Base of a Phylo from a List of Periods and Foundations
-initPhyloBase :: [(Date, Date)] -> Vector Ngrams -> Phylo
-initPhyloBase pds fds = Phylo ((fst . head) pds, (snd . last) pds) fds (map (\pd -> initPhyloPeriod pd []) pds)
+-- | To get the Proximity associated to a given Clustering method
+getProximity :: Cluster -> Proximity
+getProximity cluster = case cluster of
+ Louvain (LouvainParams proxi) -> proxi
+ RelatedComponents (RCParams proxi) -> proxi
+ _ -> panic "[ERR][Viz.Phylo.Tools.getProximity] this cluster has no associated Proximity"
--- | To create a PhyloLevel
-initPhyloLevel :: PhyloLevelId -> [PhyloGroup] -> PhyloLevel
-initPhyloLevel id groups = PhyloLevel id groups
+-- | To initialize all the Cluster / Proximity with their default parameters
+initFis :: Maybe Bool -> Maybe Bool -> Maybe Support -> FisParams
+initFis (def True -> flt) (def True -> kmf) (def 1 -> min) = FisParams flt kmf min
+initHamming :: Maybe Double -> HammingParams
+initHamming (def 0.01 -> sens) = HammingParams sens
--- | To create a PhyloPeriod
-initPhyloPeriod :: PhyloPeriodId -> [PhyloLevel] -> PhyloPeriod
-initPhyloPeriod id l = PhyloPeriod id l
+initLonelyBranch :: Maybe Int -> Maybe Int -> Maybe Int -> LBParams
+initLonelyBranch (def 2 -> periodsInf) (def 2 -> periodsSup) (def 1 -> minNodes) = LBParams periodsInf periodsSup minNodes
+initLouvain :: Maybe Proximity -> LouvainParams
+initLouvain (def defaultWeightedLogJaccard -> proxi) = LouvainParams proxi
--- | To filter Fis with small Support but by keeping non empty Periods
-keepFilled :: (Int -> [a] -> [a]) -> Int -> [a] -> [a]
-keepFilled f thr l = if (null $ f thr l) && (not $ null l)
- then keepFilled f (thr - 1) l
- else f thr l
+initRelatedComponents :: Maybe Proximity -> RCParams
+initRelatedComponents (def Filiation -> proxi) = RCParams proxi
+initWeightedLogJaccard :: Maybe Double -> Maybe Double -> WLJParams
+initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
--- | To get all combinations of a list
-listToDirectedCombi :: Eq a => [a] -> [(a,a)]
-listToDirectedCombi l = [(x,y) | x <- l, y <- l, x /= y]
+-- | To initialize a PhyloQuery from given and default parameters
+initPhyloQuery :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQuery
+initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster)
+ (def defaultWeightedLogJaccard -> matching) (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
+ PhyloQuery name desc grain steps cluster matching nthLevel nthCluster
--- | To get all combinations of a list and apply a function to the resulting list of pairs
-listToDirectedCombiWith :: Eq a => forall b. (a -> b) -> [a] -> [(b,b)]
-listToDirectedCombiWith f l = [(f x,f y) | x <- l, y <- l, x /= y]
+-- | To initialize a PhyloQueryView default parameters
+initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
+initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Flat -> dm) (def True -> v) =
+ PhyloQueryView lvl f c d ms fs ts s dm v
--- | To get all combinations of a list with no repetition
-listToUnDirectedCombi :: [a] -> [(a,a)]
-listToUnDirectedCombi l = [ (x,y) | (x:rest) <- tails l, y <- rest ]
+-- | To define some obvious boolean getters
+shouldFilterFis :: FisParams -> Bool
+shouldFilterFis = _fis_filtered
--- | To get all combinations of a list with no repetition and apply a function to the resulting list of pairs
-listToUnDirectedCombiWith :: forall a b. (a -> b) -> [a] -> [(b,b)]
-listToUnDirectedCombiWith f l = [ (f x, f y) | (x:rest) <- tails l, y <- rest ]
+shouldKeepMinorFis :: FisParams -> Bool
+shouldKeepMinorFis = _fis_keepMinorFis
+----------------------------
+-- | Default ressources | --
+----------------------------
--- | To set the LevelId of a PhyloLevel and of all its PhyloGroups
-setPhyloLevelId :: Int -> PhyloLevel -> PhyloLevel
-setPhyloLevelId lvl' (PhyloLevel (id, lvl) groups)
- = PhyloLevel (id, lvl') groups'
- where
- groups' = over (traverse . phylo_groupId) (\((period, lvl), idx) -> ((period, lvl'), idx)) groups
+-- Clusters
+defaultFis :: Cluster
+defaultFis = Fis (initFis Nothing Nothing Nothing)
--- | To unify the keys (x,y) that Map 1 share with Map 2 such as: (x,y) <=> (y,x)
-unifySharedKeys :: Eq a => Ord a => Map (a,a) b -> Map (a,a) b -> Map (a,a) b
-unifySharedKeys m1 m2 = mapKeys (\(x,y) -> if member (y,x) m2
- then (y,x)
- else (x,y) ) m1
+defaultLouvain :: Cluster
+defaultLouvain = Louvain (initLouvain Nothing)
+defaultRelatedComponents :: Cluster
+defaultRelatedComponents = RelatedComponents (initRelatedComponents Nothing)
+-- Filters
---------------------------------------------------
--- | PhyloQuery & PhyloQueryView Constructors | --
+defaultLonelyBranch :: Filter
+defaultLonelyBranch = LonelyBranch (initLonelyBranch Nothing Nothing Nothing)
+-- Params
--- | Define a default value for each Proximity / Cluster
-dft :: a -> Maybe a -> a
-dft = fromMaybe
+defaultPhyloParam :: PhyloParam
+defaultPhyloParam = initPhyloParam Nothing Nothing Nothing
-defaultFis :: Cluster
-defaultFis = Fis (initFis Nothing Nothing Nothing)
+-- Proximities
defaultHamming :: Proximity
defaultHamming = Hamming (initHamming Nothing)
-defaultLonelyBranch = LonelyBranch (initLonelyBranch Nothing Nothing Nothing)
-
-defaultLouvain :: Cluster
-defaultLouvain = Louvain (initLouvain Nothing)
-
-defaultRelatedComponents :: Cluster
-defaultRelatedComponents = RelatedComponents (initRelatedComponents Nothing)
-
defaultWeightedLogJaccard :: Proximity
defaultWeightedLogJaccard = WeightedLogJaccard (initWeightedLogJaccard Nothing Nothing)
+-- Queries
--- | To get the Proximity associated to a given Clustering method
-getProximity :: Cluster -> Proximity
-getProximity cluster = case cluster of
- Louvain (LouvainParams proxi) -> proxi
- RelatedComponents (RCParams proxi) -> proxi
- _ -> panic "[ERR][Viz.Phylo.Tools.getProximity] this cluster has no associated Proximity"
+defaultQuery :: PhyloQuery
+defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
+ Nothing Nothing Nothing Nothing Nothing Nothing
+defaultQueryView :: PhyloQueryView
+defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
--- | To initialize all the Cluster / Proximity with their default parameters
-initFis :: Maybe Bool -> Maybe Bool -> Maybe Support -> FisParams
-initFis (dft True -> flt) (dft True -> kmf) (dft 1 -> min) = FisParams flt kmf min
+-- Software
-initHamming :: Maybe Double -> HammingParams
-initHamming (dft 0.01 -> sens) = HammingParams sens
+defaultSoftware :: Software
+defaultSoftware = Software "Gargantext" "v4"
-initLonelyBranch :: Maybe Int -> Maybe Int -> Maybe Int -> LBParams
-initLonelyBranch (dft 2 -> periodsInf) (dft 2 -> periodsSup) (dft 1 -> minNodes) = LBParams periodsInf periodsSup minNodes
+-- Version
-initLouvain :: Maybe Proximity -> LouvainParams
-initLouvain (dft defaultWeightedLogJaccard -> proxi) = LouvainParams proxi
+defaultPhyloVersion :: Text
+defaultPhyloVersion = "v1"
-initRelatedComponents :: Maybe Proximity -> RCParams
-initRelatedComponents (dft Filiation -> proxi) = RCParams proxi
-
-initWeightedLogJaccard :: Maybe Double -> Maybe Double -> WLJParams
-initWeightedLogJaccard (dft 0 -> thr) (dft 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 Proximity -> Maybe Level -> Maybe Cluster -> PhyloQuery
-initPhyloQuery name desc (dft 5 -> grain) (dft 3 -> steps) (dft defaultFis -> cluster)
- (dft defaultWeightedLogJaccard -> matching) (dft 2 -> nthLevel) (dft defaultRelatedComponents -> nthCluster) =
- PhyloQuery name desc grain steps cluster matching nthLevel nthCluster
--- | To define some obvious boolean getters
-shouldFilterFis :: FisParams -> Bool
-shouldFilterFis = _fis_filtered
-shouldKeepMinorFis :: FisParams -> Bool
-shouldKeepMinorFis = _fis_keepMinorFis
\ No newline at end of file
diff --git a/src/Gargantext/Viz/Phylo/View/ViewMaker.hs b/src/Gargantext/Viz/Phylo/View/ViewMaker.hs
index 5324ff2c..31ff9839 100644
--- a/src/Gargantext/Viz/Phylo/View/ViewMaker.hs
+++ b/src/Gargantext/Viz/Phylo/View/ViewMaker.hs
@@ -125,21 +125,25 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
-- | To transform a PhyloQuery into a PhyloView
-queryToView :: PhyloQueryView -> Phylo -> PhyloView
-queryToView q p = processDisplay (q ^. qv_display)
+toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
+toPhyloView q p = processDisplay (q ^. qv_display)
$ processSort (q ^. qv_sort) p
$ processTaggers (q ^. qv_taggers) p
$ processFilters (q ^. qv_filters) p
$ processMetrics (q ^. qv_metrics) p
$ addChildNodes (q ^. qv_childs) (q ^. qv_lvl) (q ^. qv_childsDepth) (q ^. qv_verbose) (q ^. qv_filiation) p
- $ initPhyloView (q ^. qv_lvl) "Phylo2000" "This is a Phylo" (q ^. qv_filiation) (q ^. qv_verbose) p
+ $ initPhyloView (q ^. qv_lvl) (getPhyloTitle p) (getPhyloDescription p) (q ^. qv_filiation) (q ^. qv_verbose) p
--- | dirty params
-phyloParams :: PhyloParam
-phyloParams = PhyloParam "v0.1" (Software "Gargantext" "v4") "" Nothing
-
--- | To do : effectively get the PhyloParams of a Phylo
+-- | To get the PhyloParam of a Phylo
getPhyloParams :: Phylo -> PhyloParam
-getPhyloParams p = phyloParams
\ No newline at end of file
+getPhyloParams = _phylo_param
+
+-- | To get the title of a Phylo
+getPhyloTitle :: Phylo -> Text
+getPhyloTitle p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
+
+-- | To get the desc of a Phylo
+getPhyloDescription :: Phylo -> Text
+getPhyloDescription p = _q_phyloTitle $ _phyloParam_query $ getPhyloParams p
\ No newline at end of file
--
2.21.0