{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.Offline.Phylo (tests) where
import CLI.Phylo.Common
import Data.Aeson as JSON
import Data.Aeson.Types qualified as JSON
import Data.GraphViz.Attributes.Complete qualified as Graphviz
import Data.Text.Lazy as TL
import Data.TreeDiff
import Data.Vector qualified as V
import Gargantext.Core.Text.List.Formats.TSV
import Gargantext.Core.Types.Phylo hiding (Phylo(..))
import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, phylo2dot2json)
import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre
import Gargantext.Core.Viz.Phylo.PhyloExport
import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools
import Paths_gargantext
import Prelude
import Test.Tasty
import Test.Tasty.HUnit
phyloTestConfig :: PhyloConfig
phyloTestConfig = PhyloConfig {
corpusPath = "corpus.csv"
, listPath = "list.csv"
, outputPath = "data/"
, corpusParser = Tsv {_tsv_limit = 150000}
, listParser = V4
, phyloName = "Phylo Name"
, phyloScale = 2
, similarity = WeightedLogJaccard {_wlj_sensibility = 0.5, _wlj_minSharedNgrams = 2}
, seaElevation = Constante {_cons_start = 0.1, _cons_gap = 0.1}
, defaultMode = True
, findAncestors = False
, phyloSynchrony = ByProximityThreshold {_bpt_threshold = 0.5, _bpt_sensibility = 0.0, _bpt_scope = AllBranches, _bpt_strategy = MergeAllGroups}
, phyloQuality = Quality {_qua_granularity = 0.8, _qua_minBranch = 3}
, timeUnit = Year {_year_period = 3, _year_step = 1, _year_matchingFrame = 5}
, clique = MaxClique {_mcl_size = 5, _mcl_threshold = 1.0e-4, _mcl_filter = ByThreshold}
, exportLabel = [ BranchLabel {_branch_labelTagger = MostEmergentTfIdf, _branch_labelSize = 2}
, GroupLabel {_group_labelTagger = MostEmergentInclusive, _group_labelSize = 2}
]
, exportSort = ByHierarchy {_sort_order = Desc}
, exportFilter = [ByBranchSize {_branch_size = 3.0}]
}
tests :: TestTree
tests = testGroup "Phylo" [
testGroup "Export" [
testCase "ngramsToLabel respects encoding" test_ngramsToLabel_01
, testCase "ngramsToLabel is rendered correctly in CustomAttribute" test_ngramsToLabel_02
]
, testGroup "toPhyloWithoutLink" [
testCase "returns expected data" testSmallPhyloWithoutLinkExpectedOutput
, testCase "phyloCleopatre returns expected data" testCleopatreWithoutLinkExpectedOutput
, testCase "Nadal canned corpus returns expected data" testNadalWithoutLinkExpectedOutput
]
, testGroup "phylo2dot2json" [
testCase "is deterministic" testPhylo2dot2json
]
, testGroup "toPhylo" [
testCase "is deterministic" testToPhyloDeterminism
]
, testGroup "relatedComponents" [
testCase "finds simple connection" testRelComp_Connected
]
, testCase "parses csv phylo" testCsvPhylo
]
testCleopatreWithoutLinkExpectedOutput :: Assertion
testCleopatreWithoutLinkExpectedOutput = do
let actual = toPhyloWithoutLink Cleopatre.docs Cleopatre.config
expected <- readPhylo =<< getDataFileName "test-data/phylo/cleopatre.golden.json"
assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
testNadalWithoutLinkExpectedOutput :: Assertion
testNadalWithoutLinkExpectedOutput = do
corpusPath' <- getDataFileName "test-data/phylo/nadal_docslist.golden.tsv"
listPath' <- getDataFileName "test-data/phylo/nadal_ngramslist.golden.tsv"
let config = phyloTestConfig { corpusPath = corpusPath'
, listPath = listPath'
, listParser = V3
}
mapList <- fileToList (listParser config) (listPath config)
corpus <- fileToDocsDefault (corpusParser config)
(corpusPath config)
[Year 3 1 5,Month 3 1 5,Week 4 2 5]
mapList
let actual = setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
expected <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/nadal.golden.json")
assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
testSmallPhyloWithoutLinkExpectedOutput :: Assertion
testSmallPhyloWithoutLinkExpectedOutput = do
bpaConfig <- getDataFileName "bench-data/phylo/bpa-config.json"
corpusPath' <- getDataFileName "test-data/phylo/small_phylo_docslist.tsv"
listPath' <- getDataFileName "test-data/phylo/small_phylo_ngramslist.tsv"
(Right config) <- fmap (\pcfg -> pcfg { corpusPath = corpusPath'
, listPath = listPath'
}) <$> (JSON.eitherDecodeFileStrict' bpaConfig)
mapList <- fileToList (listParser config) (listPath config)
corpus <- fileToDocsDefault (corpusParser config)
(corpusPath config)
[Year 3 1 5,Month 3 1 5,Week 4 2 5]
mapList
let actual = setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
expected <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json")
assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
testPhylo2dot2json :: Assertion
testPhylo2dot2json = do
expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName "test-data/phylo/phylo2dot2json.golden.json"
case expected_e of
Left err -> fail err
Right (expected :: GraphData) -> do
actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
case actual_e of
Left err -> fail err
Right (actual :: GraphData) -> do
assertBool ("Phylo mismatch!" <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected `compareGraphDataFuzzy` actual)
compareGraphDataFuzzy :: GraphData -> GraphData -> Bool
compareGraphDataFuzzy gd1 gd2 =
and [ _gd__subgraph_cnt gd1 == _gd__subgraph_cnt gd2
, _gd_directed gd1 == _gd_directed gd2
, and $ Prelude.map (uncurry compareEdgeDataFuzzy) $ Prelude.zip (_gd_edges gd1) (_gd_edges gd2)
, and $ Prelude.map (uncurry compareObjectDataFuzzy) $ Prelude.zip (_gd_objects gd1) (_gd_objects gd2)
, _gd_strict gd1 == _gd_strict gd2
, _gd_data gd1 `compareGraphDataDataFuzzy` _gd_data gd2
]
where
gdd1 `compareEdgeDataFuzzy` ggd2 = case (gdd1, ggd2) of
(GroupToAncestor gvId1 ecd1 gad1, GroupToAncestor gvId2 ecd2 gad2)
-> and [ gvId1 == gvId2, ecd1 `compareEdgeCommonDataFuzzy` ecd2, gad1 == gad2 ]
(GroupToAncestor{}, _)
-> False
(GroupToGroup gvId1 ecd1 gd1', GroupToGroup gvId2 ecd2 gd2')
-> and [ gvId1 == gvId2, ecd1 `compareEdgeCommonDataFuzzy` ecd2, gd1' == gd2' ]
(GroupToGroup{}, _)
-> False
(BranchToGroup gvId1 ecd1 bgd1, BranchToGroup gvId2 ecd2 bgd2)
-> and [ gvId1 == gvId2, ecd1 `compareEdgeCommonDataFuzzy` ecd2, bgd1 == bgd2 ]
(BranchToGroup{}, _)
-> False
(PeriodToPeriod gvId1 ecd1, PeriodToPeriod gvId2 ecd2)
-> and [ gvId1 == gvId2, ecd1 `compareEdgeCommonDataFuzzy` ecd2 ]
(PeriodToPeriod{}, _)
-> False
gdd1 `compareObjectDataFuzzy` ggd2 = case (gdd1, ggd2) of
(GroupToNode gvId1 ncd1 gnd1, GroupToNode gvId2 ncd2 gnd2)
-> and [ gvId1 == gvId2, ncd1 `compareNodeCommonDataFuzzy` ncd2, gnd1 == gnd2 ]
(GroupToNode{}, _)
-> False
(BranchToNode gvId1 ncd1 bnd1, BranchToNode gvId2 ncd2 bnd2)
-> and [ gvId1 == gvId2, ncd1 `compareNodeCommonDataFuzzy` ncd2, bnd1 == bnd2 ]
(BranchToNode{}, _)
-> False
(PeriodToNode gvId1 ncd1 pnd1, PeriodToNode gvId2 ncd2 pnd2)
-> and [ gvId1 == gvId2, ncd1 `compareNodeCommonDataFuzzy` ncd2, pnd1 == pnd2 ]
(PeriodToNode{}, _)
-> False
(Layer gvId1 gdd1' ld1, Layer gvId2 gdd2 ld2)
-> and [ gvId1 == gvId2, gdd1' `compareGraphDataDataFuzzy` gdd2, ld1 == ld2 ]
(Layer{}, _)
-> False
gdd1 `compareNodeCommonDataFuzzy` ggd2 =
-- Excluded fields: pos, width, height.
and [ _nd_label gdd1 == _nd_label ggd2
, _nd_name gdd1 == _nd_name ggd2
, _nd_nodeType gdd1 == _nd_nodeType ggd2
, _nd_shape gdd1 == _nd_shape ggd2
]
gdd1 `compareEdgeCommonDataFuzzy` gdd2 =
-- Excluded fields: pos, width.
and [ _ed_color gdd1 == _ed_color gdd2
, _ed_head gdd1 == _ed_head gdd2
, _ed_tail gdd1 == _ed_tail gdd2
]
gdd1 `compareGraphDataDataFuzzy` ggd2 =
-- Excluded fields: bb, lp, lheight, lwidth.
and [ _gdd_color gdd1 == _gdd_color ggd2
, _gdd_fontsize gdd1 == _gdd_fontsize ggd2
, _gdd_label gdd1 == _gdd_label ggd2
, _gdd_labelloc gdd1 == _gdd_labelloc ggd2
, _gdd_name gdd1 == _gdd_name ggd2
, _gdd_nodesep gdd1 == _gdd_nodesep ggd2
, _gdd_overlap gdd1 == _gdd_overlap ggd2
, _gdd_phyloBranches gdd1 == _gdd_phyloBranches ggd2
, _gdd_phyloDocs gdd1 == _gdd_phyloDocs ggd2
, _gdd_phyloFoundations gdd1 == _gdd_phyloFoundations ggd2
, _gdd_phyloGroups gdd1 == _gdd_phyloGroups ggd2
, _gdd_phyloPeriods gdd1 == _gdd_phyloPeriods ggd2
, _gdd_phyloSources gdd1 == _gdd_phyloSources ggd2
, _gdd_phyloTerms gdd1 == _gdd_phyloTerms ggd2
, _gdd_phyloTimeScale gdd1 == _gdd_phyloTimeScale ggd2
, _gdd_rank gdd1 == _gdd_rank ggd2
, _gdd_ranksep gdd1 == _gdd_ranksep ggd2
, _gdd_ratio gdd1 == _gdd_ratio ggd2
, _gdd_splines gdd1 == _gdd_splines ggd2
, _gdd_style gdd1 == _gdd_style ggd2
]
test_ngramsToLabel_01 :: Assertion
test_ngramsToLabel_01 =
let ngrams = V.fromList [ "évaluation", "méthodologique" ]
in ngramsToLabel ngrams [0,1] @?= "évaluation | méthodologique"
test_ngramsToLabel_02 :: Assertion
test_ngramsToLabel_02 =
let ngrams = V.fromList [ "钱", "狗" ]
in (Graphviz.customValue $ toAttr "lbl" $ TL.fromStrict $ ngramsToLabel ngrams [0,1]) @?= "钱 | 狗"
testRelComp_Connected :: Assertion
testRelComp_Connected = do
(relatedComponents @Int) [] @?= []
(relatedComponents @Int) [[]] @?= [[]]
(relatedComponents @Int) [[],[1,2]] @?= [[],[1,2]]
(relatedComponents @Int) [[1,2],[]] @?= [[1,2],[]]
(relatedComponents @Int) [[1,2], [2]] @?= [[1,2]]
(relatedComponents @Int) [[1,2], [2],[2]] @?= [[1,2]]
(relatedComponents @Int) [[1,2], [2],[2,1]] @?= [[1,2]]
(relatedComponents @Int) [[1,2], [2,4]] @?= [[1,2,4]]
(relatedComponents @Int) [[1,2], [3,5], [2,4]] @?= [[3,5], [1,2,4]]
(relatedComponents @Int) [[1,2], [3,5], [2,4],[9,5],[5,4]] @?= [[1,2,4,3,5,9]]
(relatedComponents @Int) [[1,2,5], [4,5,9]] @?= [[1,2,5,4,9]]
testToPhyloDeterminism :: Assertion
testToPhyloDeterminism = do
corpusPath' <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.tsv"
listPath' <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.tsv"
let config = phyloTestConfig { corpusPath = corpusPath'
, listPath = listPath'
, listParser = V3
}
mapList <- tsvMapTermList (listPath config)
corpus <- fileToDocsDefault (corpusParser config)
(corpusPath config)
[Year 3 1 5,Month 3 1 5,Week 4 2 5]
mapList
let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config
expected <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/187481.json")
assertBool ("Phylo mismatch! " <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected == actual)
testCsvPhylo :: Assertion
testCsvPhylo = do
pth <- getDataFileName "test-data/phylo/cleopatre.golden.csv.json"
phyloJson <- eitherDecodeFileStrict' @Phylo pth
case phyloJson of
Left err -> error err
Right _ -> pure ()