mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-09 15:12:21 +00:00
99 lines
2.7 KiB
Haskell
99 lines
2.7 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# OPTIONS_GHC -w #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Properties where
|
|
|
|
import Test.Tasty
|
|
|
|
#if !defined(NO_HGEOMETRY)
|
|
|
|
import qualified Data.Vector as V
|
|
import Linear.V2
|
|
import Linear.Vector
|
|
import Test.QuickCheck
|
|
import Test.Tasty.QuickCheck
|
|
|
|
import Reanimate.Math.Common
|
|
import Reanimate.Math.Polygon
|
|
import Reanimate.Math.SSSP
|
|
import Reanimate.Math.Triangulate
|
|
import Helpers
|
|
|
|
import Debug.Trace
|
|
|
|
|
|
|
|
prop_pGenerate (PolyParam a) (PolyParam b) (PolyParam c) (PolyParam d) =
|
|
pIsSimple $ pGenerate [a,b,c,d]
|
|
|
|
prop_pIsSimple = pIsSimple
|
|
|
|
prop_isBetween a b = percent $ \t ->
|
|
a /= b ==>
|
|
isBetween (lerp t a b) (a,b) &&
|
|
isBetween a (a,b) &&
|
|
isBetween b (a,b)
|
|
|
|
prop_isBetweenAxis a = percent $ \t ->
|
|
let b = a + V2 0 1
|
|
c = a + V2 1 0 in
|
|
isBetween (lerp t a b) (a,b) &&
|
|
isBetween (lerp t a c) (a,c)
|
|
|
|
prop_isNotBetween a b = forAll (choose (1.1,100)) $ \t ->
|
|
a /= 0 && b /= 0 ==>
|
|
not (isBetween (lerp (realToFrac (t::Double)) a b :: V2 Rational) (a,b))
|
|
|
|
prop_winding = forAll (choose (1,100)) $ \n -> pIsSimple (pMkWinding n)
|
|
|
|
prop_ccw p = label (if pIsConvex p then "convex" else "concave") $ pIsCCW p
|
|
prop_rev_ccw p = not $ pIsCCW (mkPolygon $ V.reverse $ polygonPoints p)
|
|
prop_pCycle p = forAll (choose (0,1)) $ \t ->
|
|
pIsSimple (pCycle p t)
|
|
|
|
-- prop_validEarClip p = isValidTriangulation p (earClip $ pRing p)
|
|
|
|
-- prop_validEarCut p = isValidTriangulation p (earCut $ pRing p)
|
|
|
|
prop_validMonotone p = isValidTriangulation p (triangulate $ pRing p)
|
|
|
|
-- dualToTrangulation . dual = id
|
|
prop_dualInv p =
|
|
let t = polygonTriangulation p in
|
|
dualToTriangulation (pRing p) (dual (polygonOffset p) t) == t
|
|
|
|
prop_ssspEq p =
|
|
pSize p < 20 ==>
|
|
naive (pRing p) == polygonSSSP p V.! 0
|
|
|
|
prop_ssspEq2 :: Polygon -> Bool
|
|
prop_ssspEq2 p =
|
|
let t = polygonTriangulation p
|
|
d = dual (polygonOffset p) t
|
|
in sssp (pRing p) d == ssspFinger (pRing p) d
|
|
|
|
prop_ssspSize :: Polygon -> Bool
|
|
prop_ssspSize p =
|
|
length (sssp (pRing p) (dual 0 $ polygonTriangulation p)) == pSize p
|
|
|
|
prop_pCuts p =
|
|
pSize p < 20 ==>
|
|
all (\(l,r) -> pIsSimple l && pIsSimple r) (pCuts p)
|
|
|
|
prop_ssspVisibilityLength (Parameters xs) =
|
|
let p = pGenerate xs in
|
|
pSize (ssspVisibility p) <= pSize p
|
|
|
|
prop_dualCycle p = forAll (choose (0,pSize p-1)) $ \n ->
|
|
let p1 = pSetOffset p n
|
|
p2 = pCopy p1
|
|
in and [ pParent p1 0 i == pParent p2 0 i | i <- [0.. pSize p-1] ]
|
|
|
|
return []
|
|
all_props :: TestTree
|
|
all_props = testProperties "properties" $allProperties
|
|
#else
|
|
all_props :: TestTree
|
|
all_props = testGroup "properties" []
|
|
#endif
|