Compare commits

...

6 Commits

5 changed files with 117 additions and 0 deletions

1
.envrc Normal file
View File

@ -0,0 +1 @@
use nix

1
.gitignore vendored Normal file
View File

@ -0,0 +1 @@
/genstar/doc

71
genstar/Main.hs Normal file
View File

@ -0,0 +1,71 @@
module Main where
import Control.Monad (join)
import Test.QuickCheck (Arbitrary (arbitrary))
-- | One point of a path, consisting of its \(x\) and \(y\) coordinates.
newtype Vertex = Point (Double, Double) deriving (Eq)
instance Show Vertex where
show (Point (x, y)) = show x ++ " " ++ show y
instance Arbitrary Vertex where
arbitrary = do
x <- arbitrary
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 :: 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).
move :: Vertex -> Vertex -> Vertex
move (Point (x1, y1)) (Point (x2, y2)) = Point (x1 + x2, y1 + y2)
-- | Points \(p_0, p_2, \dots, p_{n-1}\)
-- that should be connected,
-- so that \(p_{i \bmod n}\) is connected to \(p_{i+1 \bmod n}\).
newtype PolygonPath = PolygonPath [Vertex]
instance Show PolygonPath where
show (PolygonPath (v : vs)) = "<path d=\"M " ++ show v ++ join (map (\v -> " L " ++ show v) vs) ++ " Z\"/>\n"
show (PolygonPath []) = ""
-- | 'regularPolygonMod' @n@ @rf@ @pos@
-- creates a regular @n@-gon
-- 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 -> 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@
-- creates a regular polygon
-- with the radius @r@
-- and the center at @pos@.
regularPolygon :: Integer -> Integer -> Vertex -> PolygonPath
regularPolygon n r = regularPolygonMod n (const (fromInteger r))
-- | 'star' @n@ @r1@ @r2@ @pos@
-- creates a star
-- with @n@ spikes,
-- the inner radius @r1@,
-- the outer radius @r2@
-- and the center @pos@.
star :: Integer -> Double -> Double -> Vertex -> PolygonPath
star n r1 r2 = regularPolygonMod (n * 2) ((take (fromInteger n * 2) (cycle [r1, r2]) !!) . fromInteger)
main :: IO ()
main = putStr $ join $ map (\n -> show n ++ "-gon: " ++ show (regularPolygon n 100 (Point (100, 100)))) [5, 8, 10, 15, 18, 30]

33
genstar/Test.hs Normal file
View 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

11
shell.nix Normal file
View File

@ -0,0 +1,11 @@
{ pkgs ? import <nixpkgs> { } }:
pkgs.mkShell {
name = "emi5";
nativeBuildInputs = with pkgs; [
(haskellPackages.ghcWithPackages (pkgs: with pkgs; [
QuickCheck
]))
];
}