[FIX] Score by Doc or Corpus.
[gargantext.git] / src / Gargantext / Viz / Phylo.hs
index 453ecab03fad324c08a2ede15bc3d208d396bda4..89936e5565a558eb667f0cf4c5b8283642987f52 100644 (file)
@@ -15,7 +15,7 @@ granularity of group of ngrams (terms and multi-terms).
 The main type is Phylo which is synonym of Phylomemy (only difference is
 the number of chars).
 
-References: 
+References:
 Chavalarias, D., Cointet, J.-P., 2013. Phylomemetic patterns
 in science evolution — the rise and fall of scientific fields. PloS
 one 8, e54847.
@@ -29,6 +29,7 @@ one 8, e54847.
 
 module Gargantext.Viz.Phylo where
 
+import Prelude (Bounded)
 import Control.Lens (makeLenses)
 import Data.Aeson.TH (deriveJSON,defaultOptions)
 import Data.Maybe   (Maybe)
@@ -36,36 +37,36 @@ import Data.Text    (Text)
 import Data.Set     (Set)
 import Data.Map     (Map)
 import Data.Vector  (Vector)
-import Data.Time.Clock.POSIX  (POSIXTime)
+--import Data.Time.Clock.POSIX  (POSIXTime)
 import GHC.Generics (Generic)
-import Gargantext.Database.Schema.Ngrams (NgramsId)
+--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)
+--------------------
+-- | PhyloParam | --
+--------------------
+
 
--- | .phylo parameters
-data PhyloParam = 
-     PhyloParam { _phyloParam_version     :: Text -- Double ?
-                , _phyloParam_software    :: Software
-                , _phyloParam_params      :: Hash
-                , _phyloParam_query       :: Maybe PhyloQuery
-     } deriving (Generic, Show)
+-- | Global parameters of a Phylo
+data PhyloParam =
+     PhyloParam { _phyloParam_version  :: Text -- Double ?
+                , _phyloParam_software :: Software
+                , _phyloParam_query    :: PhyloQueryBuild
+     } deriving (Generic, Show, Eq)
 
-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)
+     } deriving (Generic, Show, Eq)
+
+
+---------------
+-- | Phylo | --
+---------------
 
-------------------------------------------------------------------------
 
 -- | Phylo datatype of a phylomemy
 -- Duration    : time Segment of the whole Phylo
@@ -74,9 +75,22 @@ data Software =
 data Phylo =
      Phylo { _phylo_duration    :: (Start, End)
            , _phylo_foundations :: Vector Ngrams
+           , _phylo_foundationsPeaks :: PhyloPeaks
            , _phylo_periods     :: [PhyloPeriod]
+           , _phylo_param       :: PhyloParam
            }
-           deriving (Generic, Show)
+           deriving (Generic, Show, Eq)
+
+-- | The PhyloPeaks describe the aggregation of some foundations Ngrams behind a list of Ngrams trees (ie: a forest)
+-- PeaksLabels are the root labels of each Ngrams trees
+data PhyloPeaks =
+      PhyloPeaks { _phylo_peaksLabels :: Vector Ngrams
+                 , _phylo_peaksForest :: [Tree Ngrams]
+                 }
+                 deriving (Generic, Show, Eq)
+
+-- | A Tree of Ngrams where each node is a label
+data Tree a = Empty | Node a [Tree a] deriving (Generic, Show, Eq)
 
 
 -- | Date : a simple Integer
@@ -88,14 +102,25 @@ 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
 data PhyloPeriod =
      PhyloPeriod { _phylo_periodId     :: PhyloPeriodId
                  , _phylo_periodLevels :: [PhyloLevel]
-                 } 
-                 deriving (Generic, Show)
+                 }
+                 deriving (Generic, Show, Eq)
+
+
+--------------------
+-- | PhyloLevel | --
+--------------------
 
 
 -- | PhyloLevel : levels of phylomemy on level axis
@@ -108,13 +133,18 @@ data PhyloLevel =
      PhyloLevel { _phylo_levelId     :: PhyloLevelId
                 , _phylo_levelGroups :: [PhyloGroup]
                 }
-                deriving (Generic, Show)
+                deriving (Generic, Show, Eq)
+
+
+--------------------
+-- | 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
--- Quality : map of measures (support, etc.) that depict some qualitative aspects of a phylo 
+-- 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 ?)
@@ -125,18 +155,18 @@ data PhyloGroup =
                 , _phylo_groupMeta          :: Map Text Double
                 , _phylo_groupCooc          :: Map (Int, Int) Double
                 , _phylo_groupBranchId      :: Maybe PhyloBranchId
