reanimate-0.4.2.0: test/Properties.hs

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -w      #-}
{-# LANGUAGE TemplateHaskell      #-}
module Properties where

import qualified Data.Vector            as V
import           Linear.V2
import           Linear.Vector
import           Test.QuickCheck
import           Test.Tasty
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 p = pIsSimple p

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_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