simple-vec3-0.4: tests/Main.hs

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Proxy

import Test.Tasty
import Test.Tasty.QuickCheck

import Data.Vec3


infix 4 <~=>
(<~=>) :: forall v1 v2. (Vec3 v1, Vec3 v2) => v1 -> v2 -> Bool
(<~=>) a b = ax ~= bx &&
             ay ~= by &&
             az ~= bz
  where
    (ax, ay, az) = toXYZ (a :: v1)
    (bx, by, bz) = toXYZ (b :: v2)


infix 4 ~=
(~=) :: Double -> Double -> Bool
(~=) a b | a == b = True
         | a == 0 || b == 0 || isDenormalized absDiff = absDiff < maxError
         | otherwise = absDiff / (abs a + abs b) < maxError
  where
    absDiff = abs $ a - b
    maxError = 1e-13


tests
  :: forall ty.
     ( Arbitrary ty, Arbitrary (Matrix ty)
     , Show ty, Show (Matrix ty)
     , Vec3 ty, Eq ty
     )
  => Proxy ty
  -> [TestTree]
tests _ =
  [ testProperty
    "Commutativity of addition: a + b = b + a"
    (\(a :: ty) b -> a <+> b <~=> b <+> a)
  , testProperty
    "Associativity of addition: (a + b) + c = a + (b + c)"
    (\(a :: ty) b c -> (a <+> b) <+> c <~=> a <+> (b <+> c))
  , testProperty
    "Identity element of addition (zero): v + 0 = v"
    (\(v :: ty) -> (v <+> origin <~=> v))
  , testProperty
    "Inverse elements of addition: v + (-v) = 0"
    (\(v :: ty) -> (v <+> invert v <~=> (origin :: ty)))
  , testProperty
    "Compatibility of scalar and field multiplication"
    (\(v :: ty) p q -> (v .^ p .^ q <~=> v .^ (p * q)))
  , testProperty
    "Identity of scalar multiplication"
    (\(v :: ty) -> (v .^ 1 <~=> v))
  , testProperty
    "Distributivity wrt vector addition"
    (\(a :: ty) b p -> ((a <+> b) .^ p) <~=> (a .^ p) <+> (b .^ p))
  , testProperty
    "Distributivity wrt scalar addition"
    (\(a :: ty) p q -> (a .^ (p + q) <~=> (a .^ p) <+> (a .^ q)))
  , testProperty
    "Subtraction definition"
    (\(a :: ty) b -> (a <+> invert b <~=> a <-> b))
  , testProperty
    "Normalization"
    (\(v :: ty) -> (v <~=> (origin :: ty) || norm (normalize v) ~= 1))
  , testProperty
    "Triangle inequality"
    (\(a :: ty) b c -> (distance a b + distance b c >= distance a c))
  , testProperty
    "Diagonal matrix multiplication"
    (\(v :: ty) (s :: Double) -> (diag s `mxv` v == v .^ s))
  ]


main :: IO ()
main = defaultMain $ testGroup "Tests"
  [ testGroup "CVec3" (tests (Proxy :: Proxy CVec3))
  , testGroup "TVec3" (tests (Proxy :: Proxy TVec3))
  ]