src/Gargantext/Viz/Phylo/Example.hs

   1 {-|
   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
   8 Portability : POSIX
   9
  10 -- | Cesar et Cleôpatre
  11 -- Exemple de phylomemie
  12 -- French without accents
  13
  14
  15 TODO:
  16 - split the functions : RAW -> Document -> Ngrams
  17
  18 -- reverse history: antechronologique
  19 -- metrics support
  20
  21
  22 -}
  23
  24 {-# LANGUAGE NoImplicitPrelude #-}
  25 {-# LANGUAGE FlexibleContexts  #-}
  26 {-# LANGUAGE OverloadedStrings #-}
  27
  28 module Gargantext.Viz.Phylo.Example where
  29
  30 import Control.Lens     hiding (makeLenses, both, Level)
  31
  32 import Data.Bool        (Bool, not)
  33 import Data.List        (concat, union, intersect, tails, tail, head, last, null, zip, sort, length, any, (++), (!!), nub, sortOn, reverse, splitAt, take)
  34 import Data.Map         (Map, elems, member, adjust, singleton, empty, (!), keys, restrictKeys, mapWithKey, filterWithKey)
  35 import Data.Semigroup   (Semigroup)
  36 import Data.Set         (Set)
  37 import Data.Text        (Text, unwords, toLower, words)
  38 import Data.Tuple       (fst, snd)
  39 import Data.Tuple.Extra
  40 import Data.Vector      (Vector, fromList, elemIndex)
  41
  42 import Gargantext.Prelude                      hiding (head)
  43 import Gargantext.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, Size(..))
  44 import Gargantext.Text.Terms.Mono              (monoTexts)
  45 import Gargantext.Viz.Phylo
  46 import Gargantext.Viz.Phylo.Tools
  47
  48 import qualified Data.Bool   as Bool
  49 import qualified Data.List   as List
  50 import qualified Data.Map    as Map
  51 import qualified Data.Maybe  as Maybe
  52 import qualified Data.Set    as Set
  53 import qualified Data.Tuple  as Tuple
  54 import qualified Data.Vector as Vector
  55
  56
  57 ------------------------------------------------------------------------
  58 -- | STEP 13 | -- Incrementaly cluster the PhyloGroups n times, link them through the Periods and build level n of the Phylo
  59
  60
  61 ------------------------------------------------------------------------
  62 -- | STEP 12 | -- Cluster the Fis
  63
  64
  65 ------------------------------------------------------------------------
  66 -- | STEP 11 | -- Link the PhyloGroups of level 1 through the Periods
  67
  68
  69 -- | To process the weightedLogJaccard between two PhyloGroups
  70 weightedLogJaccard :: PhyloGroup -> PhyloGroup -> (PhyloGroupId, Double)
  71 weightedLogJaccard group group' = (getGroupId group', 1)
  72
  73
  74 -- | To apply the corresponding proximity function based on a given Proximity
  75 getProximity :: Proximity -> PhyloGroup -> PhyloGroup -> (PhyloGroupId, Double)
  76 getProximity p group group' = case p of
  77   WeightedLogJaccard -> weightedLogJaccard group group'
  78   Other              -> undefined
  79   _                  -> panic ("[ERR][Viz.Phylo.Example.getProximity] Proximity function not defined")
  80
  81
  82 -- | To get the next or previous PhyloPeriod based on a given PhyloPeriodId
  83 getNextPeriods :: PairTo -> PhyloPeriodId -> [PhyloPeriodId] -> [PhyloPeriodId]
  84 getNextPeriods to id l = case to of
  85     Childs  -> unNested id ((tail . snd) next)
  86     Parents -> unNested id ((reverse . fst) next)
  87     _       -> panic ("[ERR][Viz.Phylo.Example.getNextPeriods] PairTo type not defined")
  88     where
  89       --------------------------------------
  90       next :: ([PhyloPeriodId], [PhyloPeriodId])
  91       next = splitAt idx l
  92       --------------------------------------
  93       idx :: Int
  94       idx = case (List.elemIndex id l) of
  95         Nothing -> panic ("[ERR][Viz.Phylo.Example.getNextPeriods] PhyloPeriodId not defined")
  96         Just i  -> i
  97       --------------------------------------
  98       -- | To have an non-overlapping next period
  99       unNested :: PhyloPeriodId -> [PhyloPeriodId] -> [PhyloPeriodId]
 100       unNested x l
 101         | null l                  = []
 102         | nested (fst $ head l) x = unNested x (tail l)
 103         | nested (snd $ head l) x = unNested x (tail l)
 104         | otherwise               = l
 105       --------------------------------------
 106       nested :: Date -> PhyloPeriodId -> Bool
 107       nested d prd = d >= fst prd && d <= snd prd
 108       --------------------------------------
 109
 110
 111 -- | To find the best set (max = 2) of Childs/Parents candidates based on a given Proximity mesure until a maximum depth (max = Period + 5 units )
 112 findBestCandidates :: PairTo -> Int -> Int -> Double -> PhyloGroup -> Phylo -> [(PhyloGroupId, Double)]
 113 findBestCandidates to depth max thr group p
 114   | depth > max || (null . head) next = []
 115   | (not . null) best = take 2 best
 116   | otherwise = findBestCandidates to (depth + 1) max thr group p
 117   where
 118     --------------------------------------
 119     next :: [PhyloPeriodId]
 120     next = getNextPeriods to (getGroupPeriod group) (getPhyloPeriods p)
 121     --------------------------------------
 122     candidates :: [PhyloGroup]
 123     candidates = getGroupsWithFilters (getGroupLevel group) (head next) p
 124     --------------------------------------
 125     scores :: [(PhyloGroupId, Double)]
 126     scores = map (\group' -> getProximity WeightedLogJaccard group group') candidates
 127     --------------------------------------
 128     best :: [(PhyloGroupId, Double)]
 129     best = reverse
 130          $ sortOn snd
 131          $ filter (\(id,s) -> s >= thr) scores
 132     --------------------------------------
 133
 134
 135 -- | To add a new list of Pointers into an existing Childs/Parents list of Pointers
 136 makePair :: PairTo -> PhyloGroup -> [(PhyloGroupId, Double)] -> PhyloGroup
 137 makePair to group ids = case to of
 138     Childs  -> over (phylo_groupPeriodChilds) addPointers group
 139     Parents -> over (phylo_groupPeriodParents) addPointers group
 140     _       -> panic ("[ERR][Viz.Phylo.Example.makePair] PairTo type not defined")
 141     where
 142       --------------------------------------
 143       addPointers :: [Pointer] -> [Pointer]
 144       addPointers l = nub $ (l ++ ids)
 145       --------------------------------------
 146
 147
 148 -- | To pair all the Phylogroups of given PhyloLevel to their best Parents or Childs
 149 pairGroupsToGroups :: PairTo -> Level -> Double -> Phylo -> Phylo
 150 pairGroupsToGroups to lvl thr p = alterPhyloGroupsWith
 151                                     (\groups ->
 152                                       map (\group ->
 153                                             let
 154                                               --------------------------------------
 155                                               candidates :: [(PhyloGroupId, Double)]
 156                                               candidates = findBestCandidates to 1 5 thr group p
 157                                               --------------------------------------
 158                                             in
 159                                               makePair to group candidates ) groups)
 160                                     getGroupLevel (getLevelValue lvl) p
 161
 162
 163 phyloWithPair_1_Childs :: Phylo
 164 phyloWithPair_1_Childs = pairGroupsToGroups Childs (initLevel 1 Level_1) 0.5 phyloLinked_0_1
 165
 166
 167 phyloWithPair_1_Parents :: Phylo
 168 phyloWithPair_1_Parents = pairGroupsToGroups Parents (initLevel 1 Level_1) 0.5 phyloLinked_0_1
 169
 170
 171 ------------------------------------------------------------------------
 172 -- | STEP 10 | -- Build the coocurency Matrix of the Phylo
 173
 174
 175 -- | Are two PhyloGroups sharing at leats one Ngrams
 176 shareNgrams :: PhyloGroup -> PhyloGroup -> Bool
 177 shareNgrams g g' = (not . null) $ intersect (getGroupNgrams g) (getGroupNgrams g')
 178
 179
 180 -- | To get the good pair of keys (x,y) or (y,x) in a given Map (a,b) c
 181 getKeyPair :: (Int,Int) -> Map (Int,Int) a -> (Int,Int)
 182 getKeyPair (x,y) m = case findPair (x,y) m of
 183                       Nothing -> panic "[ERR][Viz.Phylo.Example.getKeyPair] Nothing"
 184                       Just i  -> i
 185                      where
 186                       --------------------------------------
 187                       findPair :: (Int,Int) -> Map (Int,Int) a -> Maybe (Int,Int)
 188                       findPair (x,y) m
 189                         | member (x,y) m = Just (x,y)
 190                         | member (y,x) m = Just (y,x)
 191                         | otherwise      = Nothing
 192                       --------------------------------------
 193
 194
 195 -- | To get all combinations of a list with no repetition and apply a function to the resulting list of pairs
 196 listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)]
 197 listToCombi f l = [ (f x, f y) | (x:rest) <- tails l,  y <- rest ]
 198
 199
 200 -- | To transform the Fis into a coocurency Matrix in a Phylo
 201 fisToCooc :: Map (Date, Date) Fis -> Phylo -> Map (Int, Int) Double
 202 fisToCooc m p = map   (/docs)
 203               $ foldl (\mem x -> adjust (+1) (getKeyPair x mem) mem) cooc
 204               $ concat
 205               $ map (\x -> listToCombi (\x -> ngramsToIdx x p) $ (Set.toList . fst) x) fis
 206   where
 207     --------------------------------------
 208     fis :: [(Clique,Support)]
 209     fis = concat $ map (\x -> Map.toList x) (elems m)
 210     --------------------------------------
 211     fisNgrams :: [Ngrams]
 212     fisNgrams = foldl (\mem x -> union mem $ (Set.toList . fst) x) [] fis
 213     --------------------------------------
 214     docs :: Double
 215     docs = fromIntegral $ foldl (\mem x -> mem + (snd x)) 0 fis
 216     --------------------------------------
 217     cooc :: Map (Int, Int) (Double)
 218     cooc = Map.fromList $ map (\x -> (x,0)) (listToCombi (\x -> ngramsToIdx x p) fisNgrams)
 219     --------------------------------------
 220
 221
 222 phyloCooc :: Map (Int, Int) Double
 223 phyloCooc = fisToCooc phyloFisFiltered phyloLinked_0_1
 224
 225
 226 ------------------------------------------------------------------------
 227 -- | STEP 9 | -- Build level 1 of the Phylo
 228
 229
 230 -- | To Cliques into Groups
 231 cliqueToGroup :: PhyloPeriodId -> Int -> Int -> Ngrams -> (Clique,Support) -> Map (Date, Date) Fis -> Phylo -> PhyloGroup
 232 cliqueToGroup period lvl idx label fis m p = PhyloGroup ((period, lvl), idx)
 233                                                     label
 234                                                     ngrams
 235                                                     (singleton "support" (fromIntegral $ snd fis))
 236                                                     cooc
 237                                                     [] [] [] []
 238   where
 239     --------------------------------------
 240     ngrams :: [Int]
 241     ngrams = sort $ map (\x -> ngramsToIdx x p)
 242                   $ Set.toList
 243                   $ fst fis
 244     --------------------------------------
 245     cooc :: Map (Int, Int) Double
 246     cooc =  filterWithKey (\k _ -> elem (fst k) ngrams && elem (snd k) ngrams)
 247                           $ fisToCooc (restrictKeys m $ Set.fromList [period]) p
 248     --------------------------------------
 249
 250
 251 -- | To transform Fis into PhyloLevels
 252 fisToPhyloLevel :: Map (Date, Date) Fis -> Phylo -> Phylo
 253 fisToPhyloLevel m p = over (phylo_periods . traverse)
 254                            (\period ->
 255                               let periodId = _phylo_periodId period
 256                                   fisList  = zip [1..] (Map.toList (m ! periodId))
 257                               in  over (phylo_periodLevels)
 258                                        (\levels ->
 259                                           let groups = map (\fis -> cliqueToGroup periodId 1 (fst fis) "" (snd fis) m p) fisList
 260                                           in  levels ++ [PhyloLevel (periodId, 1) groups]
 261                                        ) period ) p
 262
 263
 264 phyloLinked_0_1 :: Phylo
 265 phyloLinked_0_1 = alterLevelLinks lvl_0_1  phyloLinked_1_0
 266
 267
 268 lvl_0_1 :: LevelLink
 269 lvl_0_1 = initLevelLink (initLevel 0 Level_0) (initLevel 1 Level_1)
 270
 271
 272 phyloLinked_1_0 :: Phylo
 273 phyloLinked_1_0 = alterLevelLinks lvl_1_0  phyloWithGroups1
 274
 275
 276 lvl_1_0 :: LevelLink
 277 lvl_1_0 = initLevelLink (initLevel 1 Level_1) (initLevel 0 Level_0)
 278
 279
 280 phyloWithGroups1 :: Phylo
 281 phyloWithGroups1 = updatePhyloByLevel (initLevel 1 Level_1) phyloLinked_m1_0
 282
 283
 284 ------------------------------------------------------------------------
 285 -- | STEP 8 | -- Create Frequent Items Sets by Period and filter them
 286
 287
 288 -- | To Filter Fis by support
 289 filterFisBySupport :: Bool -> Int -> Map (Date, Date) Fis -> Map (Date, Date) Fis
 290 filterFisBySupport empty min m = case empty of
 291   True  -> Map.map (\fis -> filterMinorFis min fis) m
 292   False -> Map.map (\fis -> filterMinorFisNonEmpty min fis) m
 293
 294
 295 -- | To filter Fis with small Support, to preserve nonempty periods please use : filterFisBySupport False
 296 filterMinorFis :: Int -> Fis -> Fis
 297 filterMinorFis min fis = Map.filter (\s -> s > min) fis
 298
 299
 300 -- | To filter Fis with small Support but by keeping non empty Periods
 301 filterMinorFisNonEmpty :: Int -> Fis -> Fis
 302 filterMinorFisNonEmpty min fis = if (Map.null fis') && (not $ Map.null fis)
 303                                  then filterMinorFisNonEmpty (min - 1) fis
 304                                  else fis'
 305   where
 306     --------------------------------------
 307     fis' :: Fis
 308     fis' = filterMinorFis min fis
 309     --------------------------------------
 310
 311
 312 -- | To filter nested Fis
 313 filterFisByNested :: Map (Date, Date) Fis -> Map (Date, Date) Fis
 314 filterFisByNested = map (\fis -> restrictKeys fis
 315                               $ Set.fromList
 316                               $ filterNestedSets (head (keys fis)) (keys fis) []
 317                             )
 318
 319
 320 -- | To transform a list of Documents into a Frequent Items Set
 321 docsToFis :: Map (Date, Date) [Document] -> Map (Date, Date) Fis
 322 docsToFis docs = map (\d -> fisWithSizePolyMap
 323                               (Segment 1 20)
 324                               1
 325                               (map (words . text) d)) docs
 326
 327
 328 phyloFisFiltered :: Map (Date, Date) Fis
 329 phyloFisFiltered = filterFisBySupport True 1 (filterFisByNested phyloFis)
 330
 331
 332 phyloFis :: Map (Date, Date) Fis
 333 phyloFis = docsToFis phyloPeriods
 334
 335
 336 ------------------------------------------------------------------------
 337 -- | STEP 7 | -- Link level -1 to level 0
 338
 339
 340 phyloLinked_m1_0 :: Phylo
 341 phyloLinked_m1_0 = alterLevelLinks lvl_m1_0  phyloLinked_0_m1
 342
 343
 344 lvl_m1_0 :: LevelLink
 345 lvl_m1_0 = initLevelLink (initLevel (-1) Level_m1) (initLevel 0 Level_0)
 346
 347
 348 ------------------------------------------------------------------------
 349 -- | STEP 6 | -- Link level 0 to level -1
 350
 351
 352 -- | To set the LevelLinks between a given PhyloGroup and a list of childs/parents PhyloGroups
 353 linkGroupToGroups :: LevelLink -> PhyloGroup -> [PhyloGroup] -> PhyloGroup
 354 linkGroupToGroups lvl current targets
 355   | getLevelLinkValue From lvl < getLevelLinkValue To lvl = setLevelParents current
 356   | getLevelLinkValue From lvl > getLevelLinkValue To lvl = setLevelChilds current
 357   | otherwise = current
 358   where
 359     --------------------------------------
 360     setLevelChilds :: PhyloGroup -> PhyloGroup
 361     setLevelChilds =  over (phylo_groupLevelChilds) addPointers
 362     --------------------------------------
 363     setLevelParents :: PhyloGroup -> PhyloGroup
 364     setLevelParents =  over (phylo_groupLevelParents) addPointers
 365     --------------------------------------
 366     addPointers :: [Pointer] -> [Pointer]
 367     addPointers lp = lp ++ Maybe.mapMaybe (\target ->
 368                                             if shouldLink lvl (_phylo_groupNgrams current)
 369                                                               (_phylo_groupNgrams target )
 370                                             then Just ((getGroupId target),1)
 371                                             else Nothing) targets
 372     --------------------------------------
 373
 374
 375 -- | To set the LevelLinks between two lists of PhyloGroups
 376 linkGroupsByLevel :: LevelLink -> Phylo -> [PhyloGroup] -> [PhyloGroup]
 377 linkGroupsByLevel lvl p groups  = map (\group ->
 378   if getGroupLevel group == getLevelLinkValue From lvl
 379   then linkGroupToGroups lvl group (getGroupsWithFilters (getLevelLinkValue To lvl) (getGroupPeriod group) p)
 380   else group ) groups
 381
 382
 383 -- | To set the LevelLink of all the PhyloGroups of a Phylo
 384 alterLevelLinks :: LevelLink -> Phylo -> Phylo
 385 alterLevelLinks lvl p = alterPhyloGroups (linkGroupsByLevel lvl p) p
 386
 387
 388 phyloLinked_0_m1 :: Phylo
 389 phyloLinked_0_m1 = alterLevelLinks lvl_0_m1  phyloWithGroups0
 390
 391
 392 lvl_0_m1 :: LevelLink
 393 lvl_0_m1 = initLevelLink (initLevel 0 Level_0) (initLevel (-1) Level_m1)
 394
 395
 396 ------------------------------------------------------------------------
 397 -- | STEP 5 | -- Build level 0 as a copy of level -1
 398
 399
 400 -- | To clone the last PhyloLevel of each PhyloPeriod and update it with a new LevelValue
 401 clonePhyloLevel :: Int -> Phylo -> Phylo
 402 clonePhyloLevel lvl p = alterPhyloLevels (\l -> addPhyloLevel
 403                                                (setPhyloLevelId lvl $ head l)
 404                                                l) p
 405
 406
 407 phyloWithGroups0 :: Phylo
 408 phyloWithGroups0 = updatePhyloByLevel (initLevel 0 Level_0) phyloWithGroupsm1
 409
 410
 411 ------------------------------------------------------------------------
 412 -- | STEP 4 | -- Build level -1
 413
 414
 415 -- | To transform a list of Documents into a PhyloLevel
 416 docsToPhyloLevel :: Int ->(Date, Date) -> [Document] -> Phylo -> PhyloLevel
 417 docsToPhyloLevel lvl (d, d') docs p = initPhyloLevel
 418                                         ((d, d'), lvl)
 419                                         (map (\(f,s) -> initGroup [s] s f lvl d d' p)
 420                                              $ zip [1..]
 421                                              $ (nub . concat)
 422                                              $ map (words . text) docs)
 423
 424
 425 -- | To transform a Map of Periods and Documents into a list of PhyloPeriods
 426 docsToPhyloPeriods :: Int -> Map (Date,Date) [Document] -> Phylo -> [PhyloPeriod]
 427 docsToPhyloPeriods lvl docs p = map (\(id,l) -> initPhyloPeriod id l)
 428                                     $ Map.toList levels
 429   where
 430     --------------------------------------
 431     levels :: Map (Date,Date) [PhyloLevel]
 432     levels = mapWithKey (\k v -> [docsToPhyloLevel lvl k v p]) docs
 433     --------------------------------------
 434
 435
 436 -- | To update a Phylo for a given Levels
 437 updatePhyloByLevel :: Level -> Phylo -> Phylo
 438 updatePhyloByLevel lvl p
 439   = case getLevelLabel lvl of
 440
 441     Level_m1 -> appendPhyloPeriods (docsToPhyloPeriods (getLevelValue lvl) lvlData p) p
 442       where
 443         --------------------------------------
 444         lvlData :: Map (Date,Date) [Document]
 445         lvlData = phyloPeriods
 446         --------------------------------------
 447
 448     Level_0  -> clonePhyloLevel (getLevelValue lvl) p
 449
 450     Level_1  -> fisToPhyloLevel lvlData p
 451       where
 452         --------------------------------------
 453         lvlData :: Map (Date, Date) Fis
 454         lvlData = phyloFisFiltered
 455         --------------------------------------
 456
 457     _        -> panic ("[ERR][Viz.Phylo.Example.updatePhyloByLevel] Level not defined")
 458
 459
 460 phyloWithGroupsm1 :: Phylo
 461 phyloWithGroupsm1 = updatePhyloByLevel (initLevel (-1) Level_m1) phylo
 462
 463
 464 ------------------------------------------------------------------------
 465 -- | STEP 3 | -- Parse the Documents and group them by Periods
 466
 467
 468 -- | To init a set of periods out of a given Grain and Step
 469 docsToPeriods :: (Ord date, Enum date) => (doc -> date)
 470      -> Grain -> Step -> [doc] -> Map (date, date) [doc]
 471 docsToPeriods _ _ _ [] = panic "[ERR][Viz.Phylo.Example.docsToPeriods] Empty [Documents] can not have any periods"
 472 docsToPeriods f g s es = Map.fromList $ zip hs $ map (inPeriode f es) hs
 473   where
 474     --------------------------------------
 475     hs = steps g s $ both f (head es, last es)
 476     --------------------------------------
 477     inPeriode :: Ord b => (t -> b) -> [t] -> (b, b) -> [t]
 478     inPeriode f' h (start,end) =
 479       fst $ List.partition (\d -> f' d >= start && f' d <= end) h
 480     --------------------------------------
 481     steps :: (Eq date, Enum date) => Grain -> Step -> (date, date) -> [(date, date)]
 482     steps s' o' (start,end) = map (\l -> (head l, last l))
 483                           $ chunkAlong s' o' [start .. end]
 484     --------------------------------------
 485
 486
 487 -- | To parse a list of Documents by filtering on a Vector of Ngrams
 488 parseDocs :: PhyloNgrams -> [Document] -> [Document]
 489 parseDocs l docs = map (\(Document d t) -> Document d (unwords
 490                                                       $ filter (\x -> Vector.elem x l)
 491                                                       $ monoTexts t)) docs
 492
 493
 494 -- | To group a list of Documents by fixed periods
 495 groupDocsByPeriod :: Grain -> Step -> [Document] -> Phylo -> Map (Date, Date) [Document]
 496 groupDocsByPeriod g s docs p = docsToPeriods date g s
 497                              $ parseDocs (getPhyloNgrams p) docs
 498
 499
 500 phyloPeriods :: Map (Date, Date) [Document]
 501 phyloPeriods = groupDocsByPeriod 5 3 phyloDocs phylo
 502
 503
 504 ------------------------------------------------------------------------
 505 -- | STEP 2 | -- Init an initial list of Ngrams and a Phylo
 506
 507
 508 -- | To init a Phylomemy
 509 initPhylo :: [Document] -> PhyloNgrams -> Phylo
 510 initPhylo docs ngrams = Phylo (both date $ (last &&& head) docs) ngrams []
 511
 512
 513 -- | To init a PhyloNgrams as a Vector of Ngrams
 514 initNgrams :: [Ngrams] -> PhyloNgrams
 515 initNgrams l = Vector.fromList $ map toLower l
 516
 517
 518 phylo :: Phylo
 519 phylo = initPhylo phyloDocs (initNgrams actants)
 520
 521
 522 ------------------------------------------------------------------------
 523 -- | STEP 1 | -- Get a list of Document
 524
 525
 526 -- | To transform a corpus of texts into a structured list of Documents
 527 corpusToDocs :: [(Date, Text)] -> [Document]
 528 corpusToDocs l = map (\(d,t) -> Document d t) l
 529
 530
 531 phyloDocs :: [Document]
 532 phyloDocs = corpusToDocs corpus
 533
 534
 535 ------------------------------------------------------------------------
 536 -- | STEP 0 | -- Let's start with an example
 537
 538
 539 actants :: [Ngrams]
 540 actants = [ "Cleopatre"   , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV"
 541           , "Marc-Antoine", "Cesar"   , "Antoine"      , "Octave"  , "Rome"
 542           , "Alexandrie"  , "Auguste" , "Pompee"       , "Cassius" , "Brutus"]
 543
 544
 545 corpus :: [(Date, Text)]
 546 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")]