Implement basic tests for polygons

This commit is contained in:
Simon Bruder 2022-12-28 00:17:57 +01:00
parent eacbfc4c3b
commit 71b6ac2eed
Signed by: simon
GPG key ID: 8D3C82F9F309F8EC

View file

@ -2,13 +2,25 @@
module Test where
import Main (Vertex (Point), fromAngle, move, scale, vertexDistance)
import Test.QuickCheck (discard, quickCheck, quickCheckAll)
import Data.List (partition)
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
epsilon :: Double
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
prop_VertexFromAngleDistance :: Double -> Bool
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 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 []
check = $quickCheckAll