geom2d 0.1.0.1 → 0.1.2.0

raw patch · 8 files changed

+193/−15 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Geom2d/Distance.hs +5/−0
• Geom2d/Point.hs +7/−0
• Geom2d/Point/Internal.hs +22/−12
• Geom2d/Rotation.hs +3/−0
• Geom2d/Shape.hs +1/−0
• Geom2d/Shape/Internal.hs +87/−2
• Test/Shape.hs +67/−0
• geom2d.cabal +1/−1

@@ -1,9 +1,14 @@ {-# LANGUAGE MultiParamTypeClasses #-} +-- | This module provides a type class to modell distance between+-- geometric objects.+ module Geom2d.Distance where  import Geom2d.Point.Internal +-- | The Distance between objects that have no volume, like points,+-- should satisfy the triangle inequality. class Distance p q where   distance :: (Ord a, Floating a) => p a -> q a -> a 

@@ -15,19 +15,25 @@  import Geom2d.Point.Internal +-- | A triangle is simply a tuple of three points. type Triangle p = (p,p,p)  infixl 7 `dot`,`cross` +-- | This function defines the dot product of two vectors. dot :: (Num a, Point p) => p a -> p a -> a dot a b = x a * x b + y a * y b +-- | This function defined the cross product of two vectors. cross :: (Num a, Point p) => p a -> p a -> a cross a b = x a * y b - y a * x b +-- | Calculate the area of a triangle. triArea :: (Point p, Num (p a), Fractional a) => Triangle (p a) -> a triArea (a,b,c) = abs $ ((b - a) `cross` (c - a)) / 2 +-- | Determin whether a point is in a triangle.  A point being on the+-- edge is considered inside the triangle. pointInTriangle :: (Eq (p a), Num (p a), Fractional a, Point p, Ord a) =>                    Triangle (p a) -> p a -> Bool pointInTriangle (a,b,c) p@@ -49,6 +55,7 @@       v1 = b-a       v2 = p-a +-- | This type class modells data that can be scaled by a factor. class Scale p where   scale :: (Num a) => a -> p a -> p a 

@@ -1,3 +1,7 @@+{-# LANGUAGE FlexibleInstances #-}+-- | This module describes the internal structure of the `Point` type+-- class and the `Point'` instance of said type class.+ module Geom2d.Point.Internal     ( Point' (..)     , Point (..)@@ -7,7 +11,6 @@ where  import Data.AEq-import Data.Fixed import Geom2d.Rotation import qualified Prelude ((^)) import Prelude hiding ((^))@@ -16,6 +19,8 @@ (^) :: Num a => a -> Int -> a (^) = (Prelude.^) +-- | This data type modells the the characteristics of vectors in 2+-- dimensional space.  You should construct it via `fromCoords`. newtype Point' a = Point' (a,a) deriving (Show, Read, Eq)  class Point p where@@ -23,6 +28,7 @@   y :: p a -> a   fromCoords :: a -> a -> p a +-- | Return the magnitude of a vector. magnitude :: (Point p, Floating a, Num a) => p a -> a magnitude p =   sqrt (x p ^ (2::Int) + y p ^ (2::Int))@@ -32,18 +38,22 @@   y (Point' p) = snd p   fromCoords a b = Point' (a, b) -instance (Eq a, Num a, Fractional a, RealFloat a) => Num (Point' a) where-  (Point' (p1,p2)) + (Point' (q1,q2)) = Point' (p1+q1, p2+q2)-  (Point' (p1,p2)) - (Point' (q1,q2)) = Point' (p1-q1, p2-q2)-  (Point' (m,n)) * (Point' (p,q)) = Point' (m*p - n*q, m*q + n*p)-  abs (Point' (m,n)) = Point' (sqrt (m^2 + n^2), 0)-  signum p@(Point' (m,n))-      | m == fromIntegral (0::Int) && n == fromIntegral (0::Int) =-          Point' (m,n)-      | otherwise = Point' (m*l,n*l)+-- | Implementing the `Num` type class allows us to add and subtract+-- vectors.  Multiplication is implemented in terms of complex number+-- multiplication.  If you want to multiply using the dot or cross+-- products use the appropriate functions from this package.+instance (Eq a, Num a, Fractional a, Floating a, Point p) => Num (p a) where+  p + q = fromCoords (x p + x q) (y p + y q)+  p - q = fromCoords (x p - x q) (y p - y q)+  a * b = fromCoords (x a*x b - y a*y b) (x a*y b + y a*x b)+  abs p = fromCoords (sqrt (x p^2 + y p^2)) 0+  signum p+      | x p == fromIntegral (0::Int) && y p == fromIntegral (0::Int) =+          fromCoords 0 0+      | otherwise = fromCoords (x p*l) (y p*l)       where l = 1 / x (abs p)-  fromInteger n = Point' (fromInteger n, 0)-  negate (Point' (a,b)) = Point' (negate a, negate b)+  fromInteger n = fromCoords (fromInteger n) 0+  negate p = fromCoords (negate $ x p) (negate $ y p)  instance (Arbitrary a) => Arbitrary (Point' a) where   arbitrary = curry Point' <$> arbitrary <*> arbitrary

@@ -1,3 +1,6 @@+-- | This module contains a type class that can be used to modell+-- data, that can be rotated by a given angle.+ module Geom2d.Rotation  where

@@ -1,5 +1,6 @@ module Geom2d.Shape     ( Shape+    , Spatial (..)     , circle     , rectangle     )

@@ -2,6 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PartialTypeSignatures #-}  module Geom2d.Shape.Internal     ( Circle (..)@@ -12,6 +13,7 @@     , convexHull'     , rectangleInt     , Shape (..)+    , Spatial (..)     )         where@@ -52,6 +54,15 @@   intersect (Circle m1 r1) (Circle m2 r2) =     distance m1 m2 <= r1 + r2 +instance (Distance p (FinLine p), Floating a, Ord a) =>+         Intersect (Circle p a) (FinLine p a) where+  intersect (Circle m r) l =+    distance m l <= r++instance (Distance p (FinLine p), Floating a, Ord a) =>+         Intersect (FinLine p a) (Circle p a) where+  intersect = flip intersect+ instance (Arbitrary a, Arbitrary (p a), Ord a, Num a) =>          Arbitrary (Circle p a) where   arbitrary = Circle <$> arbitrary <*>@@ -61,6 +72,9 @@   angle (Circle m _) = angle m   rotate ang (Circle m r) = Circle (rotate ang m) r +instance Translate p => Translate (Circle p) where+  translate v (Circle m r) = Circle (translate v m) r+ mkCircleInt :: (Num a) => p a -> a -> Circle p a mkCircleInt m r' = Circle m (abs r') @@ -78,7 +92,7 @@                    Polygon (p a) [p a]                    deriving (Show,Read,Eq) -instance (Point p, Fractional a, Num (p a), Eq (p a), Ord a) =>+instance (Point p, Ord a, Eq (p a), Floating a) =>          Intersect (p a) (Polygon p a) where   intersect p (Polygon m vs) =     any (`pointInTriangle` p) triangles@@ -86,7 +100,7 @@                       ( zip verteces (tail verteces ++ [head verteces]))           verteces = map (+ m) vs -instance (Point p, Fractional a, Num (p a), Eq (p a), Ord a) =>+instance (Point p, Floating a, Num (p a), Eq (p a), Ord a) =>          Intersect (Polygon p a) (p a) where   intersect = flip intersect @@ -126,10 +140,26 @@          Intersect (Circle p a) (Polygon p a) where   intersect = flip intersect +instance (RealFloat a, Eq a, Eq (p a), Point p) =>+         Intersect (Polygon p a) (FinLine p a) where+  intersect poly@(Polygon m vs) line@(FinLine a b) =+    a `intersect` poly ||+    b `intersect` poly ||+    any (intersect line) edges+    where edges = zipWith FinLine verts (tail verts ++ [head verts])+          verts = map (+m) vs++instance (RealFloat a, Eq a, Eq (p a), Point p) =>+         Intersect (FinLine p a) (Polygon p a) where+  intersect = flip intersect+ instance (Rotation p) => Rotation (Polygon p) where   rotate r (Polygon m vs) = Polygon (rotate r m) (map (rotate r) vs)   angle (Polygon m _) = angle m +instance Translate p => Translate (Polygon p) where+  translate v (Polygon m vs) = Polygon (translate v m) vs+ -- | Calculate the convex hull of an arbitrary number of points. convexHull' :: forall p a.                (Num (p a), Fractional a, Ord a, Scale p, Point p) =>@@ -207,8 +237,63 @@          Intersect (p a) (Shape p a) where   intersect = flip intersect +instance (Point p, RealFloat a, Ord a, Eq (p a)) =>+         Intersect (Shape p a) (FinLine p a) where+  intersect (ShapeCircle c) = intersect c+  intersect (ShapePolygon p) = intersect p++instance (Point p, RealFloat a, Ord a, Eq (p a)) =>+         Intersect (FinLine p a) (Shape p a) where+  intersect = flip intersect+ instance (Rotation p, Point p) => Rotation (Shape p) where   rotate a (ShapeCircle s) = ShapeCircle (rotate a s)   rotate a (ShapePolygon s) = ShapePolygon (rotate a s)   angle (ShapeCircle s) = angle s   angle (ShapePolygon s) = angle s++instance ( Eq (p a), RealFloat a, Num (p a), Point p, Arbitrary a+         , Arbitrary (p a), Scale p) =>+         Arbitrary (Shape p a) where+  arbitrary = oneof [ ShapeCircle <$> arbitrary+                    , ShapePolygon <$> arbitrary+                    ]++instance Translate p => Translate (Shape p) where+  translate v (ShapeCircle c) = ShapeCircle (translate v c)+  translate v (ShapePolygon c) = ShapePolygon (translate v c)++class Spatial s where+  area :: (Floating a, Ord a) => s a -> a+  minX :: (Floating a, Ord a) => s a -> a+  maxX :: (Floating a, Ord a) => s a -> a+  minY :: (Floating a, Ord a) => s a -> a+  maxY :: (Floating a, Ord a) => s a -> a++instance (Point p) => Spatial (Circle p) where+  area (Circle _ r) = r^(2::Int) * pi+  minX (Circle m r) = x m - r+  maxX (Circle m r) = x m + r+  minY (Circle m r) = y m - r+  maxY (Circle m r) = y m + r++instance (Point p) => Spatial (Polygon p) where+  area (Polygon _ vs) =+    (sum.map (triArea.(\(a,b) -> (a,b,fromCoords 0 0)))) edges+    where edges = zip vs (tail vs ++ [head vs])+  minX (Polygon m vs) = x m + (minimum.map x) vs+  maxX (Polygon m vs) = x m + (maximum.map x) vs+  minY (Polygon m vs) = y m + (minimum.map y) vs+  maxY (Polygon m vs) = y m + (maximum.map y) vs++instance (Point p) => Spatial (Shape p) where+  area (ShapeCircle c) = area c+  area (ShapePolygon p) = area p+  minX (ShapeCircle c) = minX c+  minX (ShapePolygon p) = minX p+  maxX (ShapeCircle c) = maxX c+  maxX (ShapePolygon p) = maxX p+  minY (ShapeCircle c) = minY c+  minY (ShapePolygon p) = minY p+  maxY (ShapeCircle c) = maxY c+  maxY (ShapePolygon p) = maxY p

@@ -9,6 +9,8 @@ import Geom2d.Rotation import Geom2d.Shape import Geom2d.Shape.Internal+import Geom2d.Translate+import Geom2d.Line import Test.QuickCheck import Test.Utils @@ -161,6 +163,71 @@     rect <- rectangle (fromCoords 1 0 :: Point' Float) 1 1     ang <- angle rect     return (ang ~== 0)++prop_circle_area_1 :: Float -> Bool+prop_circle_area_1 r =+  area (circle (fromCoords 0 0 :: Point' Float) r) ~==+  abs r ^ (2::Int) * pi++prop_polygon_area_1 :: Float -> Float -> Bool+prop_polygon_area_1 a' b' = fromMaybe True $ do+  rect <- rectangle (fromCoords 0 0 :: Point' Float) a b+  return (area rect ~== a * b)+  where a = abs a'+        b = abs b'++prop_shape_area :: Point' Float -> Shape Point' Float -> Bool+prop_shape_area v s =+  area s ~==+  (area.translate v) s++prop_shape_min_max_values :: Shape Point' Float -> Point' Float -> Bool+prop_shape_min_max_values s v =+  minX s + dx ~== minX (translate v s) &&+  maxX s + dx ~== maxX (translate v s) &&+  minY s + dy ~== minY (translate v s) &&+  maxY s + dy ~== maxY (translate v s)+  where dx = x v+        dy = y v++prop_circle_min_max_values :: Circle Point' Float -> Bool+prop_circle_min_max_values circ =+  minX circ ~== x m - r &&+  maxX circ ~== x m + r &&+  minY circ ~== y m - r &&+  maxY circ ~== y m + r+  where m = center circ+        r = radius circ++prop_rectangle_min_max_values :: Float -> Float -> Bool+prop_rectangle_min_max_values a' b' = fromMaybe True $ do+  rect <- rectangle (fromCoords 0 0 :: Point' Float) a b+  return ( minX rect ~== (-a/2) &&+           maxX rect ~== a/2 &&+           minY rect ~== (-b/2) &&+           maxY rect ~== b/2 )+  where a = abs a'+        b = abs b'++prop_intersect_finline_circle :: Bool+prop_intersect_finline_circle =+  fromMaybe False $ do+    line <- mkFinLine (point (-5) 0) (point 5 0)+    return (circle (point 0 0) 3 `intersect` line &&+            not (circle (point 0 100) 3 `intersect` line))+  where point :: Float -> Float -> Point' Float+        point = fromCoords++prop_intersect_finline_polygon :: Bool+prop_intersect_finline_polygon =+  fromMaybe False $ do+    line <- mkFinLine (point (-5) 0) (point 5 0)+    rectNotCol <- rectangle (point 0 100) 3 3+    rectCol <- rectangle (point 0 0) 2 2+    return (rectCol `intersect` line &&+            not (rectNotCol `intersect` line))+  where point :: Float -> Float -> Point' Float+        point = fromCoords  return [] runTests = $quickCheckAll

@@ -1,5 +1,5 @@ name:                geom2d-version:             0.1.0.1+version:             0.1.2.0 synopsis:            package for geometry in euklidean 2d space description:         This package provides tools for dealing with geometric                      objects in 2D space.