src-test/Ngrams/Metrics.hs

   1 {-# LANGUAGE CPP                  #-}
   2 {-# LANGUAGE OverloadedStrings    #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4
   5 module Ngrams.Metrics (main) where
   6
   7 import Gargantext.Ngrams.Metrics
   8 import Data.Ratio
   9 import Data.Text (Text)
  10 import Test.Hspec
  11 import Test.QuickCheck
  12 import qualified Data.Text as T
  13
  14 #if !MIN_VERSION_base(4,8,0)
  15 import Control.Applicative
  16 #endif
  17
  18 instance Arbitrary Text where
  19   arbitrary = T.pack <$> arbitrary
  20
  21 main :: IO ()
  22 main = hspec spec
  23
  24 spec :: Spec
  25 spec = do
  26   describe "levenshtein" $ do
  27     testSwap levenshtein
  28     context "with concrete examples" $ do
  29       testPair levenshtein "kitten"   "sitting" 3
  30       testPair levenshtein "cake"     "drake"   2
  31       testPair levenshtein "saturday" "sunday"  3
  32       testPair levenshtein "red"      "wax"     3
  33 #if __GLASGOW_HASKELL__ >= 710
  34       testPair levenshtein "a😀c"     "abc"     1
  35 #endif
  36       testPair levenshtein "lucky"    "lucky"   0
  37       testPair levenshtein ""         ""        0
  38   describe "levenshteinNorm" $ do
  39     testSwap levenshteinNorm
  40     testPair levenshteinNorm "kitten"   "sitting" (4 % 7)
  41     testPair levenshteinNorm "cake"     "drake"   (3 % 5)
  42     testPair levenshteinNorm "saturday" "sunday"  (5 % 8)
  43     testPair levenshteinNorm "red"      "wax"     (0 % 1)
  44 #if __GLASGOW_HASKELL__ >= 710
  45     testPair levenshteinNorm "a😀c"     "abc"     (2 % 3)
  46 #endif
  47     testPair levenshteinNorm "lucky"    "lucky"   (1 % 1)
  48     testPair levenshteinNorm ""         ""        (1 % 1)
  49   describe "damerauLevenshtein" $ do
  50     testSwap damerauLevenshtein
  51     testPair damerauLevenshtein "veryvery long" "very long" 4
  52     testPair damerauLevenshtein "thing"         "think"     1
  53     testPair damerauLevenshtein "nose"          "ones"      2
  54     testPair damerauLevenshtein "thing"         "sign"      3
  55     testPair damerauLevenshtein "red"           "wax"       3
  56 #if __GLASGOW_HASKELL__ >= 710
  57     testPair damerauLevenshtein "a😀c"          "abc"       1
  58 #endif
  59     testPair damerauLevenshtein "lucky"         "lucky"     0
  60     testPair damerauLevenshtein ""              ""          0
  61   describe "damerauLevenshteinNorm" $ do
  62     testSwap damerauLevenshteinNorm
  63     testPair damerauLevenshteinNorm "veryvery long" "very long" (9 % 13)
  64     testPair damerauLevenshteinNorm "thing"         "think"     (4 % 5)
  65     testPair damerauLevenshteinNorm "nose"          "ones"      (1 % 2)
  66     testPair damerauLevenshteinNorm "thing"         "sign"      (2 % 5)
  67     testPair damerauLevenshteinNorm "red"           "wax"       (0 % 1)
  68 #if __GLASGOW_HASKELL__ >= 710
  69     testPair damerauLevenshteinNorm "a😀c"          "abc"       (2 % 3)
  70 #endif
  71     testPair damerauLevenshteinNorm "lucky"         "lucky"     (1 % 1)
  72     testPair damerauLevenshteinNorm ""              ""          (1 % 1)
  73   describe "hamming" $ do
  74     testSwap hamming
  75     testPair hamming "karolin" "kathrin" (Just 3)
  76     testPair hamming "karolin" "kerstin" (Just 3)
  77     testPair hamming "1011101" "1001001" (Just 2)
  78     testPair hamming "2173896" "2233796" (Just 3)
  79     testPair hamming "toned"   "roses"   (Just 3)
  80     testPair hamming "red"     "wax"     (Just 3)
  81 #if __GLASGOW_HASKELL__ >= 710
  82     testPair hamming "a😀c"    "abc"      (Just 1)
  83 #endif
  84     testPair hamming "lucky"   "lucky"   (Just 0)
  85     testPair hamming ""        ""        (Just 0)
  86     testPair hamming "small"   "big"     Nothing
  87   describe "overlap" $ do
  88     testSwap overlap
  89     testPair overlap "fly"     "butterfly" (1 % 1)
  90     testPair overlap "night"   "nacht"     (3 % 5)
  91     testPair overlap "context" "contact"   (5 % 7)
  92     testPair overlap "red"     "wax"       (0 % 1)
  93 #if __GLASGOW_HASKELL__ >= 710
  94     testPair overlap "a😀c"   "abc"   (2 % 3)
  95 #endif
  96     testPair overlap "lucky" "lucky" (1 % 1)
  97   describe "jaccard" $ do
  98     testSwap jaccard
  99     testPair jaccard "xxx"     "xyx"     (1 % 2)
 100     testPair jaccard "night"   "nacht"   (3 % 7)
 101     testPair jaccard "context" "contact" (5 % 9)
 102 #if __GLASGOW_HASKELL__ >= 710
 103     testPair overlap "a😀c"     "abc"     (2 % 3)
 104 #endif
 105     testPair jaccard "lucky"   "lucky"   (1 % 1)
 106
 107 -- | Test that given function returns the same results when order of
 108 -- arguments is swapped.
 109
 110 testSwap :: (Eq a, Show a) => (Text -> Text -> a) -> SpecWith ()
 111 testSwap f = context "if we swap the arguments" $
 112   it "produces the same result" $
 113     property $ \a b -> f a b === f b a
 114
 115 -- | Create spec for given metric function applying it to two 'Text' values
 116 -- and comparing the result with expected one.
 117
 118 testPair :: (Eq a, Show a)
 119   => (Text -> Text -> a) -- ^ Function to test
 120   -> Text              -- ^ First input
 121   -> Text              -- ^ Second input
 122   -> a                 -- ^ Expected result
 123   -> SpecWith ()
 124 testPair f a b r = it ("‘" ++ T.unpack a ++ "’ and ‘" ++ T.unpack b ++ "’") $
 125   f a b `shouldBe` r