simple-vec3-0.5: 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 element 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))
  ]