[MERGE]

gargantext.cabal

@@ -38,6 +38,9 @@ data-files:
     test-data/phylo/bpa_phylo_test.json
     test-data/phylo/open_science.json
     test-data/phylo/issue-290-small.golden.json
+    test-data/phylo/small_phylo_docslist.csv
+    test-data/phylo/small_phylo_ngramslist.csv
+    test-data/phylo/small-phylo.golden.json
     test-data/test_config.ini
     gargantext-cors-settings.toml
     .clippy.dhall
@@ -836,6 +839,7 @@ test-suite garg-test-tasty
   type: exitcode-stdio-1.0
   main-is: drivers/tasty/Main.hs
   other-modules:
+      Common
       Test.API.Setup
       Test.Core.Text
       Test.Core.Text.Corpus.Query
@@ -868,7 +872,22 @@ test-suite garg-test-tasty
       Test.Utils.Jobs
       Paths_gargantext
   hs-source-dirs:
-      test
+      test bin/gargantext-phylo/Phylo
+  default-extensions:
+      DataKinds
+      DeriveGeneric
+      FlexibleContexts
+      FlexibleInstances
+      GADTs
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+      StrictData
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       QuickCheck ^>= 2.14.2
@@ -881,6 +900,8 @@ test-suite garg-test-tasty
     , conduit ^>= 1.3.4.2
     , containers ^>= 0.6.5.1
     , crawlerArxiv
+    , cryptohash
+    , directory
     , duckling ^>= 0.2.0.0
     , extra ^>= 1.7.9
     , fast-logger ^>= 3.0.5
@@ -918,6 +939,7 @@ test-suite garg-test-tasty
     , servant-server
     , shelly >= 1.9 && < 2
     , stm ^>= 2.5.0.1
+    , split
     , tasty ^>= 1.4.2.1
     , tasty-hspec
     , tasty-hunit
@@ -929,6 +951,7 @@ test-suite garg-test-tasty
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , vector
     , wai
     , wai-extra
     , warp

src/Gargantext/Core/Viz/Phylo/PhyloTools.hs

@@ -16,18 +16,19 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.PhyloTools where
 
 import Control.Lens hiding (Level)
-import Data.List (union, nub, init, tail, partition, nubBy, (!!))
+import Data.Discrimination qualified as D
 import Data.List qualified as List
+import Data.List (union, nub, init, tail, partition, nubBy, (!!))
 import Data.Map (elems, empty, fromList, findWithDefault, unionWith, keys, member, (!), filterWithKey, fromListWith, restrictKeys)
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
 import Data.Set (disjoint)
 import Data.Set qualified as Set
 import Data.String (String)
-import Data.Text (unpack)
 import Data.Text qualified as Text
-import Data.Vector (Vector, elemIndex)
+import Data.Text (unpack)
 import Data.Vector qualified as Vector
+import Data.Vector (Vector, elemIndex)
 import Gargantext.Core.Viz.Phylo
 import Gargantext.Prelude hiding (empty)
 import Prelude (read)
@@ -693,13 +694,13 @@ groupsToBranches' groups =
          in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph
 
 
-relatedComponents :: Ord a => [[a]] -> [[a]]
+relatedComponents :: (D.Grouping a, Ord a) => [[a]] -> [[a]]
 relatedComponents graph = foldl' (\branches groups ->
     if (null branches)
     then branches ++ [groups]
     else
         let branchPart = partition (\branch -> disjoint (Set.fromList branch) (Set.fromList groups)) branches
-         in (fst branchPart) ++ [nub $ concat $ (snd branchPart) ++ [groups]]) [] graph
+         in (fst branchPart) ++ [D.nub $ concat $ (snd branchPart) ++ [groups]]) [] graph
 
 
 toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]

test/Test/Offline/Phylo.hs

@@ -5,15 +5,18 @@
 
 module Test.Offline.Phylo (tests) where
 
+import Data.Aeson
 import Gargantext.Core.Viz.Phylo
-import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, writePhylo)
-import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo)
+import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo)
+import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
 import Gargantext.Core.Viz.Phylo.PhyloTools
 import Prelude
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 
+import Common
+
 import Paths_gargantext
 
 phyloConfig :: PhyloConfig
@@ -42,12 +45,52 @@ phyloConfig = PhyloConfig {
 
 tests :: TestTree
 tests = testGroup "Phylo" [
-  testCase "returns expected data" testSmallPhyloExpectedOutput
+    testGroup "toPhyloWithoutLink" [
+      testCase "returns expected data" testSmallPhyloWithoutLinkExpectedOutput
+    ]
+  , testGroup "toPhylo" [
+    testCase "returns expected data" testSmallPhyloExpectedOutput
+  ]
+  , testGroup "relatedComponents" [
+    testCase "finds simple connection" testRelComp_Connected
+  ]
   ]
 
+testSmallPhyloWithoutLinkExpectedOutput :: Assertion
+testSmallPhyloWithoutLinkExpectedOutput = do
+  bpaConfig      <- getDataFileName "bench-data/phylo/bpa-config.json"
+  corpusPath'    <- getDataFileName "test-data/phylo/small_phylo_docslist.csv"
+  listPath'      <- getDataFileName "test-data/phylo/small_phylo_ngramslist.csv"
+  (Right config) <- fmap (\pcfg -> pcfg { corpusPath = corpusPath'
+                                        , listPath   = listPath'
+                                        }) <$> (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
+  actual   <- pure $ toPhyloWithoutLink corpus config
+  expected <- readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json"
+  expected @?= actual
+
 testSmallPhyloExpectedOutput :: Assertion
 testSmallPhyloExpectedOutput = do
   issue290PhyloSmall <- setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290-small.json")
   expected <- readPhylo =<< getDataFileName "test-data/phylo/issue-290-small.golden.json"
   let actual = toPhylo issue290PhyloSmall
   expected @?= actual
+
+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]]
+