Implement basic tests for polygons

master
Simon Bruder 2022-12-28 00:17:57 +01:00
parent eacbfc4c3b
commit 71b6ac2eed
Signed by: simon
GPG Key ID: 8D3C82F9F309F8EC
1 changed files with 33 additions and 2 deletions

View File

@ -2,13 +2,25 @@
module Test where module Test where
import Main (Vertex (Point), fromAngle, move, scale, vertexDistance) import Data.List (partition)
import Test.QuickCheck (discard, quickCheck, quickCheckAll) import Main (PolygonPath (PolygonPath), Vertex (Point), fromAngle, move, regularPolygon, scale, star, vertexDistance)
import Test.QuickCheck (Arbitrary (arbitrary), Positive, chooseInteger, discard, getPositive, quickCheck, quickCheckAll)
newtype PolygonVertexCount a = PolygonVertexCount a deriving (Show)
instance Integral a => Arbitrary (PolygonVertexCount a) where
arbitrary = do
x <- chooseInteger (3, 1000)
return $ PolygonVertexCount (fromIntegral x)
-- | the largest acceptable difference between two doubles so they are considered equal -- | the largest acceptable difference between two doubles so they are considered equal
epsilon :: Double epsilon :: Double
epsilon = 1e-10 epsilon = 1e-10
getVertices :: Maybe PolygonPath -> [Vertex]
getVertices (Just (PolygonPath ps)) = ps
getVertices Nothing = []
-- | checks whether the distance of a vertex constructed by 'fromAngle' to the origin is 1 -- | checks whether the distance of a vertex constructed by 'fromAngle' to the origin is 1
prop_VertexFromAngleDistance :: Double -> Bool prop_VertexFromAngleDistance :: Double -> Bool
prop_VertexFromAngleDistance angle = abs (1 - vertexDistance (fromAngle angle)) < epsilon prop_VertexFromAngleDistance angle = abs (1 - vertexDistance (fromAngle angle)) < epsilon
@ -25,6 +37,25 @@ prop_MoveSelfEqualsScale2 p = move p p == scale 2 p
prop_MoveNegativeSelfEqualsOrigin :: Vertex -> Bool prop_MoveNegativeSelfEqualsOrigin :: Vertex -> Bool
prop_MoveNegativeSelfEqualsOrigin p = move p (scale (-1) p) == Point (0, 0) prop_MoveNegativeSelfEqualsOrigin p = move p (scale (-1) p) == Point (0, 0)
-- | checks whether distance of points of a regular polygon have the radius as distance from the origin
prop_RegularPolygonPointsDistance :: Integral a => (PolygonVertexCount a, Positive Double) -> Bool
prop_RegularPolygonPointsDistance (PolygonVertexCount n, r) = all (\p -> abs (vertexDistance p - getPositive r) < epsilon) (getVertices (regularPolygon (fromIntegral n) (getPositive r) (Point (0, 0))))
-- | checks whether the average of all polygon points equals the specified centre point
prop_RegularPolygonCentre :: (Integral a) => (PolygonVertexCount a, Positive Double, Vertex) -> Bool
prop_RegularPolygonCentre (PolygonVertexCount n, r, p) = abs (specX - calcX) < epsilon && abs (specY - calcY) < epsilon
where
Point (specX, specY) = p
Point (calcX, calcY) = scale (1 / fromIntegral n) $ foldr move (Point (0, 0)) (getVertices (regularPolygon (fromIntegral n) (getPositive r) p))
-- | checks whether the distance of all points of a star from the centre can be partitioned into two classes,
-- both of the same size, the number of spikes
prop_StarDistancePartitioning :: (Integral a) => (PolygonVertexCount a, Positive Double, Positive Double) -> Bool
prop_StarDistancePartitioning (PolygonVertexCount n, r1, r2) = length c1 == length c2 && length c1 == fromIntegral n
where
(c1, c2) = partition (\x -> abs (getPositive r1 - vertexDistance x) > abs (getPositive r2 - vertexDistance x)) vertices
vertices = getVertices (star (fromIntegral n) (getPositive r1) (getPositive r2) (Point (0, 0)))
return [] return []
check = $quickCheckAll check = $quickCheckAll