-                
+
                 , _phylo_groupPeriodParents :: [Pointer]
                 , _phylo_groupPeriodChilds  :: [Pointer]
-                
+
                 , _phylo_groupLevelParents  :: [Pointer]
                 , _phylo_groupLevelChilds   :: [Pointer]
                 }
-                deriving (Generic, Show, Eq, Ord)             
+                deriving (Generic, Show, Eq, Ord)
 
 
--- | Level : A level of aggregation (-1 = Txt, 0 = Ngrams, 1 = Fis, [2..] = Cluster)  
-type Level = Int 
+-- | 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
 
@@ -155,25 +185,29 @@ type Pointer = (PhyloGroupId, Weight)
 type Ngrams = Text
 
 
+--------------------
 -- | Aggregates | --
+--------------------
 
 
 -- | Document : a piece of Text linked to a Date
 data Document = Document
       { date :: Date
-      , text :: Text
+      , text :: [Ngrams]
       } deriving (Show)
 
-
 -- | 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) 
-type PhyloFis = (Clique,Support)
-
+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_metrics :: Map (Int,Int) (Map Text [Double])
+  } deriving (Show)
 
--- | A list of clustered PhyloGroup 
+-- | A list of clustered PhyloGroup
 type PhyloCluster = [PhyloGroup]
 
 
@@ -189,178 +223,200 @@ type GroupGraph = (GroupNodes,GroupEdges)
 -- | Error | --
 ---------------
 
+
 data PhyloError = LevelDoesNotExist
                 | LevelUnassigned
-          deriving (Show)               
+          deriving (Show)
+
 
 -----------------
 -- | Cluster | --
 -----------------
 
+
 -- | Cluster constructors
-data Cluster = Fis FisParams 
+data Cluster = Fis FisParams
              | RelatedComponents RCParams
              | Louvain LouvainParams
-        deriving (Show)
+        deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for Fis clustering
 data FisParams = FisParams
-  { _fis_filtered     :: Bool
-  , _fis_keepMinorFis :: Bool
-  , _fis_minSupport   :: Support 
-  } deriving (Show)
+  { _fis_keepMinorFis :: Bool
+  , _fis_minSupport   :: Support
+  } deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for RelatedComponents clustering
 data RCParams = RCParams
-  { _rc_proximity :: Proximity } deriving (Show)
+  { _rc_proximity :: Proximity } deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for Louvain clustering
 data LouvainParams = LouvainParams
-  { _louvain_proximity :: Proximity } deriving (Show)
+  { _louvain_proximity :: Proximity } deriving (Generic, Show, Eq, Read)
+
 
 -------------------
 -- | Proximity | --
 -------------------
 
+
 -- | Proximity constructors
 data Proximity = WeightedLogJaccard WLJParams
                | Hamming HammingParams
                | Filiation
-          deriving (Show)
+          deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for WeightedLogJaccard proximity
-data WLJParams = WLJParams 
+data WLJParams = WLJParams
   { _wlj_threshold   :: Double
   , _wlj_sensibility :: Double
-  } deriving (Show)
+  } deriving (Generic, Show, Eq, Read)
 
 -- | Parameters for Hamming proximity
-data HammingParams = HammingParams 
-  { _hamming_threshold :: Double } deriving (Show)
+data HammingParams = HammingParams
+  { _hamming_threshold :: Double } deriving (Generic, Show, Eq, Read)
+
 
 ----------------
 -- | Filter | --
 ----------------
 
+
 -- | Filter constructors
-data Filter = LonelyBranch LBParams deriving (Show)
+data Filter = SmallBranch SBParams deriving (Generic, Show, Eq)
+
+-- | Parameters for SmallBranch filter
+data SBParams = SBParams
+  { _sb_periodsInf :: Int
+  , _sb_periodsSup :: Int
+  , _sb_minNodes   :: Int } deriving (Generic, Show, Eq)
 
--- | Parameters for LonelyBranch filter
-data LBParams = LBParams
-  { _lb_periodsInf :: Int 
-  , _lb_periodsSup :: Int
-  , _lb_minNodes   :: Int } deriving (Show) 
 
 ----------------
--- | Metric | -- 
+-- | Metric | --
 ----------------
 
+
 -- | Metric constructors
-data Metric = BranchAge deriving (Show)
+data Metric = BranchAge deriving (Generic, Show, Eq, Read)
+
 
 ----------------
 -- | Tagger | --
 ----------------
 
+
 -- | Tagger constructors
-data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
+data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics
+  deriving (Generic, Show, Read)
+
 
 --------------
 -- | Sort | --
 --------------
 
