{-# LANGUAGE BlockArguments #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} module Spec.DMat4 (tests) where import Hedgehog import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) import Linear qualified import Linear ((!*!)) import Geomancy.DMat4 qualified import Geomancy.DVec4 qualified import Geomancy.Mat4 ((!*)) import Geomancy.Transform qualified as Transform import Support.Ball (balls, balls44, consistent, enclosed, narrow, widen) import Support.Gen (forAllDTransform, forAllTransform, genDVec4, genEdgeScalar, genMostlySame, genVec4) import Support.Linear (entries, toM44, toM44D, toV4, toV4D) import Support.Property (pattern PROP_TESTS) import Support.Reference.Mat4 qualified as Ref.Mat4 tests :: TestTree tests = testGroup "DMat4" [ testPropertyNamed "assoc" "prop_dmat4_assoc" prop_dmat4_assoc , testPropertyNamed "order" "prop_dmat4_order" prop_dmat4_order , testPropertyNamed "eq" "prop_dmat4_eq" prop_dmat4_eq , testPropertyNamed "det" "prop_dmat4_det" prop_dmat4_det , testPropertyNamed "inverse" "prop_dmat4_inverse" prop_dmat4_inverse , testPropertyNamed "apply" "prop_dmat4_apply" prop_dmat4_apply , testPropertyNamed "float_parity" "prop_dmat4_float_parity" prop_dmat4_float_parity ] prop_dmat4_assoc :: Property prop_dmat4_assoc = withDiscards 1000 . withTests PROP_TESTS $ property do (p, p_) <- forAllDTransform (v, v_) <- forAllDTransform (m, m_) <- forAllDTransform let pv'm = (p <> v) <> m p'vm = p <> (v <> m) pv'mBall = Ref.Mat4.compose (Ref.Mat4.compose (balls44 p_) (balls44 v_)) (balls44 m_) p'vmBall = Ref.Mat4.compose (balls44 p_) (Ref.Mat4.compose (balls44 v_) (balls44 m_)) replicate 16 Nothing === enclosed (entries pv'mBall) (entries (toM44D pv'm)) replicate 16 Nothing === enclosed (entries p'vmBall) (entries (toM44D p'vm)) let mv_p = (m_ !*! v_) !*! p_ m_vp = m_ !*! (v_ !*! p_) mv_pBall = (balls44 m_ !*! balls44 v_) !*! balls44 p_ m_vpBall = balls44 m_ !*! (balls44 v_ !*! balls44 p_) replicate 16 Nothing === enclosed (entries mv_pBall) (entries mv_p) replicate 16 Nothing === enclosed (entries m_vpBall) (entries m_vp) replicate 16 Nothing === consistent (entries pv'mBall) (entries p'vmBall) replicate 16 Nothing === consistent (entries mv_pBall) (entries m_vpBall) replicate 16 Nothing === consistent (entries pv'mBall) (entries mv_pBall) prop_dmat4_order :: Property prop_dmat4_order = withTests 1 $ property do let cm = Geomancy.DMat4.colMajor @Geomancy.DMat4.DMat4 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 rm = Geomancy.DMat4.rowMajor @Geomancy.DMat4.DMat4 0 4 8 2 1 5 9 3 2 6 0 4 3 7 1 5 Geomancy.DMat4.toListColMajor2d cm === Geomancy.DMat4.toListColMajor2d rm let cmT = Geomancy.DMat4.transpose cm rmT = Geomancy.DMat4.transpose rm Geomancy.DMat4.toListColMajor2d cmT === Geomancy.DMat4.toListColMajor2d rmT prop_dmat4_det :: Property prop_dmat4_det = withTests 1 $ property do 1 === Geomancy.DMat4.det Geomancy.DMat4.identity 1 === Geomancy.DMat4.det (Geomancy.DMat4.fromMat4 $ Transform.translate 1 2 3) 0 === Geomancy.DMat4.det (Geomancy.DMat4.fromMat4 $ Transform.scaleX 0) -1 === Geomancy.DMat4.det (Geomancy.DMat4.fromMat4 $ Transform.scaleZ (-1)) 8 === Geomancy.DMat4.det (Geomancy.DMat4.fromMat4 $ Transform.scale 2) (1/8) === Geomancy.DMat4.det (Geomancy.DMat4.fromMat4 $ Transform.scale (1/2)) prop_dmat4_inverse :: Property prop_dmat4_inverse = withDiscards 1000 . withTests PROP_TESTS $ property do (m, m_) <- forAllDTransform let mm' = m <> Geomancy.DMat4.inverse m mBall = balls44 m_ mm'Ball = Ref.Mat4.compose mBall (Ref.Mat4.inverse mBall) annotateShow mm' replicate 16 Nothing === enclosed (entries mm'Ball) (entries (toM44D mm')) replicate 16 Nothing === enclosed (entries mm'Ball) (entries (Linear.identity :: Linear.M44 Double)) prop_dmat4_apply :: Property prop_dmat4_apply = withDiscards 1000 . withTests PROP_TESTS $ property do (m, m_) <- forAllDTransform v <- forAll genDVec4 let out = m Geomancy.DMat4.!* v out_ = toV4D v Linear.*! m_ outBall = Ref.Mat4.apply (balls44 m_) (balls (toV4D v)) out_Ball = balls (toV4D v) Linear.*! balls44 m_ annotateShow out annotateShow out_ replicate 4 Nothing === enclosed outBall (toV4D out) replicate 4 Nothing === enclosed out_Ball out_ replicate 4 Nothing === consistent outBall out_Ball prop_dmat4_float_parity :: Property prop_dmat4_float_parity = withDiscards 1000 . withTests PROP_TESTS $ property do (a, a_) <- forAllTransform (b, b_) <- forAllTransform let viaDouble = Geomancy.DMat4.toMat4 $ Geomancy.DMat4.fromMat4 a <> Geomancy.DMat4.fromMat4 b widened = fmap (fmap widen) . balls44 viaDoubleBall = fmap (fmap narrow) $ Ref.Mat4.compose (widened a_) (widened b_) viaFloatBall = Ref.Mat4.compose (balls44 a_) (balls44 b_) replicate 16 Nothing === enclosed (entries viaDoubleBall) (entries (toM44 viaDouble)) replicate 16 Nothing === enclosed (entries viaFloatBall) (entries (toM44 (a <> b))) replicate 16 Nothing === consistent (entries viaDoubleBall) (entries viaFloatBall) v <- forAll genVec4 let viaDoubleV = Geomancy.DVec4.toVec4 $ Geomancy.DMat4.fromMat4 a Geomancy.DMat4.!* Geomancy.DVec4.fromVec4 v viaDoubleVBall = fmap narrow $ Ref.Mat4.apply (widened a_) (fmap widen (balls (toV4 v))) viaFloatVBall = Ref.Mat4.apply (balls44 a_) (balls (toV4 v)) replicate 4 Nothing === enclosed viaDoubleVBall (toV4 viaDoubleV) replicate 4 Nothing === enclosed viaFloatVBall (toV4 (a !* v)) replicate 4 Nothing === consistent viaDoubleVBall viaFloatVBall prop_dmat4_eq :: Property prop_dmat4_eq = withTests PROP_TESTS $ property do let four = Gen.list (Range.singleton 4) fromRows = evalMaybe . Geomancy.DMat4.fromRowMajor2d @[] @Geomancy.DMat4.DMat4 rowsA <- forAll $ four (four genEdgeScalar) rowsB <- forAll $ traverse (traverse (genMostlySame 8)) rowsA a <- fromRows rowsA b <- fromRows rowsB label $ if rowsA == rowsB then "equal" else "different" (a == b) === (rowsA == rowsB) (a /= b) === (rowsA /= rowsB)