From cf58c36fc463984e4edfc73061c90aff264bd8ae Mon Sep 17 00:00:00 2001 From: pddla Date: Thu, 2 Apr 2020 15:28:45 -0700 Subject: [PATCH] added more tests for skellygen --- package.yaml | 2 + src/AnimalClub/Animals/Animal.hs | 5 ++ src/AnimalClub/Animals/Examples/Goat.hs | 7 +- src/AnimalClub/Skellygen/AnimalNode.hs | 3 +- src/AnimalClub/Skellygen/AnimalScript.hs | 12 ++-- src/AnimalClub/Skellygen/Mesh.hs | 3 +- src/AnimalClub/Skellygen/Skellygen.hs | 44 +++++++++--- test/AnimalClub/SkellygenSpec.hs | 92 +++++++++++++++++++----- 8 files changed, 128 insertions(+), 40 deletions(-) diff --git a/package.yaml b/package.yaml index 57e8942..8f6b904 100644 --- a/package.yaml +++ b/package.yaml @@ -88,6 +88,7 @@ dependencies: - convertible - storable-record - relude +- monad-extras library: source-dirs: src @@ -245,6 +246,7 @@ verbatim: | , convertible , storable-record , relude + , monad-extras hs-source-dirs: src c-sources: csrc/animalclub.cpp diff --git a/src/AnimalClub/Animals/Animal.hs b/src/AnimalClub/Animals/Animal.hs index 6d12efb..3833db3 100644 --- a/src/AnimalClub/Animals/Animal.hs +++ b/src/AnimalClub/Animals/Animal.hs @@ -9,6 +9,7 @@ Stability : experimental module AnimalClub.Animals.Animal ( + relV3, asPhantom, mans, manf, manbt, AnimalExp(..), @@ -35,6 +36,10 @@ import Control.Monad.Writer (tell) --import Control.Exception (assert) --import Debug.Trace (trace) + +relV3 :: (AnimalFloat a) => a -> a -> a -> AbsOrRel (V3 a) +relV3 x y z = Rel $ V3 x y z + -- | set the AnimalNode as the root node asPhantom :: AnimalNode a -> AnimalNode a asPhantom an = an { _isPhantom = True } diff --git a/src/AnimalClub/Animals/Examples/Goat.hs b/src/AnimalClub/Animals/Examples/Goat.hs index c9ff3d1..33889e6 100644 --- a/src/AnimalClub/Animals/Examples/Goat.hs +++ b/src/AnimalClub/Animals/Examples/Goat.hs @@ -17,11 +17,6 @@ import AnimalClub.Skellygen.Linear import AnimalClub.Skellygen.TRS --- | whatever helper - -relV3 :: (AnimalFloat a) => a -> a -> a -> AbsOrRel (V3 a) -relV3 x y z = Rel $ V3 x y z - {- goat ↑ Y @@ -130,6 +125,6 @@ octopusWorm = asPhantom $ mans "root" (relV3 0 0 0) (Abs 0.2) $ map (\r -> flipAnimalNode (rotateArbTrans (r*2*pi/8)) (defTransFlag Same) flipWorm) [0..7] --- | Animalnode representation of canonical cube +-- | AnimalNode representation of canonical cube, sorta cube :: AnimalNode Float cube = asPhantom $ mans "root" (relV3 0 0 0) (Abs 1.0) [mans "end" (relV3 1 0 0) (Rel 1.0) []] diff --git a/src/AnimalClub/Skellygen/AnimalNode.hs b/src/AnimalClub/Skellygen/AnimalNode.hs index 09bbbf7..01bfe32 100644 --- a/src/AnimalClub/Skellygen/AnimalNode.hs +++ b/src/AnimalClub/Skellygen/AnimalNode.hs @@ -162,6 +162,7 @@ applyBoneTrans (ArbTrans f) = f -- each Node is a "limb" between the node's position and its parent -- if it is the top level node, it's parent assumes origin position -- if it is a phantom node, it won't have an associated mesh but otherwise is the same +-- note that any top level node is effectively a phantom node -- -- orientations are automatically determined based on parent position (see comments in AnimalScript) -- positions and thickness can be specified as absolute or relative for convenience I guess @@ -178,7 +179,7 @@ data AnimalNode a = AnimalNode { _isPhantom :: Bool, -- ^ if this is true, this node will be invisible (won't create a mesh) _children :: [AnimalNode a] -- _nodeOrientation :: NodeOrientation -} deriving (Generic, NFData) +} deriving (Generic, NFData, Show) makeLenses ''AnimalNode diff --git a/src/AnimalClub/Skellygen/AnimalScript.hs b/src/AnimalClub/Skellygen/AnimalScript.hs index a473c46..d2e2057 100644 --- a/src/AnimalClub/Skellygen/AnimalScript.hs +++ b/src/AnimalClub/Skellygen/AnimalScript.hs @@ -19,6 +19,7 @@ import Lens.Micro.Platform (makeLenses, set) import AnimalClub.Skellygen.AnimalNode import AnimalClub.Skellygen.AnimalProperty import AnimalClub.Skellygen.Linear +import AnimalClub.Skellygen.Mesh import qualified AnimalClub.Skellygen.Skellygen as SN import AnimalClub.Skellygen.TRS @@ -215,11 +216,12 @@ toSkellyNode props cn = outsn where prop = getAnimalProperty (_name' cn) props skellyChildren = map (toSkellyNode props) (_children' cn) outsn = SN.SkellyNode { - SN._snDebugName = show (_name' cn), - SN._snIsPhantom = _isPhantom' cn, - SN._snChildren = skellyChildren, - SN._snM44Rel = _m44RelFinal' cn, - SN._snThickness = _skinParams prop * _thickness' cn -- combine with base thickness multiplicatively + SN._snDebugName = show (_name' cn) + , SN._snIsPhantom = _isPhantom' cn + , SN._snChildren = skellyChildren + , SN._snM44Rel = _m44RelFinal' cn + , SN._snThickness = _skinParams prop * _thickness' cn -- combine with base thickness multiplicatively + , SN._snDebugMesh = emptyPotatoMesh } -- | convert Animal Node to Skellygen diff --git a/src/AnimalClub/Skellygen/Mesh.hs b/src/AnimalClub/Skellygen/Mesh.hs index 2528abe..274f597 100644 --- a/src/AnimalClub/Skellygen/Mesh.hs +++ b/src/AnimalClub/Skellygen/Mesh.hs @@ -49,12 +49,11 @@ data PotatoMesh a = PotatoMesh { , normals :: V.Vector (V3 a) , texCoords :: V.Vector (V2 a) , indices :: V.Vector Face -} deriving (Generic, NFData) +} deriving (Generic, NFData, Show) emptyPotatoMesh :: (AnimalFloat a) => PotatoMesh a emptyPotatoMesh = PotatoMesh V.empty V.empty V.empty V.empty - -- this can probably be improved even more to take advantage of stream fusion concatPotatoMesh :: (AnimalFloat a) => [PotatoMesh a] -> PotatoMesh a concatPotatoMesh pms = r where diff --git a/src/AnimalClub/Skellygen/Skellygen.hs b/src/AnimalClub/Skellygen/Skellygen.hs index 62b210b..22479ed 100644 --- a/src/AnimalClub/Skellygen/Skellygen.hs +++ b/src/AnimalClub/Skellygen/Skellygen.hs @@ -5,11 +5,13 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} -module AnimalClub.Skellygen.Skellygen - ( SkellyNode(..) - , generateLocalMesh +module AnimalClub.Skellygen.Skellygen( + SkellyNode(..) , generatePotatoMesh - ) where + , generatePotatoMeshWithDebugging + + , generateLocalMesh +) where import Relude hiding (identity) import Relude.Unsafe ((!!)) @@ -71,6 +73,7 @@ data SkellyNode a = SkellyNode , _snChildren :: [SkellyNode a] , _snM44Rel :: M44 a -- ^ relative to parent , _snThickness :: a -- ^ base physical size of joint. + , _snDebugMesh :: PotatoMesh a -- ^ for debugging and testing purposes only } deriving (Show, Generic, NFData) --dummyParent :: SkellyNode @@ -151,8 +154,6 @@ generateSinglePotatoMesh pos ct pt = , indices = G.fromList $ i } --- TODO parallelize --- go through all children and accumulate [PotatoMesh a] then use G.concat _generatePotatoMesh :: (AnimalFloat a) => M44 a -- ^ parent ABS transform @@ -168,17 +169,44 @@ _generatePotatoMesh p_snM44 p_thick skn = selfLocalMesh :| (mconcat cmeshes) whe absM44 = p_snM44 !*! relm44 cmeshes = parMap rdeepseq (toList . _generatePotatoMesh absM44 thick) (_snChildren skn) --- TODO switch to G.concat +-- | same as _generatePotatoMesh except populates snDebugMesh +_generatePotatoMeshWithDebugging :: + (AnimalFloat a) + => M44 a -- ^ parent ABS transform + -> a -- ^ parent thickness + -> SkellyNode a -- ^ node to generate + -> (SkellyNode a, NonEmpty (PotatoMesh a)) -- ^ output mesh and SkellyNode with debug mesh populated +_generatePotatoMeshWithDebugging p_snM44 p_thick skn = (rSN, rMesh) where + thick = _snThickness skn + relm44 = _snM44Rel skn + selfLocalMesh = if _snIsPhantom skn + then emptyPotatoMesh + else transformPotatoMeshM44 p_snM44 $ generateSinglePotatoMesh relm44 thick p_thick + absM44 = p_snM44 !*! relm44 + (children, cmeshes) = unzip $ parMap rdeepseq (over _2 toList . _generatePotatoMeshWithDebugging absM44 thick) (_snChildren skn) + rMesh = selfLocalMesh :| (mconcat cmeshes) + rSN = skn { _snChildren = children, _snDebugMesh = selfLocalMesh } + generatePotatoMesh :: (AnimalFloat a) => SkellyNode a -- ^ input top level parent node -> PotatoMesh a -- ^ output mesh generatePotatoMesh skn = concatPotatoMesh . toList $ _generatePotatoMesh identity 1.0 skn +-- | same as generatePotatoMesh except returns SkellyNode with populated _snDebugMesh +generatePotatoMeshWithDebugging :: + (AnimalFloat a) + => SkellyNode a -- ^ input top level parent node + -> (SkellyNode a, PotatoMesh a) -- ^ output top level parent and mesh +generatePotatoMeshWithDebugging skn = (sn, concatPotatoMesh . toList $ pm) where + (sn, pm) = _generatePotatoMeshWithDebugging identity 1.0 skn + + + --- old local mesh stuff +-- old local mesh stuff CAN DELETE generateSingleLocalMesh :: (AnimalFloat a) => M44 a -- ^ input node transform diff --git a/test/AnimalClub/SkellygenSpec.hs b/test/AnimalClub/SkellygenSpec.hs index 7129de4..69c05b6 100644 --- a/test/AnimalClub/SkellygenSpec.hs +++ b/test/AnimalClub/SkellygenSpec.hs @@ -9,45 +9,96 @@ import Relude import Test.Hspec import Test.HUnit import Test.QuickCheck +import Linear.Arbitrary +import Control.Monad.Extra +import qualified Data.Vector.Generic as V import qualified Text.Show +import System.Random +import Lens.Micro.Platform +import AnimalClub.Animals import AnimalClub.Skellygen import AnimalClub.Skellygen.Linear hiding (trace) +import AnimalClub.Skellygen.Mesh import AnimalClub.Skellygen.TRS -import Linear.Arbitrary - --import Debug.Trace --- TODO finish -{- -instance (Arbitrary a) => Arbitrary (AnimalNode a) where +splitSize :: Int -> Gen [Int] +splitSize = unfoldM f where + f s = do + if s == 0 + then return Nothing + else do + x <- choose (1,s) + return $ Just (x, s-x) + +instance (Arbitrary a, Random a, AnimalFloat a) => Arbitrary (AnimalNode a) where arbitrary = sized arb where - arb 0 = do + arb n = do pos <- arbitrary + csize <- if n <= 1 + then return [] + else splitSize n + children <- mapM (\s -> resize s arbitrary) csize + th <- choose (0.1,10) return AnimalNode { - _name = undefined - , _pos = Abs pos - , _thickness = undefined - , _isPhantom = True - , _children = [] + _name = BoneId "blank" [] + , _boneTrans = Same + , _pos = Rel pos + , _thickness = Abs th + , _isPhantom = False + , _children = children } --} --- TODO flips an animal node using ReflX --- and checks that all X coordinates cancel out ---prop_flipAnimalNode_ReflX :: Bool +-- notably, default instance does not cover ArbTrans case +instance (Arbitrary a) => Arbitrary (BoneTrans a) where + arbitrary = elements [ReflX, ReflY, ReflZ] + +-- | adds up all coordinates in PotatoMesh +-- only for testing +sumPositionsAndNormalsForTesting :: (AnimalFloat a) => PotatoMesh a -> (V3 a, V3 a) +sumPositionsAndNormalsForTesting (PotatoMesh p n _ _) = (V.sum p, V.sum n) + + +-- | tests the property that coordinates of any mesh generated by flipping an animal node add up to 0 +-- N.B. this test does not work for Float as machine roundoff starts compounding and growing ¯\_(ツ)_/¯ +prop_flipAnimalNode_Refl :: (AnimalFloat a) => BoneTrans a -> AnimalNode a -> Bool +prop_flipAnimalNode_Refl bt an = r where + withFlip = asPhantom $ mans "test_root" (relV3 0 0 0) (Abs 1.0) + [an, flipAnimalNode bt (defTransFlag bt) an] + pm = generatePotatoMesh . animalNodeToSkellyNode $ withFlip + (ps,ns) = sumPositionsAndNormalsForTesting pm + l = case bt of + ReflX -> _x + ReflY -> _y + ReflZ -> _z + _ -> undefined + eps = 0.00001 + r = (view l ps < eps) && (view l ns < eps) + + -- TODO spins an animal node around several times (total 360 degrees) -- and checks that all coordinates around spun axis add to 0 --prop_flipAnimalNode_Spin :: Bool --- TODO creates an animalNode using flipAnimalNode twice and checks that the nodes that got flipped twice match their unflipped values ---spec_flipAnimalNode_Twice :: Bool - +-- | checks that the nodes that got flipped twice match their unflipped values +prop_flipAnimalNode_Twice :: (AnimalFloat a, Epsilon a) => BoneTrans a -> AnimalNode a -> Bool +prop_flipAnimalNode_Twice bt an = r where + flipOnce = flipAnimalNode bt (defTransFlag bt) an + flipTwice = flipAnimalNode bt (defTransFlag bt) flipOnce + pm_orig = generatePotatoMesh . animalNodeToSkellyNode $ an + pm_flipTwice = generatePotatoMesh . animalNodeToSkellyNode $ flipTwice + -- cheap way to test if the two meshes are the same + -- we could prob do better here and test that the two meshes are identical but whatever + (ps,ns) = sumPositionsAndNormalsForTesting pm_orig + (ps',ns') = sumPositionsAndNormalsForTesting pm_flipTwice + r = nearZero (ps - ps') && nearZero (ns - ns') -- math stuff +-- TODO move to a new file -- | this only generates "nice" TRS (nothing weird going on in scale component) instance (Arbitrary a, AnimalFloat a) => Arbitrary (TRS a) where @@ -82,6 +133,11 @@ spec_fromEulerXYZ = do spec :: Spec spec = do + describe "Skellygen" $ do + it "satisfies property that reflected node coordinates all add up to 0 in reflected coordinate" $ + property (prop_flipAnimalNode_Refl @Double) + it "satisfies property that reflecting twice gives the same thing" $ + property (prop_flipAnimalNode_Twice @Double) describe "TRS" $ do it "mul_TRS_V3 works as expected" $ property $ prop_mul_TRS_V3