2 Module : Gargantext.Viz.Phylo.Example
3 Description : Phylomemy example based on history of Cleopatre.
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
10 -- | Cesar et Cleôpatre
11 -- Exemple de phylomemie
12 -- French without accents
16 - split the functions : RAW -> Document -> Ngrams
18 -- reverse history: antechronologique
24 {-# LANGUAGE NoImplicitPrelude #-}
25 {-# LANGUAGE FlexibleContexts #-}
26 {-# LANGUAGE OverloadedStrings #-}
28 module Gargantext.Viz.Phylo.Example where
30 import Control.Lens hiding (both)
31 import qualified Data.List as List
32 import Data.Text (Text, unwords, toLower, words)
33 import Data.Tuple.Extra
34 import Data.Semigroup (Semigroup)
36 import qualified Data.Map as Map
37 import qualified Data.Vector as Vector
38 import qualified Data.Maybe as Maybe
39 import qualified Data.Tuple as Tuple
42 import qualified Data.Set as DS
43 import qualified Data.Matrix as DM'
45 import Gargantext.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, Size(..))
46 import Gargantext.Text.Terms.Mono (monoTexts)
47 import Gargantext.Prelude
48 import Gargantext.Viz.Phylo
50 ------------------------------------------------------------------------
54 -- | Date : a simple Integer
56 -- | Document : a piece of Text linked to a Date
57 data Document = Document
61 -- | Corpus : a list of Documents
62 type Corpus = [Document]
65 type MapList = [Ngrams]
66 type PeriodeSize = Int
67 -- data Periodes b a = Map (b,b) a
68 type Occurrences = Int
70 --------------------------------------------------------------------
72 data PhyloError = LevelDoesNotExist
78 data PhyloField = PhyloField {
82 --------------------------------------------------------------------
83 phyloExampleFinal :: Phylo
84 phyloExampleFinal = undefined
86 --------------------------------------------------------------------
87 appariement :: Map (Date, Date) (Map (Set Ngrams) Int)
88 appariement = undefined
90 --------------------------------------------------------------------
94 fisToFields = undefined
96 phyloClusters :: Map (Date,Date) [PhyloField]
97 phyloClusters = undefined
99 ------------------------------------------------------------------------
100 -- | STEP 8 | -- Incrementaly cluster the PhyloGroups n times, link them through the Periods and build level n of the Phylo
103 ------------------------------------------------------------------------
104 -- | STEP 7 | -- Link the PhyloGroups of level 1 through the Periods
107 ------------------------------------------------------------------------
108 -- | STEP 6 | -- Cluster the Fis and buil level 1 of the Phylo
111 ------------------------------------------------------------------------
112 -- | STEP 5 | -- Find the Fis out of Documents and Ngrams and build level 1 of the Phylo
115 phyloFis :: Map (Date, Date) Fis
116 phyloFis = termsToFis phyloTerms
118 termsToFis :: Map (Date, Date) [Document]
119 -> Map (Date, Date) Fis
120 termsToFis = corpusToFis (words . text)
122 -- | TODO: parameters has to be checked
123 -- | TODO FIS on monotexts
124 corpusToFis :: (Document -> [Ngrams])
125 -> Map (Date, Date) [Document]
126 -> Map (Date, Date) (Map (Set Ngrams) Int)
127 corpusToFis f = Map.map (\d -> fisWithSizePolyMap (Segment 1 20) 1 (map f d))
130 ------------------------------------------------------------------------
131 -- | STEP 4 | -- Build level -1 and 0 of the Phylo
132 addPointer :: Semigroup field
133 => ASetter source target identity (field -> field)
134 -> field -> source -> target
135 addPointer field targetPointer source =
136 set field (<> targetPointer) source
138 alterLvl :: PhyloGroup -> PhyloGroup
139 alterLvl g = g {_phylo_groupId = ((Tuple.fst $ Tuple.fst $ _phylo_groupId g, 0), Tuple.snd $ _phylo_groupId g)}
141 alterLvl' :: PhyloGroup -> PhyloGroup
142 alterLvl' (PhyloGroup ((dates, _lvl), ix) gLabel gNgrams gPeriodParents gPeriodChilds gLevelParent gLevelChilds)
143 = PhyloGroup gId' gLabel gNgrams' gPeriodParents gPeriodChilds gLevelParent gLevelChilds
145 gId' = ((dates, 0), ix)
148 -- | for the moment level 0 is just a copy of level -1
149 --level0PhyloGroups :: [PhyloGroup]
150 --level0PhyloGroups = map alterLvl initPhyloGroups
152 findIdx :: Ngrams -> Int
153 findIdx n = case (Vector.elemIndex n phyloNgrams) of
154 Nothing -> panic "PhyloError"
157 ngramsToGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> PhyloGroup
158 ngramsToGroup terms label idx lvl from to = PhyloGroup (((from, to), lvl), idx) label (map (\x -> findIdx x) terms) [] [] [] []
160 docsToGroups :: (Date, Date) -> Corpus -> [PhyloGroup]
161 docsToGroups k v = map (\x ->
162 ngramsToGroup [Tuple.snd x] (Tuple.snd x) (Tuple.fst x) (-1) (Tuple.fst k) (Tuple.snd k)
163 ) $ zip [1..] $ (List.nub . List.concat) $ map (words . text) v
165 data Levels = Level_m1 | Level_0 | Level_1 | Level_2 | Level_N
166 deriving (Show, Eq, Enum, Bounded)
168 toPhyloGroups :: Levels -> Map (Date,Date) Corpus -> [PhyloGroup]
169 toPhyloGroups lvl corpus = case lvl of
170 Level_m1 -> List.concat $ Map.elems $ Map.mapWithKey docsToGroups corpus
171 _ -> panic ("error phylo to be defined")
175 initPhyloGroups :: [PhyloGroup]
176 initPhyloGroups = toPhyloGroups Level_m1 phyloTerms
179 ------------------------------------------------------------------------
180 -- | STEP 3 | -- Split the Corpus into Periods and reduce each Document as a list of Ngrams
183 phyloTerms :: Map (Date, Date) [Document]
184 phyloTerms = toPeriodes date 5 3 $ cleanCorpus cleanedActants phyloCorpus
186 toPeriodes :: (Ord date, Enum date) => (doc -> date)
187 -> Grain -> Step -> [doc] -> Map (date, date) [doc]
188 toPeriodes _ _ _ [] = panic "Empty corpus can not have any periods"
189 toPeriodes f g s es = Map.fromList $ zip hs $ map (inPeriode f es) hs
191 hs = steps g s $ both f (List.head es, List.last es)
192 --------------------------------------------------------------------
193 -- | Define overlapping periods of time by following regular steps
194 inPeriode :: Ord b => (t -> b) -> [t] -> (b, b) -> [t]
195 inPeriode f' h (start,end) =
196 fst $ List.partition (\d -> f' d >= start && f' d <= end) h
197 --------------------------------------------------------------------
198 -- | Find steps of linear and homogenous time of integer
199 steps :: (Eq date, Enum date) => Grain -> Step -> (date, date) -> [(date, date)]
200 steps s' o' (start,end) = map (\l -> (List.head l, List.last l))
201 $ chunkAlong s' o' [start .. end]
203 cleanCorpus :: MapList -> Corpus -> Corpus
204 cleanCorpus ml = map (\(Document d t) -> Document d (unwords $ filter (\x -> elem x ml) $ monoTexts t))
207 ------------------------------------------------------------------------
208 -- | STEP 2 | -- Find some Ngrams (ie: phyloGroup of level -1) out of the Corpus & init the phylo
211 -- phylo = Phylo (both date $ (List.last &&& List.head) phyloCorpus) (initPhyloNgrams cleanedActants) undefined
213 phyloNgrams :: PhyloNgrams
214 phyloNgrams = Vector.fromList cleanedActants
216 cleanedActants :: [Ngrams]
217 cleanedActants = map toLower actants
220 actants = [ "Cleopatre" , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV"
221 , "Marc-Antoine", "Cesar" , "Antoine" , "Octave" , "Rome"
222 , "Alexandrie" , "Auguste" , "Pompee" , "Cassius" , "Brutus"]
225 ------------------------------------------------------------------------
226 -- | STEP 1 | -- Get a corpus of Documents
229 phyloCorpus :: Corpus
230 phyloCorpus = map (\(d,t) -> Document d t) exampleDocuments
232 exampleDocuments :: [(Date, Text)]
233 exampleDocuments = 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")]