ms-0.1: tests/test.hs

import Data.Profunctor
import qualified Data.Vector as V
import Math.MetricSpace
import Test.Tasty
import Test.Tasty.QuickCheck as QC

data SameLengthVector3 a = SameLengthVector3 (V.Vector a) (V.Vector a) (V.Vector a) deriving Show

main = defaultMain $ opts tests
  where
    opts = localOption (QuickCheckTests 3000)

tests :: TestTree
tests = testGroup "Tests" [properties]

properties :: TestTree
properties = testGroup "Properties" [qcProps]

nonnegative :: (Num b, Ord b) => MetricSpace a b -> a -> a -> Bool
nonnegative m a b = dist m a b >= 0

indisc :: (Eq b, Num b) => MetricSpace a b -> a -> Bool
indisc m a = dist m a a == 0

symmetry :: Eq b => MetricSpace a b -> a -> a -> Bool
symmetry m a b = dist m a b == dist m b a

triangle :: (Num b, Ord b) => MetricSpace a b -> a -> a -> a -> Bool
triangle m a b c = dist m a c <= dist m a b + dist m b c

instance (Arbitrary a) => Arbitrary (V.Vector a) where
  arbitrary = fmap V.fromList arbitrary

triangleVect
  :: (Num b, Ord b, Show a, Arbitrary a) =>
     MetricSpace (V.Vector a) b -> V.Vector a -> Property
triangleVect m xs =
  forAll (vectorOf (V.length xs) arbitrary) $ \ys ->
  forAll (vectorOf (V.length xs) arbitrary) $ \zs -> triangle m xs (V.fromList ys) (V.fromList zs)

genTestGroup
  :: (Num b, Ord b, Show a, Arbitrary a, Eq a) =>
     TestName -> MetricSpace a b -> TestTree
genTestGroup name metric =
  testGroup name [
        QC.testProperty "nonnegative" $ \a b -> nonnegative metric a b
      , QC.testProperty "indisc" $ \a -> indisc metric a
      , QC.testProperty "symmetry" $ \a b -> symmetry metric a b
      , QC.testProperty "triangle" $ \a b -> triangle metric a b
      , QC.testProperty "profunctor lmap" $ \a b -> dist (lmap id metric) a b == dist metric a b
      , QC.testProperty "profunctor rmap" $ \a b -> dist (rmap id metric) a b == dist metric a b
    ]

genTestGroupV
  :: (Num b, Ord b, Show a, Arbitrary a, Eq a) =>
     TestName -> MetricSpace (V.Vector a) b -> TestTree
genTestGroupV name metric =
  testGroup name [
        QC.testProperty "nonnegative" $ \a b -> nonnegative metric a b
      , QC.testProperty "indisc" $ \a -> indisc metric a
      , QC.testProperty "symmetry" $ \a b -> symmetry metric a b
      -- TODO:
      --, QC.testProperty "triangle" $ triangleVect metric
      , QC.testProperty "profunctor lmap" $ \a b -> dist (lmap id metric) a b == dist metric a b
      , QC.testProperty "profunctor rmap" $ \a b -> dist (rmap id metric) a b == dist metric a b
    ]

qcProps = testGroup "(checked by QuickCheck)"
  [
    genTestGroup "levenshtein" levenshtein

    -- Double
  , testGroup "Double" [
        genTestGroupV "discrete" (discrete :: MetricSpace (V.Vector Double) Double)
      , genTestGroupV "euclidean" (euclidean :: MetricSpace (V.Vector Double) Double)
      , genTestGroupV "taxicab" (taxicab :: MetricSpace (V.Vector Double) Double)
    ]

    -- Float
  , testGroup "Float" [
        genTestGroupV "discrete" (discrete :: MetricSpace (V.Vector Float) Float)
      , genTestGroupV "euclidean" (euclidean :: MetricSpace (V.Vector Float) Float)
      , genTestGroupV "taxicab" (taxicab :: MetricSpace (V.Vector Float) Float)
    ]
  ]