+
 -- | Sort constructors
-data Sort  = ByBranchAge deriving (Show)
-data Order = Asc | Desc deriving (Show)
+data Sort  = ByBranchAge deriving (Generic, Show, Read, Enum, Bounded)
+data Order = Asc | Desc  deriving (Generic, Show, Read)
+
 
 --------------------
 -- | PhyloQuery | --
 --------------------
 
--- | A Phyloquery describes a phylomemic reconstruction 
-data PhyloQuery = PhyloQuery 
-    { _q_phyloName :: Text
-    , _q_phyloDesc :: Text
 
-    -- Grain and Steps for the PhyloPeriods 
+-- | A Phyloquery describes a phylomemic reconstruction
+data PhyloQueryBuild = PhyloQueryBuild
+    { _q_phyloTitle :: Text
+    , _q_phyloDesc  :: Text
+
+    -- Grain and Steps for the PhyloPeriods
     , _q_periodGrain :: Int
     , _q_periodSteps :: Int
-    
-    -- Clustering method for making level 1 of the Phylo
-    , _q_cluster :: Cluster
-    
+
+    -- Clustering method for building the contextual unit of Phylo (ie: level 1)
+    , _q_contextualUnit :: Cluster
+    , _q_contextualUnitMetrics :: [Metric]
+    , _q_contextualUnitFilters :: [Filter]
+
     -- Inter-temporal matching method of the Phylo
     , _q_interTemporalMatching :: Proximity
-    
-    -- Last level of reconstruction  
+
+    -- Last level of reconstruction
     , _q_nthLevel   :: Level
     -- Clustering method used from level 1 to nthLevel
     , _q_nthCluster :: Cluster
-    } deriving (Show)
+    } deriving (Generic, Show, Eq)
 
-data Filiation = Ascendant | Descendant | Complete deriving (Show)
-data EdgeType  = PeriodEdge | LevelEdge deriving (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)
 
 -------------------
 -- | PhyloView | --
 -------------------
 
+
 -- | A PhyloView is the output type of a Phylo
 data PhyloView = PhyloView
-  { _phylo_viewParam       :: PhyloParam
-  , _phylo_viewLabel       :: Text
-  , _phylo_viewDescription :: Text
-  , _phylo_viewFiliation   :: Filiation
-  , _phylo_viewMeta        :: Map Text Double
-  , _phylo_viewBranches    :: [PhyloBranch]
-  , _phylo_viewNodes       :: [PhyloNode]
-  , _phylo_viewEdges       :: [PhyloEdge]
-  } deriving (Show)
+  { _pv_param       :: PhyloParam
+  , _pv_title       :: Text
+  , _pv_description :: Text
+  , _pv_filiation   :: Filiation
+  , _pv_metrics     :: Map Text [Double]
+  , _pv_branches    :: [PhyloBranch]
+  , _pv_nodes       :: [PhyloNode]
+  , _pv_edges       :: [PhyloEdge]
+  } deriving (Generic, Show)
 
 -- | A phyloview is made of PhyloBranches, edges and nodes
-data PhyloBranch = PhyloBranch 
-  { _phylo_branchId    :: PhyloBranchId
-  , _phylo_branchLabel :: Text
-  , _phylo_branchMeta  :: Map Text Double
-  } deriving (Show)  
+data PhyloBranch = PhyloBranch
+  { _pb_id      :: PhyloBranchId
+  , _pb_label   :: Text
+  , _pb_metrics :: Map Text [Double]
+  } deriving (Generic, Show)
 
 data PhyloEdge = PhyloEdge
-  { _phylo_edgeSource :: PhyloGroupId
-  , _phylo_edgeTarget :: PhyloGroupId
-  , _phylo_edgeType   :: EdgeType
-  , _phylo_edgeWeight :: Weight
-  } deriving (Show)
+  { _pe_source :: PhyloGroupId
+  , _pe_target :: PhyloGroupId
+  , _pe_type   :: EdgeType
+  , _pe_weight :: Weight
+  } deriving (Generic, Show)
 
 data PhyloNode = PhyloNode
-  { _phylo_nodeId        :: PhyloGroupId
-  , _phylo_nodeBranchId  :: Maybe PhyloBranchId
-  , _phylo_nodeLabel     :: Text
-  , _phylo_nodeNgramsIdx :: [Int] 
-  , _phylo_nodeNgrams    :: Maybe [Ngrams]
-  , _phylo_nodeMeta      :: Map Text Double
-  , _phylo_nodeParent    :: Maybe PhyloGroupId 
-  , _phylo_nodeChilds    :: [PhyloNode]
-  } deriving (Show)
+  { _pn_id        :: PhyloGroupId
+  , _pn_bid  :: Maybe PhyloBranchId
+  , _pn_label     :: Text
+  , _pn_idx :: [Int]
+  , _pn_ngrams    :: Maybe [Ngrams]
+  , _pn_metrics      :: Map Text [Double]
+  , _pn_parents :: Maybe [PhyloGroupId]
+  , _pn_childs  :: [PhyloNode]
+  } deriving (Generic, Show)
+
 
 ------------------------
 -- | PhyloQueryView | --
 ------------------------
 
