Bearing.hs

-- | Compass bearings.
module Data.CG.Minus.Bearing where

import Data.CG.Minus

-- | Enumeration of compass bearings (32 divisions).
data Bearing = N | NbE | NNE | NEbN | NE | NEbE | ENE | EbN
             | E | EbS | ESE | SEbE | SE | SEbS | SSE | SbE
             | S | SbW | SSW | SWbS | SW | SWbW | WSW | WbS
             | W | WbN | WNW | NWbW | NW | NWbN | NNW | NbW
               deriving (Eq,Enum,Bounded,Show)

-- | The 4, 8 and 16 element subsets of bearings, and all 32 bearings.
bearings_4,bearings_8,bearings_16,bearings_32 :: [Bearing]
bearings_4 = [N,E,S,W]
bearings_8 = [N,NE,E,SE,S,SW,W,NW]
bearings_16 = [N,NNE,NE,ENE,E,ESE,SE,SSE,S,SSW,SW,WSW,W,WNW,NW,NNW]
bearings_32 = [N .. NbW]

-- | The point on the unit circle of 'Bearing'.
--
-- > map bearing_pt_u [N,E,S,W]
-- > let n = sqrt 0.5 in pt_eq_by (~=) (bearing_pt_u NE) (Pt n n)
bearing_pt_u :: Bearing -> Pt R
bearing_pt_u b = pt_from_polar (Pt 1 (bearing_angle b))

-- | 'E' is zero, direction is counter-clockwise, in radians, in (-pi,pi).
--
-- > map (r_from_radians . bearing_angle) bearings_8 == [90,45,0,-45,-90,-135,180,135]
bearing_angle :: Bearing -> R
bearing_angle b =
    let ph = pi / 16
        n = 8 - fromIntegral (fromEnum b)
        a = n * ph
    in if a <= -pi then a + 2 * pi else a

bearing_n :: Integral i => i -> Pt R -> Pt R -> i
bearing_n dv p q =
    let dv' = fromIntegral dv
        a = negate (pt_angle p q) + pi
    in round ((a * ((dv' / 2) / pi)) - (dv' / 4)) `mod` dv

-- | Bearing from 'Pt' /p/ to /q/.
--
-- > let f (x,y) = bearing (Pt 0 0) (Pt x y)
-- > map f [(0,1),(1,1),(1,0),(1,-1)] == [N,NE,E,SE]
-- > map f [(0,-1),(-1,-1),(-1,0),(-1,1)] == [S,SW,W,NW]
-- > map f [(1/2,1),(1,1/2),(1,-1/2),(1/2,-1)] == [NNE,ENE,ESE,SSE]
-- > map f [(1/4,1),(1,1/4),(1,-1/4),(1/4,-1)] == [NbE,EbN,EbS,SbE]
-- > map f [(-1/2,-1),(-1,-1/2),(-1,1/2),(-1/2,1)] == [SSW,WSW,WNW,NNW]
-- > map f [(-1/4,-1),(-1,-1/4),(-1,1.4),(-1/4,1)] == [SbW,WbS,NWbN,NbW]
bearing :: Pt R -> Pt R -> Bearing
bearing p = toEnum . bearing_n 32 p

-- | Bearing to nearest eight point compass bearing
--
-- > let f (x,y) = bearing_8 (Pt 0 0) (Pt x y)
-- > map f [(1/4,1),(1,1/4),(1,-1/4),(1/4,-1)] == [N,E,E,S]
bearing_8 :: Pt R -> Pt R -> Bearing
bearing_8 p = toEnum . (* 4) . bearing_n 8 p

-- | Predicate that is 'True' if bearings are opposite.
--
-- > bearing_opposite (NW,SE) == True
-- > map bearing_opposite (zip [N,E,S,W] [S,W,N,E]) == [True,True,True,True]
bearing_opposite :: (Bearing,Bearing) -> Bool
bearing_opposite (p, q) =
    let n = (fromEnum p - fromEnum q) `mod` 32
    in n == 16