Implement basic tests for polygons

genstar/Main.hs

@@ -15,14 +15,19 @@ instance Arbitrary Vertex where
     y <- arbitrary
     return (Point (x, y))
 
+-- | 'vertexDistance' @p@
+-- returns the distance of a vertex to the origin
+vertexDistance :: Vertex -> Double
+vertexDistance (Point (x, y)) = sqrt (x ** 2 + y ** 2)
+
 -- | 'fromAngle' @angle@
 -- creates a point on the unit circle at the specified angle
 -- (specified in radians).
 fromAngle angle = Point (sin angle, cos angle)
 
 -- | 'scale' @s@ @p@ scales the vector to @p@ by the factor @s@.
-scale :: Integer -> Vertex -> Vertex
-scale s (Point (x, y)) = Point (fromInteger s * x, fromInteger s * y)
+scale :: Double -> Vertex -> Vertex
+scale s (Point (x, y)) = Point (s * x, s * y)
 
 -- | 'move' @p1@ @p2@ adds the coordinates of @p1@ and @p2@,
 -- effectively moving @p1@ by @p2@ (or vice-versa).
@@ -39,18 +44,20 @@ instance Show PolygonPath where
   show (PolygonPath []) = ""
 
 -- | 'regularPolygonMod' @n@ @rf@ @pos@
--- creates a regular @n@-gon
--- with the center at @pos@
+-- creates a regular @n@-gon (@n@ must be greater than or equal to 3)
+-- with the centre at @pos@
 -- that is modified in the sense that it takes @rf@,
 -- which is used to set the radius for each individual point.
-regularPolygonMod :: Integer -> (Integer -> Integer) -> Vertex -> PolygonPath
-regularPolygonMod n rf pos = PolygonPath (map (\step -> move pos $ scale (rf step) $ fromAngle (fromInteger step * 2 * pi / fromInteger n)) [0 .. (n - 1)])
+regularPolygonMod :: Integer -> (Integer -> Double) -> Vertex -> Maybe PolygonPath
+regularPolygonMod n rf pos
+  | n < 3 = Nothing
+  | otherwise = Just (PolygonPath (map (\step -> move pos $ scale (rf step) $ fromAngle (fromInteger step * 2 * pi / fromInteger n)) [0 .. (n - 1)]))
 
 -- | 'regularPolygon' @n@ @r@ @pos@
 -- creates a regular polygon
 -- with the radius @r@
--- and the center at @pos@.
-regularPolygon :: Integer -> Integer -> Vertex -> PolygonPath
+-- and the centre at @pos@.
+regularPolygon :: Integer -> Double -> Vertex -> Maybe PolygonPath
 regularPolygon n r = regularPolygonMod n (const r)
 
 -- | 'star' @n@ @r1@ @r2@ @pos@
@@ -58,8 +65,8 @@ regularPolygon n r = regularPolygonMod n (const r)
 -- with @n@ spikes,
 -- the inner radius @r1@,
 -- the outer radius @r2@
--- and the center @pos@.
-star :: Integer -> Integer -> Integer -> Vertex -> PolygonPath
+-- and the centre @pos@.
+star :: Integer -> Double -> Double -> Vertex -> Maybe PolygonPath
 star n r1 r2 = regularPolygonMod (n * 2) ((take (fromInteger n * 2) (cycle [r1, r2]) !!) . fromInteger)
 
 main :: IO ()

genstar/Test.hs

@@ -0,0 +1,64 @@
+{-# 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