2014-10-07 17:12:07 +00:00
|
|
|
{-# OPTIONS_HADDOCK ignore-exports #-}
|
|
|
|
|
2014-10-10 15:40:08 +00:00
|
|
|
module Algebra.Vector where
|
2014-10-07 17:12:07 +00:00
|
|
|
|
2014-10-24 23:44:13 +00:00
|
|
|
import Control.Applicative
|
2014-12-13 03:05:28 +00:00
|
|
|
import Control.Arrow ((***))
|
2014-11-29 04:08:54 +00:00
|
|
|
import Data.List (sortBy)
|
2014-10-08 14:31:57 +00:00
|
|
|
import Diagrams.TwoD.Types
|
2014-10-24 23:44:13 +00:00
|
|
|
import Graphics.Gloss.Geometry.Line
|
|
|
|
import GHC.Float
|
2014-10-13 20:06:12 +00:00
|
|
|
import MyPrelude
|
2014-10-07 17:12:07 +00:00
|
|
|
|
|
|
|
|
2014-12-03 20:41:00 +00:00
|
|
|
type Vec = R2
|
|
|
|
type PT = P2
|
|
|
|
type Coord = (Double, Double)
|
|
|
|
type Segment = (PT, PT)
|
|
|
|
type Square = (Coord, Coord)
|
|
|
|
|
|
|
|
|
|
|
|
data Alignment = CW
|
|
|
|
| CCW
|
|
|
|
| CL
|
|
|
|
deriving (Eq)
|
|
|
|
|
|
|
|
|
2014-10-08 14:31:57 +00:00
|
|
|
-- |Checks whether the Point is in a given dimension.
|
2014-11-29 04:08:38 +00:00
|
|
|
inRange :: Square -- ^ the square: ((xmin, xmax), (ymin, ymax))
|
2014-11-13 22:04:26 +00:00
|
|
|
-> PT -- ^ Coordinate
|
|
|
|
-> Bool -- ^ result
|
2014-11-15 23:39:59 +00:00
|
|
|
inRange ((xmin, xmax), (ymin, ymax)) p =
|
|
|
|
x <= xmax && x >= xmin && y <= ymax && y >= ymin
|
2014-10-09 22:19:05 +00:00
|
|
|
where
|
|
|
|
(x, y) = unp2 p
|
2014-10-07 17:12:07 +00:00
|
|
|
|
|
|
|
|
2014-10-09 01:15:27 +00:00
|
|
|
-- |Get the angle between two vectors.
|
2014-10-08 14:31:57 +00:00
|
|
|
getAngle :: Vec -> Vec -> Double
|
2014-10-09 22:19:05 +00:00
|
|
|
getAngle a b =
|
|
|
|
acos .
|
|
|
|
flip (/) (vecLength a * vecLength b) .
|
|
|
|
scalarProd a $
|
|
|
|
b
|
2014-10-08 14:31:57 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Get the length of a vector.
|
|
|
|
vecLength :: Vec -> Double
|
2014-10-13 17:15:09 +00:00
|
|
|
vecLength v = sqrt (x^(2 :: Int) + y^(2 :: Int))
|
2014-10-08 14:31:57 +00:00
|
|
|
where
|
|
|
|
(x, y) = unr2 v
|
|
|
|
|
|
|
|
|
|
|
|
-- |Compute the scalar product of two vectors.
|
|
|
|
scalarProd :: Vec -> Vec -> Double
|
|
|
|
scalarProd v1 v2 = a1 * b1 + a2 * b2
|
|
|
|
where
|
|
|
|
(a1, a2) = unr2 v1
|
|
|
|
(b1, b2) = unr2 v2
|
|
|
|
|
|
|
|
|
|
|
|
-- |Construct a vector that points to a point from the origin.
|
|
|
|
pt2Vec :: PT -> Vec
|
|
|
|
pt2Vec = r2 . unp2
|
|
|
|
|
|
|
|
|
|
|
|
-- |Give the point which is at the coordinates the vector
|
|
|
|
-- points to from the origin.
|
|
|
|
vec2Pt :: Vec -> PT
|
|
|
|
vec2Pt = p2 . unr2
|
|
|
|
|
|
|
|
|
|
|
|
-- |Construct a vector between two points.
|
|
|
|
vp2 :: PT -- ^ vector origin
|
|
|
|
-> PT -- ^ vector points here
|
|
|
|
-> Vec
|
2014-10-13 17:14:25 +00:00
|
|
|
vp2 a b = pt2Vec b - pt2Vec a
|
2014-10-08 14:31:57 +00:00
|
|
|
|
|
|
|
|
2014-10-12 18:37:24 +00:00
|
|
|
-- |Computes the determinant of 3 points.
|
|
|
|
det :: PT -> PT -> PT -> Double
|
|
|
|
det a b c =
|
|
|
|
(bx - ax) *
|
2014-10-09 22:19:05 +00:00
|
|
|
(cy - ay) -
|
|
|
|
(by - ay) *
|
2014-10-12 18:37:24 +00:00
|
|
|
(cx - ax)
|
2014-10-08 14:31:57 +00:00
|
|
|
where
|
|
|
|
(ax, ay) = unp2 a
|
|
|
|
(bx, by) = unp2 b
|
|
|
|
(cx, cy) = unp2 c
|
2014-10-12 18:37:24 +00:00
|
|
|
|
|
|
|
|
2014-10-24 23:44:13 +00:00
|
|
|
-- |Get the point where two lines intesect, if any.
|
|
|
|
intersectSeg' :: Segment -> Segment -> Maybe PT
|
|
|
|
intersectSeg' (a, b) (c, d) =
|
|
|
|
glossToPt <$> intersectSegSeg (ptToGloss a)
|
|
|
|
(ptToGloss b)
|
|
|
|
(ptToGloss c)
|
|
|
|
(ptToGloss d)
|
|
|
|
where
|
2014-12-13 03:05:28 +00:00
|
|
|
ptToGloss = (double2Float *** double2Float) <$> unp2
|
|
|
|
glossToPt = p2 . (float2Double *** float2Double)
|
2014-10-24 23:44:13 +00:00
|
|
|
|
|
|
|
|
2014-10-12 18:37:24 +00:00
|
|
|
-- |Get the orientation of 3 points which can either be
|
|
|
|
-- * clock-wise
|
|
|
|
-- * counter-clock-wise
|
|
|
|
-- * collinear
|
|
|
|
getOrient :: PT -> PT -> PT -> Alignment
|
|
|
|
getOrient a b c = case compare (det a b c) 0 of
|
2014-10-13 00:30:11 +00:00
|
|
|
LT -> CW
|
|
|
|
GT -> CCW
|
2014-10-12 18:37:24 +00:00
|
|
|
EQ -> CL
|
|
|
|
|
|
|
|
|
|
|
|
--- |Checks if 3 points a,b,c do not build a clockwise triangle by
|
|
|
|
--- connecting a-b-c. This is done by computing the determinant and
|
|
|
|
--- checking the algebraic sign.
|
|
|
|
notcw :: PT -> PT -> PT -> Bool
|
|
|
|
notcw a b c = case getOrient a b c of
|
|
|
|
CW -> False
|
|
|
|
_ -> True
|
2014-10-13 20:06:12 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Sort X and Y coordinates lexicographically.
|
|
|
|
sortedXY :: [PT] -> [PT]
|
|
|
|
sortedXY = fmap p2 . sortLex . fmap unp2
|
2014-10-24 23:44:13 +00:00
|
|
|
|
|
|
|
|
2014-11-29 04:08:54 +00:00
|
|
|
-- |Sort all points according to their X-coordinates only.
|
|
|
|
sortedX :: [PT] -> [PT]
|
|
|
|
sortedX xs =
|
|
|
|
fmap p2
|
|
|
|
. sortBy (\(a1, _) (a2, _) -> compare a1 a2)
|
|
|
|
$ fmap unp2 xs
|
|
|
|
|
|
|
|
|
|
|
|
-- |Sort all points according to their Y-coordinates only.
|
|
|
|
sortedY :: [PT] -> [PT]
|
|
|
|
sortedY xs =
|
|
|
|
fmap p2
|
|
|
|
. sortBy (\(_, b1) (_, b2) -> compare b1 b2)
|
|
|
|
$ fmap unp2 xs
|
|
|
|
|
|
|
|
|
2014-10-24 23:44:13 +00:00
|
|
|
-- |Apply a function on the coordinates of a point.
|
|
|
|
onPT :: ((Double, Double) -> (Double, Double)) -> PT -> PT
|
|
|
|
onPT f = p2 . f . unp2
|
|
|
|
|
|
|
|
|
|
|
|
-- |Compare the y-coordinate of two points.
|
|
|
|
ptCmpY :: PT -> PT -> Ordering
|
|
|
|
ptCmpY p1' p2' = compare ((snd . unp2) p1') ((snd . unp2) p2')
|
|
|
|
|
|
|
|
|
2014-10-25 12:50:09 +00:00
|
|
|
-- |Compare the x-coordinate of two points.
|
2014-10-24 23:44:13 +00:00
|
|
|
ptCmpX :: PT -> PT -> Ordering
|
|
|
|
ptCmpX p1' p2' = compare ((fst . unp2) p1') ((fst . unp2) p2')
|
|
|
|
|
|
|
|
|
|
|
|
posInfPT :: PT
|
|
|
|
posInfPT = p2 (read "Infinity", read "Infinity")
|
|
|
|
|
|
|
|
|
|
|
|
negInfPT :: PT
|
|
|
|
negInfPT = p2 (negate . read $ "Infinity", negate . read $ "Infinity")
|