Commit ef13af01 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Revert "[MERGE]"

Test failed, not merging.

This reverts commit 2e77bfa5, reversing
changes made to fe201115.
parent 809b68b9
...@@ -38,9 +38,6 @@ data-files: ...@@ -38,9 +38,6 @@ data-files:
test-data/phylo/bpa_phylo_test.json test-data/phylo/bpa_phylo_test.json
test-data/phylo/open_science.json test-data/phylo/open_science.json
test-data/phylo/issue-290-small.golden.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 test-data/test_config.ini
gargantext-cors-settings.toml gargantext-cors-settings.toml
.clippy.dhall .clippy.dhall
...@@ -839,7 +836,6 @@ test-suite garg-test-tasty ...@@ -839,7 +836,6 @@ test-suite garg-test-tasty
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: drivers/tasty/Main.hs main-is: drivers/tasty/Main.hs
other-modules: other-modules:
Common
Test.API.Setup Test.API.Setup
Test.Core.Text Test.Core.Text
Test.Core.Text.Corpus.Query Test.Core.Text.Corpus.Query
...@@ -872,22 +868,7 @@ test-suite garg-test-tasty ...@@ -872,22 +868,7 @@ test-suite garg-test-tasty
Test.Utils.Jobs Test.Utils.Jobs
Paths_gargantext Paths_gargantext
hs-source-dirs: hs-source-dirs:
test bin/gargantext-phylo/Phylo test
default-extensions:
DataKinds
DeriveGeneric
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
ImportQualifiedPost
MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude
OverloadedStrings
RankNTypes
RecordWildCards
StrictData
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
QuickCheck ^>= 2.14.2 QuickCheck ^>= 2.14.2
...@@ -900,8 +881,6 @@ test-suite garg-test-tasty ...@@ -900,8 +881,6 @@ test-suite garg-test-tasty
, conduit ^>= 1.3.4.2 , conduit ^>= 1.3.4.2
, containers ^>= 0.6.5.1 , containers ^>= 0.6.5.1
, crawlerArxiv , crawlerArxiv
, cryptohash
, directory
, duckling ^>= 0.2.0.0 , duckling ^>= 0.2.0.0
, extra ^>= 1.7.9 , extra ^>= 1.7.9
, fast-logger ^>= 3.0.5 , fast-logger ^>= 3.0.5
...@@ -939,7 +918,6 @@ test-suite garg-test-tasty ...@@ -939,7 +918,6 @@ test-suite garg-test-tasty
, servant-server , servant-server
, shelly >= 1.9 && < 2 , shelly >= 1.9 && < 2
, stm ^>= 2.5.0.1 , stm ^>= 2.5.0.1
, split
, tasty ^>= 1.4.2.1 , tasty ^>= 1.4.2.1
, tasty-hspec , tasty-hspec
, tasty-hunit , tasty-hunit
...@@ -951,7 +929,6 @@ test-suite garg-test-tasty ...@@ -951,7 +929,6 @@ test-suite garg-test-tasty
, tmp-postgres >= 1.34.1 && < 1.35 , tmp-postgres >= 1.34.1 && < 1.35
, unordered-containers ^>= 0.2.16.0 , unordered-containers ^>= 0.2.16.0
, validity ^>= 0.11.0.1 , validity ^>= 0.11.0.1
, vector
, wai , wai
, wai-extra , wai-extra
, warp , warp
......
...@@ -16,19 +16,18 @@ Portability : POSIX ...@@ -16,19 +16,18 @@ Portability : POSIX
module Gargantext.Core.Viz.Phylo.PhyloTools where module Gargantext.Core.Viz.Phylo.PhyloTools where
import Control.Lens hiding (Level) import Control.Lens hiding (Level)
import Data.Discrimination qualified as D
import Data.List qualified as List
import Data.List (union, nub, init, tail, partition, nubBy, (!!)) import Data.List (union, nub, init, tail, partition, nubBy, (!!))
import Data.List qualified as List
import Data.Map (elems, empty, fromList, findWithDefault, unionWith, keys, member, (!), filterWithKey, fromListWith, restrictKeys) import Data.Map (elems, empty, fromList, findWithDefault, unionWith, keys, member, (!), filterWithKey, fromListWith, restrictKeys)
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Set (disjoint) import Data.Set (disjoint)
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.String (String) import Data.String (String)
import Data.Text qualified as Text
import Data.Text (unpack) import Data.Text (unpack)
import Data.Vector qualified as Vector import Data.Text qualified as Text
import Data.Vector (Vector, elemIndex) import Data.Vector (Vector, elemIndex)
import Data.Vector qualified as Vector
import Gargantext.Core.Viz.Phylo import Gargantext.Core.Viz.Phylo
import Gargantext.Prelude hiding (empty) import Gargantext.Prelude hiding (empty)
import Prelude (read) import Prelude (read)
...@@ -694,13 +693,13 @@ groupsToBranches' groups = ...@@ -694,13 +693,13 @@ groupsToBranches' groups =
in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph in map (\g -> g & phylo_groupBranchId %~ (\(lvl,_) -> (lvl,bId))) groups') graph
relatedComponents :: (D.Grouping a, Ord a) => [[a]] -> [[a]] relatedComponents :: Ord a => [[a]] -> [[a]]
relatedComponents graph = foldl' (\branches groups -> relatedComponents graph = foldl' (\branches groups ->
if (null branches) if (null branches)
then branches ++ [groups] then branches ++ [groups]
else else
let branchPart = partition (\branch -> disjoint (Set.fromList branch) (Set.fromList groups)) branches let branchPart = partition (\branch -> disjoint (Set.fromList branch) (Set.fromList groups)) branches
in (fst branchPart) ++ [D.nub $ concat $ (snd branchPart) ++ [groups]]) [] graph in (fst branchPart) ++ [nub $ concat $ (snd branchPart) ++ [groups]]) [] graph
toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]] toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -5,18 +5,15 @@ ...@@ -5,18 +5,15 @@
module Test.Offline.Phylo (tests) where module Test.Offline.Phylo (tests) where
import Data.Aeson
import Gargantext.Core.Viz.Phylo import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo) import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, writePhylo)
import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink) import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo)
import Gargantext.Core.Viz.Phylo.PhyloTools import Gargantext.Core.Viz.Phylo.PhyloTools
import Prelude import Prelude
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck import Test.Tasty.QuickCheck
import Common
import Paths_gargantext import Paths_gargantext
phyloConfig :: PhyloConfig phyloConfig :: PhyloConfig
...@@ -45,52 +42,12 @@ phyloConfig = PhyloConfig { ...@@ -45,52 +42,12 @@ phyloConfig = PhyloConfig {
tests :: TestTree tests :: TestTree
tests = testGroup "Phylo" [ tests = testGroup "Phylo" [
testGroup "toPhyloWithoutLink" [ testCase "returns expected data" testSmallPhyloExpectedOutput
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 :: Assertion
testSmallPhyloExpectedOutput = do testSmallPhyloExpectedOutput = do
issue290PhyloSmall <- setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290-small.json") issue290PhyloSmall <- setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290-small.json")
expected <- readPhylo =<< getDataFileName "test-data/phylo/issue-290-small.golden.json" expected <- readPhylo =<< getDataFileName "test-data/phylo/issue-290-small.golden.json"
let actual = toPhylo issue290PhyloSmall let actual = toPhylo issue290PhyloSmall
expected @?= actual 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]]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment