Compare commits
2 commits
71b6ac2eed
...
f691bfccae
Author | SHA1 | Date | |
---|---|---|---|
|
f691bfccae | ||
|
4a767388fd |
|
@ -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).
|
||||
|
@ -43,7 +48,7 @@ instance Show PolygonPath where
|
|||
-- with the center 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 :: Integer -> (Integer -> Double) -> Vertex -> PolygonPath
|
||||
regularPolygonMod n rf pos = PolygonPath (map (\step -> move pos $ scale (rf step) $ fromAngle (fromInteger step * 2 * pi / fromInteger n)) [0 .. (n - 1)])
|
||||
|
||||
-- | 'regularPolygon' @n@ @r@ @pos@
|
||||
|
@ -51,7 +56,7 @@ regularPolygonMod n rf pos = PolygonPath (map (\step -> move pos $ scale (rf ste
|
|||
-- with the radius @r@
|
||||
-- and the center at @pos@.
|
||||
regularPolygon :: Integer -> Integer -> Vertex -> PolygonPath
|
||||
regularPolygon n r = regularPolygonMod n (const r)
|
||||
regularPolygon n r = regularPolygonMod n (const (fromInteger r))
|
||||
|
||||
-- | 'star' @n@ @r1@ @r2@ @pos@
|
||||
-- creates a star
|
||||
|
@ -59,7 +64,7 @@ regularPolygon n r = regularPolygonMod n (const r)
|
|||
-- the inner radius @r1@,
|
||||
-- the outer radius @r2@
|
||||
-- and the center @pos@.
|
||||
star :: Integer -> Integer -> Integer -> Vertex -> PolygonPath
|
||||
star :: Integer -> Double -> Double -> Vertex -> PolygonPath
|
||||
star n r1 r2 = regularPolygonMod (n * 2) ((take (fromInteger n * 2) (cycle [r1, r2]) !!) . fromInteger)
|
||||
|
||||
main :: IO ()
|
||||
|
|
33
genstar/Test.hs
Normal file
33
genstar/Test.hs
Normal file
|
@ -0,0 +1,33 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Test where
|
||||
|
||||
import Main (Vertex (Point), fromAngle, move, scale, vertexDistance)
|
||||
import Test.QuickCheck (discard, quickCheck, quickCheckAll)
|
||||
|
||||
-- | the largest acceptable difference between two doubles so they are considered equal
|
||||
epsilon :: Double
|
||||
epsilon = 1e-10
|
||||
|
||||
-- | 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)
|
||||
|
||||
return []
|
||||
|
||||
check = $quickCheckAll
|
||||
|
||||
main :: IO Bool
|
||||
main = check
|
Reference in a new issue