Commit 8008d6ee authored by Grégoire Locqueville's avatar Grégoire Locqueville

Added some tests

parent 62f59938
This diff is collapsed.
......@@ -15,14 +15,61 @@ commentary with @some markup@.
module Test.Graph.Distance where
{-
import Gargantext.Core.Methods.Matrix.Accelerate.Utils (cross', matrix)
import Data.HashMap.Strict qualified as HM
import Data.Map qualified as Map
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.Methods.Similarities (Similarity(..))
import Gargantext.Core.Viz.Graph.Tools (doSimilarityMap)
import Gargantext.Core.Viz.Graph.Types (Strength(..))
import Gargantext.Prelude
import Test.Hspec (Spec, describe, it, shouldBe)
test :: IO ()
test = hspec $ do
describe "Cross" $ do
let result = cross' $ matrix 3 ([1,1..] :: [Double])
it "compare" $ do
shouldBe result (matrix 3 ([2,2..] :: [Double]))
-}
-- | The terms are composed of 4 food items: 2 "bases" ("feuille" and "pate")
-- and 2 "fillings" ("tomate" and "boeuf").
-- The corpus is composed of 4 recipes (one context = one recipe),
-- one for each possible pairing of a base and a filling.
recipeCooc :: HM.HashMap (NgramsTerm, NgramsTerm) Int
recipeCooc = HM.fromList
[ ((NgramsTerm "feuille", NgramsTerm "pate" ), 0)
, ((NgramsTerm "boeuf" , NgramsTerm "tomate" ), 0)
, ((NgramsTerm "boeuf" , NgramsTerm "pate" ), 1)
, ((NgramsTerm "tomate" , NgramsTerm "tomate" ), 2)
, ((NgramsTerm "pate" , NgramsTerm "tomate" ), 1)
, ((NgramsTerm "boeuf" , NgramsTerm "feuille"), 1)
, ((NgramsTerm "pate" , NgramsTerm "pate" ), 2)
, ((NgramsTerm "boeuf" , NgramsTerm "boeuf" ), 2)
, ((NgramsTerm "feuille", NgramsTerm "feuille"), 2)
, ((NgramsTerm "feuille", NgramsTerm "tomate" ), 1)
]
test :: Spec
test = do
describe "Recipe O2 Weight Map" $ do
let (recipeWeights, _coocs, dictionary) =
doSimilarityMap Distributional 0 Strong recipeCooc
it "has the right edges" $ do
-- Distributional weight map of the `recipeCooc` virtual corpus
let weights = do -- Maybe monad
-- Lookup nodes
feuilleID <- Map.lookup (NgramsTerm "feuille") dictionary
pateID <- Map.lookup (NgramsTerm "pate" ) dictionary
boeufID <- Map.lookup (NgramsTerm "boeuf" ) dictionary
tomateID <- Map.lookup (NgramsTerm "tomate" ) dictionary
-- Lookup edge weights, if any
let feuillePate = Map.lookup (feuilleID, pateID) recipeWeights
let boeufTomate = Map.lookup (boeufID, tomateID) recipeWeights
let feuilleTomate = Map.lookup (feuilleID, tomateID) recipeWeights
let feuilleBoeuf = Map.lookup (feuilleID, boeufID) recipeWeights
let pateTomate = Map.lookup (pateID, tomateID) recipeWeights
let pateBoeuf = Map.lookup (pateID, boeufID) recipeWeights
return [ feuillePate, boeufTomate, feuilleTomate
, feuilleBoeuf, pateTomate, pateBoeuf ]
-- We check that there are edges exactly where we expect there to be:
(fmap . fmap) positiveWeight weights `shouldBe`
Just [True, True, False, False, False, False]
-- | Checks whether `Map.lookup` outputs something, and that that something is
-- strictly positive, denoting the presence of an edge.
positiveWeight :: (Num a, Ord a) => Maybe a -> Bool
positiveWeight Nothing = False
positiveWeight (Just w) = w > 0
......@@ -20,7 +20,8 @@ import qualified Test.Core.Text.Corpus.Query as CorpusQuery
import qualified Test.Core.Text.Corpus.TSV as TSVParser
import qualified Test.Core.Utils as Utils
import qualified Test.Core.Worker as Worker
import qualified Test.Graph.Clustering as Graph
import qualified Test.Graph.Clustering as Clustering
import qualified Test.Graph.Distance as Distance
import qualified Test.Ngrams.Lang.Occurrences as Occurrences
import qualified Test.Ngrams.NLP as NLP
import qualified Test.Ngrams.Query as NgramsQuery
......@@ -48,7 +49,8 @@ protectStdoutBuffering action =
main :: IO ()
main = do
utilSpec <- testSpec "Utils" Utils.test
clusteringSpec <- testSpec "Graph Clustering" Graph.test
clusteringSpec <- testSpec "Graph Clustering" Clustering.test
distanceSpec <- testSpec "Graph Distance" Distance.test
dateSplitSpec <- testSpec "Date split" PD.testDateSplit
cryptoSpec <- testSpec "Crypto" Crypto.test
nlpSpec <- testSpec "NLP" NLP.test
......@@ -60,6 +62,7 @@ main = do
protectStdoutBuffering $ defaultMain $ testGroup "Gargantext"
[ utilSpec
, clusteringSpec
, distanceSpec
, dateSplitSpec
, cryptoSpec
, nlpSpec
......
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