import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
-import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloStep)
+import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools (printIOMsg, printIOComment, setConfig)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import qualified Data.Vector as Vector
import qualified Gargantext.Core.Text.Corpus.Parsers.CSV as Csv
-data PhyloStage = PhyloWithCliques | PhyloWithLinks deriving (Show)
+data Backup = BackupPhyloWithoutLink | BackupPhylo deriving (Show)
---------------
-- | Tools | --
(termsInText patterns $ (csv_title row) <> " " <> (csv_abstract row))
Nothing
[]
- ) <$> snd <$> either (\err -> panic $ cs $ "CSV error" <> (show err)) identity <$> Csv.readFile path
+ ) <$> snd <$> either (\err -> panic $ cs $ "CSV error" <> (show err)) identity <$> Csv.readCSVFile path
Csv' limit -> Vector.toList
<$> Vector.take limit
<$> Vector.map (\row -> Document (toPhyloDate (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
seaToLabel config = case (seaElevation config) of
Constante start step -> ("sea_cst_" <> (show start) <> "_" <> (show step))
Adaptative granularity -> ("sea_adapt" <> (show granularity))
+ Evolving _ -> ("sea_evolv")
sensToLabel :: PhyloConfig -> [Char]
-sensToLabel config = case (phyloProximity config) of
- Hamming _ -> undefined
- WeightedLogJaccard s -> ("WeightedLogJaccard_" <> show s)
- WeightedLogSim s -> ( "WeightedLogSim-sens_" <> show s)
+sensToLabel config = case (similarity config) of
+ Hamming _ _ -> undefined
+ WeightedLogJaccard s _ -> ("WeightedLogJaccard_" <> show s)
+ WeightedLogSim s _ -> ( "WeightedLogSim-sens_" <> show s)
cliqueToLabel :: PhyloConfig -> [Char]
configToLabel config = outputPath config
<> (unpack $ phyloName config)
<> "-" <> (timeToLabel config)
- <> "-scale_" <> (show (phyloLevel config))
+ <> "-scale_" <> (show (phyloScale config))
<> "-" <> (seaToLabel config)
<> "-" <> (sensToLabel config)
<> "-" <> (cliqueToLabel config)
-- To write a sha256 from a set of config's parameters
-configToSha :: PhyloStage -> PhyloConfig -> [Char]
+configToSha :: Backup -> PhyloConfig -> [Char]
configToSha stage config = unpack
$ replace "/" "-"
$ T.pack (show (hash $ C8.pack label))
where
label :: [Char]
label = case stage of
- PhyloWithCliques -> (corpusPath config)
+ BackupPhyloWithoutLink -> (corpusPath config)
<> (listPath config)
<> (timeToLabel config)
<> (cliqueToLabel config)
- PhyloWithLinks -> (corpusPath config)
+ BackupPhylo -> (corpusPath config)
<> (listPath config)
<> (timeToLabel config)
<> (cliqueToLabel config)
<> (seaToLabel config)
<> (syncToLabel config)
<> (qualToConfig config)
- <> (show (phyloLevel config))
+ <> (show (phyloScale config))
readListV4 :: [Char] -> IO NgramsList
printIOMsg "Reconstruct the phylo"
- let phyloWithCliquesFile = (outputPath config) <> "phyloWithCliques_" <> (configToSha PhyloWithCliques config) <> ".json"
- let phyloWithLinksFile = (outputPath config) <> "phyloWithLinks_" <> (configToSha PhyloWithLinks config) <> ".json"
+ -- check the existing backup files
- phyloWithCliquesExists <- doesFileExist phyloWithCliquesFile
- phyloWithLinksExists <- doesFileExist phyloWithLinksFile
+ let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
+ let backupPhylo = (outputPath config) <> "backupPhylo_" <> (configToSha BackupPhylo config) <> ".json"
- -- phyloStep <- if phyloWithCliquesExists
- -- then do
- -- printIOMsg "Reconstruct the phylo step from an existing file"
- -- readPhylo phyloWithCliquesFile
- -- else do
- -- printIOMsg "Reconstruct the phylo step from scratch"
- -- pure $ toPhyloStep corpus mapList config
+ phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
+ phyloExists <- doesFileExist backupPhylo
- -- writePhylo phyloWithCliquesFile phyloStep
+ -- reconstruct the phylo
- -- let phylo = toPhylo (setConfig config phyloStep)
+ phylo <- if phyloExists
+ then do
+ printIOMsg "Reconstruct the phylo from an existing file"
+ readPhylo backupPhylo
+ else do
+ if phyloWithoutLinkExists
+ then do
+ printIOMsg "Reconstruct the phylo from an existing file without links"
+ phyloWithoutLink <- readPhylo backupPhyloWithoutLink
+ writePhylo backupPhyloWithoutLink phyloWithoutLink
+ pure $ toPhylo (setConfig config phyloWithoutLink)
+ else do
+ printIOMsg "Reconstruct the phylo from scratch"
+ phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
+ writePhylo backupPhyloWithoutLink phyloWithoutLink
+ pure $ toPhylo (setConfig config phyloWithoutLink)
- phyloWithLinks <- if phyloWithLinksExists
- then do
- printIOMsg "Reconstruct the phylo from an existing file with intertemporal links"
- readPhylo phyloWithLinksFile
- else do
- if phyloWithCliquesExists
- then do
- printIOMsg "Reconstruct the phylo from an existing file with cliques"
- phyloWithCliques <- readPhylo phyloWithCliquesFile
- writePhylo phyloWithCliquesFile phyloWithCliques
- pure $ toPhylo (setConfig config phyloWithCliques)
- else do
- printIOMsg "Reconstruct the phylo from scratch"
- phyloWithCliques <- pure $ toPhyloStep corpus mapList config
- writePhylo phyloWithCliquesFile phyloWithCliques
- pure $ toPhylo (setConfig config phyloWithCliques)
-
- writePhylo phyloWithLinksFile phyloWithLinks
-
-
- -- probes
-
- -- writeFile ((outputPath config) <> (unpack $ phyloName config) <> "_synchronic_distance_cumu_jaccard.txt")
- -- $ synchronicDistance' phylo 1
-
- -- writeFile ((outputPath config) <> (unpack $ phyloName config) <> "_inflexion_points.txt")
- -- $ inflexionPoints phylo 1
+ writePhylo backupPhylo phylo
printIOMsg "End of reconstruction, start the export"
- let dot = toPhyloExport (setConfig config phyloWithLinks)
+ let dot = toPhyloExport (setConfig config phylo)
let output = configToLabel config