| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.Geometry.Ball
Contents
- data Ball d p r = Ball {
- _center :: Point d r :+ p
- _squaredRadius :: r
- squaredRadius :: forall d p r. Lens' (Ball d p r) r
- center :: forall d p r d p. Lens (Ball d p r) (Ball d p r) ((:+) (Point d r) p) ((:+) (Point d r) p)
- fromDiameter :: (Arity d, Fractional r) => Point d r -> Point d r -> Ball d () r
- fromCenterAndPoint :: (Arity d, Num r) => (Point d r :+ p) -> (Point d r :+ p) -> Ball d p r
- unitBall :: (Arity d, Num r) => Ball d () r
- inBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> PointLocationResult
- insideBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> Bool
- inClosedBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> Bool
- onBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> Bool
- type Sphere d p r = Boundary (Ball d p r)
- pattern Sphere :: (:+) (Point t t) t -> t -> Boundary (Ball t t t)
- type Disk p r = Ball 2 p r
- pattern Disk :: (:+) (Point t t) t -> t -> Ball t t t
- type Circle p r = Sphere 2 p r
- pattern Circle :: (:+) (Point t t) t -> t -> Boundary (Ball t t t)
- disk :: (Eq r, Fractional r) => Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r)
- newtype Touching p = Touching p
A d-dimensional ball
A d-dimensional ball.
Constructors
| Ball | |
Fields
| |
Instances
| Arity d => Bifunctor (Ball d) Source | |
| Arity d => Functor (Ball d p) Source | |
| Floating r => HasDefaultIpeOut (Disk p r) Source | |
| (Ord r, Floating r) => IsIntersectableWith (Line 2 r) (Circle p r) Source | |
| (Eq r, Eq p, Arity d) => Eq (Ball d p r) Source | |
| (Show r, Show p, Arity d) => Show (Ball d p r) Source | |
| (Ord r, Floating r) => IsIntersectableWith (LineSegment 2 p r) (Circle q r) Source | |
| type DefaultIpeOut (Disk p r) = Path Source | |
| type IntersectionOf (Line 2 r) (Circle p r) = (:) * NoIntersection ((:) * (Touching (Point 2 r)) ((:) * (Point 2 r, Point 2 r) ([] *))) Source | No intersection, one touching point, or two points |
| type NumType (Ball d p r) = r Source | |
| type Dimension (Ball d p r) = d Source | |
| type IntersectionOf (LineSegment 2 p r) (Circle q r) = (:) * NoIntersection ((:) * (Touching (Point 2 r)) ((:) * (Point 2 r) ((:) * (Point 2 r, Point 2 r) ([] *)))) Source | A line segment may not intersect a circle, touch it, or intersect it properly in one or two points. |
squaredRadius :: forall d p r. Lens' (Ball d p r) r Source
center :: forall d p r d p. Lens (Ball d p r) (Ball d p r) ((:+) (Point d r) p) ((:+) (Point d r) p) Source
Constructing Balls
fromDiameter :: (Arity d, Fractional r) => Point d r -> Point d r -> Ball d () r Source
Given two points on the diameter of the ball, construct a ball.
fromCenterAndPoint :: (Arity d, Num r) => (Point d r :+ p) -> (Point d r :+ p) -> Ball d p r Source
Construct a ball given the center point and a point p on the boundary.
Querying if a point lies in a ball
insideBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> Bool Source
Test if a point lies strictly inside a ball
>>>(point2 0.5 0) `insideBall` unitBallTrue>>>(point2 1 0) `insideBall` unitBallFalse>>>(point2 2 0) `insideBall` unitBallFalse
inClosedBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> Bool Source
Test if a point lies in or on the ball
onBall :: (Arity d, Ord r, Num r) => Point d r -> Ball d p r -> Bool Source
Test if a point lies on the boundary of a ball.
>>>(point2 1 0) `onBall` unitBallTrue>>>(point3 1 1 0) `onBall` unitBallFalse
Disks and Circles, aka 2-dimensional Balls and Spheres
disk :: (Eq r, Fractional r) => Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r) Source
Given three points, get the disk through the three points. If the three input points are colinear we return Nothing
>>>disk (point2 0 10) (point2 10 0) (point2 (-10) 0)Just (Ball {_center = Point2 [0.0,0.0] :+ (), _squaredRadius = 100.0})