65 lines
3.2 KiB
Haskell
65 lines
3.2 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Test where
|
|
|
|
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
|
|
|
|
-- | checks whether the distance of a vertex scaled by an factor is multiplied by that factor (absolute).
|
|
prop_VertexScaleDistance :: (Vertex, Double) -> Bool
|
|
prop_VertexScaleDistance (p, s) = abs (abs s * vertexDistance p - vertexDistance (scale s p)) < epsilon
|
|
|
|
-- | checks whether moving a vertex by itself equals scaling it by 2
|
|
prop_MoveSelfEqualsScale2 :: Vertex -> Bool
|
|
prop_MoveSelfEqualsScale2 p = move p p == scale 2 p
|
|
|
|
-- | checks whether moving a vertex by itself scaled by -1 equals the origin
|
|
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
|
|
|
|
main :: IO Bool
|
|
main = check
|