-data DisplayMode = Flat | Nested 
+
+data DisplayMode = Flat | Nested
+  deriving (Generic, Show, Read)
 
 -- | A PhyloQueryView describes a Phylo as an output view
-data PhyloQueryView = PhyloQueryView 
+data PhyloQueryView = PhyloQueryView
   { _qv_lvl    :: Level
 
-  -- Does the PhyloGraph contain ascendant, descendant or a complete Filiation ?
+  -- Does the PhyloGraph contain ascendant, descendant or a complete Filiation ? Complet redondant et merge (avec le max)
   , _qv_filiation :: Filiation
 
   -- Does the PhyloGraph contain some levelChilds ? How deep must it go ?
-  , _qv_childs      :: Bool
-  , _qv_childsDepth :: Level
+  , _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   
+  -- Firstly the metrics, then the filters and the taggers
   , _qv_metrics :: [Metric]
   , _qv_filters :: [Filter]
   , _qv_taggers :: [Tagger]
@@ -368,29 +424,32 @@ data PhyloQueryView = PhyloQueryView
   -- An asc or desc sort to apply to the PhyloGraph
   , _qv_sort :: Maybe (Sort,Order)
 
-  -- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]] 
+  -- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]]
   , _qv_display :: DisplayMode
   , _qv_verbose :: Bool
   }
 
+
 ----------------
 -- | Lenses | --
 ----------------
 
+
 makeLenses ''PhyloParam
-makeLenses ''PhyloExport
 makeLenses ''Software
 --
 makeLenses ''Phylo
+makeLenses ''PhyloPeaks
 makeLenses ''PhyloGroup
 makeLenses ''PhyloLevel
 makeLenses ''PhyloPeriod
--- 
+makeLenses ''PhyloFis
+--
 makeLenses ''Proximity
 makeLenses ''Cluster
 makeLenses ''Filter
--- 
-makeLenses ''PhyloQuery
+--
+makeLenses ''PhyloQueryBuild
 makeLenses ''PhyloQueryView
 --
 makeLenses ''PhyloView
@@ -398,19 +457,25 @@ makeLenses ''PhyloBranch
 makeLenses ''PhyloNode
 makeLenses ''PhyloEdge
 
+
 ------------------------
 -- | JSON instances | --
------------------------- 
+------------------------
 
-$(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       ) 
+
+$(deriveJSON (unPrefix "_phylo_"       ) ''Phylo       )
+$(deriveJSON (unPrefix "_phylo_peaks"  ) ''PhyloPeaks  )
+$(deriveJSON defaultOptions ''Tree  )
 $(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 (unPrefix "_phyloExport_" ) ''PhyloExport )
 --
+$(deriveJSON defaultOptions ''Filter    )
+$(deriveJSON defaultOptions ''Metric    )
 $(deriveJSON defaultOptions ''Cluster   )
 $(deriveJSON defaultOptions ''Proximity )
 --
@@ -419,8 +484,17 @@ $(deriveJSON (unPrefix "_hamming_" ) ''HammingParams )
 $(deriveJSON (unPrefix "_louvain_" ) ''LouvainParams )
 $(deriveJSON (unPrefix "_rc_" )      ''RCParams      )
 $(deriveJSON (unPrefix "_wlj_" )     ''WLJParams     )
+$(deriveJSON (unPrefix "_sb_" )      ''SBParams      )
 --
-$(deriveJSON (unPrefix "_q_" ) ''PhyloQuery )
+$(deriveJSON (unPrefix "_q_" )  ''PhyloQueryBuild  )
+$(deriveJSON (unPrefix "_pv_" ) ''PhyloView   )
+$(deriveJSON (unPrefix "_pb_" ) ''PhyloBranch )
+$(deriveJSON (unPrefix "_pe_" ) ''PhyloEdge   )
+$(deriveJSON (unPrefix "_pn_" ) ''PhyloNode   )
+
+$(deriveJSON defaultOptions ''Filiation )
+$(deriveJSON defaultOptions ''EdgeType  )
+
 
 ----------------------------
 -- | TODO XML instances | --