-{-|
-Module : Gargantext.Core.Viz.Phylo
+{-
+Module : Gargantext.Core.Viz.AdaptativePhylo
Description : Phylomemy definitions and types.
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Chavalarias, D., Cointet, J.-P., 2013. Phylomemetic patterns
in science evolution — the rise and fall of scientific fields. PloS
one 8, e54847.
-
-}
{-# LANGUAGE DeriveAnyClass #-}
module Gargantext.Core.Viz.Phylo where
-import Control.DeepSeq
+import Control.DeepSeq (NFData)
import Control.Lens (makeLenses)
-import Data.Aeson.TH (deriveJSON,defaultOptions)
-import Data.Map (Map)
-import Data.Set (Set)
+import Data.Aeson
+import Data.Aeson.TH (deriveJSON)
+import Data.Map.Strict (Map)
+import Data.Set (Set)
import Data.Swagger
-import Data.Text (Text)
-import Data.Vector (Vector)
-import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Prelude
+import Data.Text (Text, pack)
+import Data.Vector (Vector)
+import GHC.Generics
+import GHC.IO (FilePath)
import Gargantext.Core.Text.Context (TermList)
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Prelude
+import qualified Data.Text.Lazy as TextLazy
---------------------
--- | PhyloParam | --
---------------------
+----------------
+-- | PhyloConfig | --
+----------------
+data CorpusParser =
+ Wos {_wos_limit :: Int}
+ | Csv {_csv_limit :: Int}
+ | Csv' {_csv'_limit :: Int}
+ deriving (Show,Generic,Eq)
--- | Global parameters of a Phylo
-data PhyloParam =
- PhyloParam { _phyloParam_version :: Text -- Double ?
- , _phyloParam_software :: Software
- , _phyloParam_query :: PhyloQueryBuild
- } deriving (Generic, Show, Eq)
+instance ToSchema CorpusParser where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
--- | Software parameters
-data Software =
- Software { _software_name :: Text
- , _software_version :: Text
- } deriving (Generic, Show, Eq)
+data ListParser = V3 | V4 deriving (Show,Generic,Eq)
+instance ToSchema ListParser
----------------
--- | Phylo | --
----------------
+data SeaElevation =
+ Constante
+ { _cons_start :: Double
+ , _cons_gap :: Double }
+ | Adaptative
+ { _adap_steps :: Double }
+ deriving (Show,Generic,Eq)
+instance ToSchema SeaElevation
--- | Phylo datatype of a phylomemy
--- Duration : time Segment of the whole Phylo
--- Foundations : vector of all the Ngrams contained in a Phylo (build from a list of actants)
--- Periods : list of all the periods of a Phylo
-data Phylo =
- Phylo { _phylo_duration :: (Start, End)
- , _phylo_foundations :: PhyloFoundations
- , _phylo_periods :: [PhyloPeriod]
- , _phylo_docsByYears :: Map Date Double
- , _phylo_cooc :: !(Map Date (Map (Int,Int) Double))
- , _phylo_fis :: !(Map (Date,Date) [PhyloFis])
- , _phylo_param :: PhyloParam
- }
- deriving (Generic, Show, Eq)
+data Proximity =
+ WeightedLogJaccard
+ { _wlj_sensibility :: Double
+ , _wlj_minSharedNgrams :: Int }
+ | WeightedLogSim
+ { _wls_sensibility :: Double
+ , _wls_minSharedNgrams :: Int }
+ | Hamming
+ { _hmg_sensibility :: Double
+ , _hmg_minSharedNgrams :: Int}
+ deriving (Show,Generic,Eq)
--- | The foundations of a phylomemy created from a given TermList
-data PhyloFoundations =
- PhyloFoundations { _phylo_foundationsRoots :: Vector Ngrams
- , _phylo_foundationsTermsList :: TermList
- } deriving (Generic, Show, Eq)
+instance ToSchema Proximity where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+
+data SynchronyScope = SingleBranch | SiblingBranches | AllBranches
+ deriving (Show,Generic,Eq, ToSchema)
+
+data SynchronyStrategy = MergeRegularGroups | MergeAllGroups
+ deriving (Show,Generic,Eq)
+
+instance ToSchema SynchronyStrategy where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+
+data Synchrony =
+ ByProximityThreshold
+ { _bpt_threshold :: Double
+ , _bpt_sensibility :: Double
+ , _bpt_scope :: SynchronyScope
+ , _bpt_strategy :: SynchronyStrategy }
+ | ByProximityDistribution
+ { _bpd_sensibility :: Double
+ , _bpd_strategy :: SynchronyStrategy }
+ deriving (Show,Generic,Eq)
+
+instance ToSchema Synchrony where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
+
+
+
+data TimeUnit =
+ Epoch
+ { _epoch_period :: Int
+ , _epoch_step :: Int
+ , _epoch_matchingFrame :: Int }
+ | Year
+ { _year_period :: Int
+ , _year_step :: Int
+ , _year_matchingFrame :: Int }
+ | Month
+ { _month_period :: Int
+ , _month_step :: Int
+ , _month_matchingFrame :: Int }
+ | Week
+ { _week_period :: Int
+ , _week_step :: Int
+ , _week_matchingFrame :: Int }
+ | Day
+ { _day_period :: Int
+ , _day_step :: Int
+ , _day_matchingFrame :: Int }
+ deriving (Show,Generic,Eq)
+
+instance ToSchema TimeUnit where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+
+data MaxCliqueFilter = ByThreshold | ByNeighbours deriving (Show,Generic,Eq)
+
+instance ToSchema MaxCliqueFilter where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+
+
+data Cluster =
+ Fis
+ { _fis_support :: Int
+ , _fis_size :: Int }
+ | MaxClique
+ { _mcl_size :: Int
+ , _mcl_threshold :: Double
+ , _mcl_filter :: MaxCliqueFilter }
+ deriving (Show,Generic,Eq)
+
+instance ToSchema Cluster where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+
+data Quality =
+ Quality { _qua_granularity :: Double
+ , _qua_minBranch :: Int }
+ deriving (Show,Generic,Eq)
+
+instance ToSchema Quality where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_qua_")
+
+
+data PhyloConfig =
+ PhyloConfig { corpusPath :: FilePath
+ , listPath :: FilePath
+ , outputPath :: FilePath
+ , corpusParser :: CorpusParser
+ , listParser :: ListParser
+ , phyloName :: Text
+ , phyloScale :: Int
+ , phyloProximity :: Proximity
+ , seaElevation :: SeaElevation
+ , findAncestors :: Bool
+ , phyloSynchrony :: Synchrony
+ , phyloQuality :: Quality
+ , timeUnit :: TimeUnit
+ , clique :: Cluster
+ , exportLabel :: [PhyloLabel]
+ , exportSort :: Sort
+ , exportFilter :: [Filter]
+ } deriving (Show,Generic,Eq)
+
+
+------------------------------------------------------------------------
+data PhyloSubConfig =
+ PhyloSubConfig { _sc_phyloProximity :: Double
+ , _sc_phyloSynchrony :: Double
+ , _sc_phyloQuality :: Double
+ , _sc_timeUnit :: TimeUnit
+ , _sc_clique :: Cluster
+ , _sc_exportFilter :: Double
+ }
+ deriving (Show,Generic,Eq)
--- | Date : a simple Integer
-type Date = Int
+subConfig2config :: PhyloSubConfig -> PhyloConfig
+subConfig2config subConfig = defaultConfig { phyloProximity = WeightedLogJaccard (_sc_phyloProximity subConfig) 1
+ , phyloSynchrony = ByProximityThreshold (_sc_phyloSynchrony subConfig) 0 AllBranches MergeAllGroups
+ , phyloQuality = Quality (_sc_phyloQuality subConfig) 1
+ , timeUnit = _sc_timeUnit subConfig
+ , clique = _sc_clique subConfig
+ , exportFilter = [ByBranchSize $ _sc_exportFilter subConfig]
+ }
--- | UTCTime in seconds since UNIX epoch
--- type Start = POSIXTime
--- type End = POSIXTime
-type Start = Date
-type End = Date
+------------------------------------------------------------------------
+defaultConfig :: PhyloConfig
+defaultConfig =
+ PhyloConfig { corpusPath = "corpus.csv" -- useful for commandline only
+ , listPath = "list.csv" -- useful for commandline only
+ , outputPath = "data/"
+ , corpusParser = Csv 100000
+ , listParser = V4
+ , phyloName = pack "Phylo Name"
+ , phyloScale = 2
+ , phyloProximity = WeightedLogJaccard 0.5 1
+ , seaElevation = Constante 0.1 0.1
+ , findAncestors = False
+ , phyloSynchrony = ByProximityThreshold 0.5 0 AllBranches MergeAllGroups
+ , phyloQuality = Quality 0.5 1
+ , timeUnit = Year 3 1 5
+ , clique = MaxClique 5 0.0001 ByThreshold
+ , exportLabel = [BranchLabel MostEmergentTfIdf 2, GroupLabel MostEmergentInclusive 2]
+ , exportSort = ByHierarchy Desc
+ , exportFilter = [ByBranchSize 3]
+ }
+-- Main Instances
+instance ToSchema PhyloConfig
+instance ToSchema PhyloSubConfig
----------------------
--- | PhyloPeriod | --
----------------------
+instance FromJSON PhyloConfig
+instance ToJSON PhyloConfig
+instance FromJSON PhyloSubConfig
+instance ToJSON PhyloSubConfig
--- | PhyloStep : steps of phylomemy on temporal axis
--- Period: tuple (start date, end date) of the step of the phylomemy
--- Levels: levels of granularity
-data PhyloPeriod =
- PhyloPeriod { _phylo_periodId :: PhyloPeriodId
- , _phylo_periodLevels :: [PhyloLevel]
- }
- deriving (Generic, Show, Eq)
+instance FromJSON CorpusParser
+instance ToJSON CorpusParser
+instance FromJSON ListParser
+instance ToJSON ListParser
---------------------
--- | PhyloLevel | --
---------------------
+instance FromJSON Proximity
+instance ToJSON Proximity
+instance FromJSON SeaElevation
+instance ToJSON SeaElevation
--- | PhyloLevel : levels of phylomemy on level axis
--- Levels description:
--- Level -1: Ngram equals itself (by identity) == _phylo_Ngrams
--- Level 0: Group of synonyms (by stems + by qualitative expert meaning)
--- Level 1: First level of clustering
--- Level N: Nth level of clustering
-data PhyloLevel =
- PhyloLevel { _phylo_levelId :: PhyloLevelId
- , _phylo_levelGroups :: [PhyloGroup]
- }
- deriving (Generic, Show, Eq)
+instance FromJSON TimeUnit
+instance ToJSON TimeUnit
+instance FromJSON MaxCliqueFilter
+instance ToJSON MaxCliqueFilter
---------------------
--- | PhyloGroup | --
---------------------
+instance FromJSON Cluster
+instance ToJSON Cluster
+instance FromJSON PhyloLabel
+instance ToJSON PhyloLabel
--- | PhyloGroup : group of ngrams at each level and step
--- Label : maybe has a label as text
--- Ngrams: set of terms that build the group
--- Quality : map of measures (support, etc.) that depict some qualitative aspects of a phylo
--- Period Parents|Childs: weighted link to Parents|Childs (Temporal Period axis)
--- Level Parents|Childs: weighted link to Parents|Childs (Level Granularity axis)
--- Pointers are directed link from Self to any PhyloGroup (/= Self ?)
-data PhyloGroup =
- PhyloGroup { _phylo_groupId :: PhyloGroupId
- , _phylo_groupLabel :: Text
- , _phylo_groupNgrams :: [Int]
- , _phylo_groupNgramsMeta :: Map Text [Double]
- , _phylo_groupMeta :: Map Text Double
- , _phylo_groupBranchId :: Maybe PhyloBranchId
- , _phylo_groupCooc :: !(Map (Int,Int) Double)
-
- , _phylo_groupPeriodParents :: [Pointer]
- , _phylo_groupPeriodChilds :: [Pointer]
-
- , _phylo_groupLevelParents :: [Pointer]
- , _phylo_groupLevelChilds :: [Pointer]
- }
- deriving (Generic, NFData, Show, Eq, Ord)
+instance FromJSON Tagger
+instance ToJSON Tagger
--- instance NFData PhyloGroup
+instance FromJSON Sort
+instance ToJSON Sort
+instance FromJSON Order
+instance ToJSON Order
--- | Level : A level of aggregation (-1 = Txt, 0 = Ngrams, 1 = Fis, [2..] = Cluster)
-type Level = Int
--- | Index : A generic index of an element (PhyloGroup, PhyloBranch, etc) in a given List
-type Index = Int
+instance FromJSON Filter
+instance ToJSON Filter
+instance FromJSON SynchronyScope
+instance ToJSON SynchronyScope
-type PhyloPeriodId = (Start, End)
-type PhyloLevelId = (PhyloPeriodId, Level)
-type PhyloGroupId = (PhyloLevelId, Index)
-type PhyloBranchId = (Level, Index)
+instance FromJSON SynchronyStrategy
+instance ToJSON SynchronyStrategy
+instance FromJSON Synchrony
+instance ToJSON Synchrony
--- | Weight : A generic mesure that can be associated with an Id
-type Weight = Double
--- | Pointer : A weighted linked with a given PhyloGroup
-type Pointer = (PhyloGroupId, Weight)
--- | Ngrams : a contiguous sequence of n terms
-type Ngrams = Text
+instance FromJSON Quality
+instance ToJSON Quality
---------------------
--- | Aggregates | --
---------------------
+-- | Software parameters
+data Software =
+ Software { _software_name :: Text
+ , _software_version :: Text
+ } deriving (Generic, Show, Eq)
+instance ToSchema Software where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_software_")
--- | Document : a piece of Text linked to a Date
-data Document = Document
- { date :: Date
- , text :: [Ngrams]
- } deriving (Show,Generic,NFData)
--- | Clique : Set of ngrams cooccurring in the same Document
-type Clique = Set Ngrams
--- | Support : Number of Documents where a Clique occurs
-type Support = Int
--- | Fis : Frequent Items Set (ie: the association between a Clique and a Support)
-data PhyloFis = PhyloFis
- { _phyloFis_clique :: Clique
- , _phyloFis_support :: Support
- , _phyloFis_period :: (Date,Date)
- } deriving (Generic,NFData,Show,Eq)
--- | A list of clustered PhyloGroup
-type PhyloCluster = [PhyloGroup]
+defaultSoftware :: Software
+defaultSoftware =
+ Software { _software_name = pack "GarganText"
+ , _software_version = pack "v5" }
--- | A PhyloGroup in a Graph
-type GroupNode = PhyloGroup
--- | A weighted links between two PhyloGroups in a Graph
-type GroupEdge = ((PhyloGroup,PhyloGroup),Weight)
--- | The association as a Graph between a list of Nodes and a list of Edges
-type GroupGraph = ([GroupNode],[GroupEdge])
+-- | Global parameters of a Phylo
+data PhyloParam =
+ PhyloParam { _phyloParam_version :: Text
+ , _phyloParam_software :: Software
+ , _phyloParam_config :: PhyloConfig
+ } deriving (Generic, Show, Eq)
+instance ToSchema PhyloParam where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phyloParam_")
----------------
--- | Error | --
----------------
-data PhyloError = LevelDoesNotExist
- | LevelUnassigned
- deriving (Show)
+defaultPhyloParam :: PhyloParam
+defaultPhyloParam =
+ PhyloParam { _phyloParam_version = pack "v3"
+ , _phyloParam_software = defaultSoftware
+ , _phyloParam_config = defaultConfig }
------------------
--- | Cluster | --
------------------
+------------------
+-- | Document | --
+------------------
+-- | Date : a simple Integer
+type Date = Int
--- | Cluster constructors
-data Cluster = Fis FisParams
- | RelatedComponents RCParams
- | Louvain LouvainParams
- deriving (Generic, Show, Eq, Read)
+-- | DateStr : the string version of a Date
+type DateStr = Text
--- | Parameters for Fis clustering
-data FisParams = FisParams
- { _fis_keepMinorFis :: Bool
- , _fis_minSupport :: Support
- , _fis_minSize :: Int
- } deriving (Generic, Show, Eq, Read)
+-- | Ngrams : a contiguous sequence of n terms
+type Ngrams = Text
--- | Parameters for RelatedComponents clustering
-data RCParams = RCParams
- { _rc_proximity :: Proximity } deriving (Generic, Show, Eq, Read)
+-- Document : a piece of Text linked to a Date
+-- date = computational date; date' = original string date yyyy-mm-dd
+-- Export Database to Document
+data Document = Document
+ { date :: Date -- datatype Date {unDate :: Int}
+ , date' :: DateStr -- show date
+ , text :: [Ngrams]
+ , weight :: Maybe Double
+ , sources :: [Text]
+ } deriving (Eq,Show,Generic,NFData)
--- | Parameters for Louvain clustering
-data LouvainParams = LouvainParams
- { _louvain_proximity :: Proximity } deriving (Generic, Show, Eq, Read)
+--------------------
+-- | Foundation | --
+--------------------
--------------------
--- | Proximity | --
--------------------
+-- | The Foundations of a Phylo created from a given TermList
+data PhyloFoundations = PhyloFoundations
+ { _foundations_roots :: !(Vector Ngrams)
+ , _foundations_mapList :: TermList
+ } deriving (Generic, Show, Eq)
--- | Proximity constructors
-data Proximity = WeightedLogJaccard WLJParams
- | Hamming HammingParams
- | Filiation
- deriving (Generic, Show, Eq, Read)
+instance ToSchema PhyloFoundations where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_foundations_")
--- | Parameters for WeightedLogJaccard proximity
-data WLJParams = WLJParams
- { _wlj_threshold :: Double
- , _wlj_sensibility :: Double
- } deriving (Generic, Show, Eq, Read)
--- | Parameters for Hamming proximity
-data HammingParams = HammingParams
- { _hamming_threshold :: Double } deriving (Generic, Show, Eq, Read)
+data PhyloSources = PhyloSources
+ { _sources :: !(Vector Text) } deriving (Generic, Show, Eq)
-----------------
--- | Filter | --
-----------------
+instance ToSchema PhyloSources where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
+---------------------------
+-- | Coocurency Matrix | --
+---------------------------
--- | Filter constructors
-data Filter = LonelyBranch LBParams
- | SizeBranch SBParams
- deriving (Generic, Show, Eq)
--- | Parameters for LonelyBranch filter
-data LBParams = LBParams
- { _lb_periodsInf :: Int
- , _lb_periodsSup :: Int
- , _lb_minNodes :: Int } deriving (Generic, Show, Eq)
+-- | Cooc : a coocurency matrix between two ngrams
+type Cooc = Map (Int,Int) Double
--- | Parameters for SizeBranch filter
-data SBParams = SBParams
- { _sb_minSize :: Int } deriving (Generic, Show, Eq)
+-------------------
+-- | Phylomemy | --
+-------------------
-----------------
--- | Metric | --
-----------------
+-- | Period : a tuple of Dates
+type Period = (Date,Date)
+-- | PeriodStr : a tuple of DateStr
+type PeriodStr = (DateStr,DateStr)
--- | Metric constructors
-data Metric = BranchAge | BranchBirth | BranchGroups deriving (Generic, Show, Eq, Read)
+
+-- | Phylo datatype of a phylomemy
+-- foundations : the foundations of the phylo
+-- timeCooc : a Map of coocurency by minimal unit of time (ex: by year)
+-- timeDocs : a Map with the numbers of docs by minimal unit of time (ex: by year)
+-- param : the parameters of the phylomemy (with the user's configuration)
+-- periods : the temporal steps of a phylomemy
+data Phylo =
+ Phylo { _phylo_foundations :: PhyloFoundations
+ , _phylo_sources :: PhyloSources
+ , _phylo_timeCooc :: !(Map Date Cooc)
+ , _phylo_timeDocs :: !(Map Date Double)
+ , _phylo_termFreq :: !(Map Int Double)
+ , _phylo_lastTermFreq :: !(Map Int Double)
+ , _phylo_diaSimScan :: Set Double
+ , _phylo_param :: PhyloParam
+ , _phylo_periods :: Map Period PhyloPeriod
+ , _phylo_quality :: Double
+ }
+ deriving (Generic, Show, Eq)
+
+instance ToSchema Phylo where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
----------------
--- | Tagger | --
+-- | Period | --
----------------
+-- | PhyloPeriod : steps of a phylomemy on a temporal axis
+-- id: tuple (start date, end date) of the temporal step of the phylomemy
+-- scales: scales of synchronic description
+data PhyloPeriod =
+ PhyloPeriod { _phylo_periodPeriod :: Period
+ , _phylo_periodPeriodStr :: PeriodStr
+ , _phylo_periodScales :: Map PhyloScaleId PhyloScale
+ } deriving (Generic, Show, Eq)
--- | Tagger constructors
-data Tagger = BranchPeakFreq | BranchPeakCooc | BranchPeakInc
- | GroupLabelCooc | GroupLabelInc | GroupLabelIncDyn deriving (Show,Generic,Read)
+instance ToSchema PhyloPeriod where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
+---------------
+-- | Scale | --
+---------------
---------------
--- | Sort | --
---------------
+-- | Scale : a scale of synchronic description
+type Scale = Int
+-- | PhyloScaleId : the id of a scale of synchronic description
+type PhyloScaleId = (Period,Scale)
--- | Sort constructors
-data Sort = ByBranchAge | ByBranchBirth deriving (Generic, Show, Read, Enum, Bounded)
-data Order = Asc | Desc deriving (Generic, Show, Read)
+-- | PhyloScale : sub-structure of the phylomemy in scale of synchronic description
+data PhyloScale =
+ PhyloScale { _phylo_scalePeriod :: Period
+ , _phylo_scalePeriodStr :: PeriodStr
+ , _phylo_scaleScale :: Scale
+ , _phylo_scaleGroups :: Map PhyloGroupId PhyloGroup
+ }
+ deriving (Generic, Show, Eq)
+instance ToSchema PhyloScale where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
---------------------
--- | PhyloQuery | --
---------------------
+type PhyloGroupId = (PhyloScaleId, Int)
--- | A Phyloquery describes a phylomemic reconstruction
-data PhyloQueryBuild = PhyloQueryBuild
- { _q_phyloTitle :: Text
- , _q_phyloDesc :: Text
+-- | BranchId : (a scale, a sequence of branch index)
+-- the sequence is a path of heritage from the most to the less specific branch
+type PhyloBranchId = (Scale, [Int])
- -- Grain and Steps for the PhyloPeriods
- , _q_periodGrain :: Int
- , _q_periodSteps :: Int
+-- | PhyloGroup : group of ngrams at each scale and period
+data PhyloGroup =
+ PhyloGroup { _phylo_groupPeriod :: Period
+ , _phylo_groupPeriod' :: (Text,Text)
+ , _phylo_groupScale :: Scale
+ , _phylo_groupIndex :: Int
+ , _phylo_groupLabel :: Text
+ , _phylo_groupSupport :: Support
+ , _phylo_groupWeight :: Maybe Double
+ , _phylo_groupSources :: [Int]
+ , _phylo_groupNgrams :: [Int]
+ , _phylo_groupCooc :: !(Cooc)
+ , _phylo_groupBranchId :: PhyloBranchId
+ , _phylo_groupMeta :: Map Text [Double]
+ , _phylo_groupScaleParents :: [Pointer]
+ , _phylo_groupScaleChilds :: [Pointer]
+ , _phylo_groupPeriodParents :: [Pointer]
+ , _phylo_groupPeriodChilds :: [Pointer]
+ , _phylo_groupAncestors :: [Pointer]
+ , _phylo_groupPeriodMemoryParents :: [Pointer']
+ , _phylo_groupPeriodMemoryChilds :: [Pointer']
+ }
+ deriving (Generic, Show, Eq, NFData)
- -- Clustering method for building the contextual unit of Phylo (ie: level 1)
- , _q_contextualUnit :: Cluster
- , _q_contextualUnitMetrics :: [Metric]
- , _q_contextualUnitFilters :: [Filter]
+instance ToSchema PhyloGroup where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
- -- Inter-temporal matching method of the Phylo
- , _q_interTemporalMatching :: Proximity
- , _q_interTemporalMatchingFrame :: Int
- , _q_interTemporalMatchingFrameTh :: Double
- , _q_reBranchThr :: Double
- , _q_reBranchNth :: Int
+-- | Weight : A generic mesure that can be associated with an Id
+type Weight = Double
+type Thr = Double
+
+-- | Pointer : A weighted pointer to a given PhyloGroup
+type Pointer = (PhyloGroupId, Weight)
+-- | Pointer' : A weighted pointer to a given PhyloGroup with a lower bounded threshold
+type Pointer' = (PhyloGroupId, (Thr,Weight))
- -- Last level of reconstruction
- , _q_nthLevel :: Level
- -- Clustering method used from level 1 to nthLevel
- , _q_nthCluster :: Cluster
- } deriving (Generic, Show, Eq)
+data Filiation = ToParents | ToChilds | ToParentsMemory | ToChildsMemory deriving (Generic, Show)
+data PointerType = TemporalPointer | ScalePointer deriving (Generic, Show)
--- | To choose the Phylo edge you want to export : --> <-- <--> <=>
-data Filiation = Ascendant | Descendant | Merge | Complete deriving (Generic, Show, Read)
-data EdgeType = PeriodEdge | LevelEdge deriving (Generic, Show, Eq)
--------------------
--- | PhyloView | --
--------------------
+--------------------------
+-- | Phylo Clustering | --
+--------------------------
+-- | Support : Number of Documents where a Cluster occurs
+type Support = Int
--- | A PhyloView is the output type of a Phylo
-data PhyloView = PhyloView
- { _pv_param :: PhyloParam
- , _pv_title :: Text
- , _pv_description :: Text
- , _pv_filiation :: Filiation
- , _pv_level :: Level
- , _pv_periods :: [PhyloPeriodId]
- , _pv_metrics :: Map Text [Double]
- , _pv_branches :: [PhyloBranch]
- , _pv_nodes :: [PhyloNode]
- , _pv_edges :: [PhyloEdge]
- } deriving (Generic, Show)
-
--- | A phyloview is made of PhyloBranches, edges and nodes
-data PhyloBranch = PhyloBranch
- { _pb_id :: PhyloBranchId
- , _pb_peak :: Text
- , _pb_metrics :: Map Text [Double]
- } deriving (Generic, Show)
-
-data PhyloEdge = PhyloEdge
- { _pe_source :: PhyloGroupId
- , _pe_target :: PhyloGroupId
- , _pe_type :: EdgeType
- , _pe_weight :: Weight
- } deriving (Generic, Show)
-
-data PhyloNode = PhyloNode
- { _pn_id :: PhyloGroupId
- , _pn_bid :: Maybe PhyloBranchId
- , _pn_label :: Text
- , _pn_idx :: [Int]
- , _pn_ngrams :: Maybe [Ngrams]
- , _pn_metrics :: Map Text [Double]
- , _pn_cooc :: Map (Int,Int) Double
- , _pn_parents :: Maybe [PhyloGroupId]
- , _pn_childs :: [PhyloNode]
- } deriving (Generic, Show)
+data Clustering = Clustering
+ { _clustering_roots :: [Int]
+ , _clustering_support :: Support
+ , _clustering_period :: Period
+ -- additional materials for visualization
+ , _clustering_visWeighting :: Maybe Double
+ , _clustering_visFiltering :: [Int]
+ } deriving (Generic,NFData,Show,Eq)
+
+----------------
+-- | Export | --
+----------------
+
+type DotId = TextLazy.Text
+
+data EdgeType = GroupToGroup | GroupToGroupMemory | BranchToGroup | BranchToBranch | GroupToAncestor | PeriodToPeriod deriving (Show,Generic,Eq)
+
+data Filter = ByBranchSize { _branch_size :: Double } deriving (Show,Generic,Eq)
+instance ToSchema Filter where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-------------------------
--- | PhyloQueryView | --
-------------------------
+data Order = Asc | Desc deriving (Show,Generic,Eq, ToSchema)
-data ExportMode = Json | Dot | Svg
- deriving (Generic, Show, Read)
-data DisplayMode = Flat | Nested
- deriving (Generic, Show, Read)
+data Sort = ByBirthDate { _sort_order :: Order } | ByHierarchy {_sort_order :: Order } deriving (Show,Generic,Eq)
+instance ToSchema Sort where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_sort_")
--- | A PhyloQueryView describes a Phylo as an output view
-data PhyloQueryView = PhyloQueryView
- { _qv_lvl :: Level
- -- Does the PhyloGraph contain ascendant, descendant or a complete Filiation ? Complet redondant et merge (avec le max)
- , _qv_filiation :: Filiation
+data Tagger = MostInclusive | MostEmergentInclusive | MostEmergentTfIdf deriving (Show,Generic,Eq)
+instance ToSchema Tagger where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
- -- Does the PhyloGraph contain some levelChilds ? How deep must it go ?
- , _qv_levelChilds :: Bool
- , _qv_levelChildsDepth :: Level
- -- Ordered lists of filters, taggers and metrics to be applied to the PhyloGraph
- -- Firstly the metrics, then the filters and the taggers
- , _qv_metrics :: [Metric]
- , _qv_filters :: [Filter]
- , _qv_taggers :: [Tagger]
+data PhyloLabel =
+ BranchLabel
+ { _branch_labelTagger :: Tagger
+ , _branch_labelSize :: Int }
+ | GroupLabel
+ { _group_labelTagger :: Tagger
+ , _group_labelSize :: Int }
+ deriving (Show,Generic,Eq)
- -- An asc or desc sort to apply to the PhyloGraph
- , _qv_sort :: Maybe (Sort,Order)
+instance ToSchema PhyloLabel where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
- -- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]]
- , _qv_export :: ExportMode
- , _qv_display :: DisplayMode
- , _qv_verbose :: Bool
- }
+
+data PhyloBranch =
+ PhyloBranch
+ { _branch_id :: PhyloBranchId
+ , _branch_canonId :: [Int]
+ , _branch_seaLevel :: [Double]
+ , _branch_x :: Double
+ , _branch_y :: Double
+ , _branch_w :: Double
+ , _branch_t :: Double
+ , _branch_label :: Text
+ , _branch_meta :: Map Text [Double]
+ } deriving (Generic, Show, Eq)
+
+instance ToSchema PhyloBranch where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_branch_")
+
+data PhyloExport =
+ PhyloExport
+ { _export_groups :: [PhyloGroup]
+ , _export_branches :: [PhyloBranch]
+ } deriving (Generic, Show)
+instance ToSchema PhyloExport where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_export_")
----------------
-- | Lenses | --
----------------
-
-makeLenses ''PhyloParam
-makeLenses ''Software
---
-makeLenses ''Phylo
-makeLenses ''PhyloFoundations
-makeLenses ''PhyloGroup
-makeLenses ''PhyloLevel
-makeLenses ''PhyloPeriod
-makeLenses ''PhyloFis
---
+makeLenses ''PhyloConfig
+makeLenses ''PhyloSubConfig
makeLenses ''Proximity
+makeLenses ''SeaElevation
+makeLenses ''Quality
makeLenses ''Cluster
-makeLenses ''Filter
---
-makeLenses ''PhyloQueryBuild
-makeLenses ''PhyloQueryView
---
-makeLenses ''PhyloView
+makeLenses ''PhyloLabel
+makeLenses ''TimeUnit
+makeLenses ''PhyloFoundations
+makeLenses ''Clustering
+makeLenses ''Phylo
+makeLenses ''PhyloPeriod
+makeLenses ''PhyloScale
+makeLenses ''PhyloGroup
+makeLenses ''PhyloParam
+makeLenses ''PhyloExport
makeLenses ''PhyloBranch
-makeLenses ''PhyloNode
-makeLenses ''PhyloEdge
-
------------------------
-- | JSON instances | --
------------------------
+instance FromJSON Phylo
+instance ToJSON Phylo
-$(deriveJSON (unPrefix "_phylo_" ) ''Phylo )
-$(deriveJSON (unPrefix "_phylo_foundations" ) ''PhyloFoundations )
-$(deriveJSON (unPrefix "_phylo_period" ) ''PhyloPeriod )
-$(deriveJSON (unPrefix "_phylo_level" ) ''PhyloLevel )
-$(deriveJSON (unPrefix "_phylo_group" ) ''PhyloGroup )
-$(deriveJSON (unPrefix "_phyloFis_" ) ''PhyloFis )
---
-$(deriveJSON (unPrefix "_software_" ) ''Software )
-$(deriveJSON (unPrefix "_phyloParam_" ) ''PhyloParam )
---
-$(deriveJSON defaultOptions ''Filter )
-$(deriveJSON defaultOptions ''Metric )
-$(deriveJSON defaultOptions ''Cluster )
-$(deriveJSON defaultOptions ''Proximity )
---
-$(deriveJSON (unPrefix "_fis_" ) ''FisParams )
-$(deriveJSON (unPrefix "_hamming_" ) ''HammingParams )
-$(deriveJSON (unPrefix "_louvain_" ) ''LouvainParams )
-$(deriveJSON (unPrefix "_rc_" ) ''RCParams )
-$(deriveJSON (unPrefix "_wlj_" ) ''WLJParams )
---
-$(deriveJSON (unPrefix "_lb_" ) ''LBParams )
-$(deriveJSON (unPrefix "_sb_" ) ''SBParams )
---
-$(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 )
+instance FromJSON PhyloSources
+instance ToJSON PhyloSources
----------------------------
--- | Swagger instances | --
----------------------------
+instance FromJSON PhyloParam
+instance ToJSON PhyloParam
-instance ToSchema Phylo where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_")
-instance ToSchema PhyloFoundations where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_foundations")
-instance ToSchema PhyloPeriod where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_period")
-instance ToSchema PhyloLevel where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_level")
-instance ToSchema PhyloGroup where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phylo_group")
-instance ToSchema PhyloFis where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phyloFis_")
-instance ToSchema Software where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_software_")
-instance ToSchema PhyloParam where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_phyloParam_")
-instance ToSchema Filter
-instance ToSchema Metric
-instance ToSchema Cluster
-instance ToSchema Proximity where
- declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
-instance ToSchema FisParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fis_")
-instance ToSchema HammingParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hamming_")
-instance ToSchema LouvainParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_louvain_")
-instance ToSchema RCParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_rc_")
-instance ToSchema WLJParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wlj_")
-instance ToSchema LBParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lb_")
-instance ToSchema SBParams where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_sb_")
-instance ToSchema PhyloQueryBuild where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_q_")
-instance ToSchema PhyloView where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pv_")
-instance ToSchema PhyloBranch where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pb_")
-instance ToSchema PhyloEdge where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pe_")
-instance ToSchema PhyloNode where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_pn_")
-instance ToSchema Filiation
-instance ToSchema EdgeType
-
-----------------------------
--- | TODO XML instances | --
-----------------------------
+instance FromJSON PhyloPeriod
+instance ToJSON PhyloPeriod
+
+instance FromJSON PhyloScale
+instance ToJSON PhyloScale
+
+instance FromJSON Software
+instance ToJSON Software
+
+instance FromJSON PhyloGroup
+instance ToJSON PhyloGroup
+$(deriveJSON (unPrefix "_foundations_" ) ''PhyloFoundations)