-- |

-- Module:      Data.Geo.Jord.Ellipsoid

-- Copyright:   (c) 2020 Cedric Liegeois

-- License:     BSD3

-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>

-- Stability:   experimental

-- Portability: portable

--

-- Types and functions for working with ellipsoids (including spheres).

--

-- see "Data.Geo.Jord.Ellipsoids" for supported ellipsoids.

module Data.Geo.Jord.Ellipsoid
    ( Ellipsoid
    , equatorialRadius
    , polarRadius
    , eccentricity
    , flattening
    , ellispoid
    , sphere
    , toSphere
    , isSphere
    , meanRadius
    ) where

import Data.Geo.Jord.Length

-- | Parameters of an ellispoid describing the surface of a celestial body.

--  An ellispoid is a circle if  its 'equatorialRadius' and 'polarRadius' are

-- equal (both its 'eccentricity' and 'flattening' are 0); it is used to represent

-- a celestial body as a sphere.

data Ellipsoid =
    Ellipsoid
        { Ellipsoid -> Length
equatorialRadius :: !Length -- ^ equatorial radius or semi-major axis (a).

        , Ellipsoid -> Length
polarRadius :: !Length -- ^ polar radius or semi-minor axis (b).

        , Ellipsoid -> Double
eccentricity :: !Double -- ^ eccentricity

        , Ellipsoid -> Double
flattening :: !Double -- ^ flattening

        }
    deriving (Ellipsoid -> Ellipsoid -> Bool
(Ellipsoid -> Ellipsoid -> Bool)
-> (Ellipsoid -> Ellipsoid -> Bool) -> Eq Ellipsoid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ellipsoid -> Ellipsoid -> Bool
$c/= :: Ellipsoid -> Ellipsoid -> Bool
== :: Ellipsoid -> Ellipsoid -> Bool
$c== :: Ellipsoid -> Ellipsoid -> Bool
Eq, Int -> Ellipsoid -> ShowS
[Ellipsoid] -> ShowS
Ellipsoid -> String
(Int -> Ellipsoid -> ShowS)
-> (Ellipsoid -> String)
-> ([Ellipsoid] -> ShowS)
-> Show Ellipsoid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ellipsoid] -> ShowS
$cshowList :: [Ellipsoid] -> ShowS
show :: Ellipsoid -> String
$cshow :: Ellipsoid -> String
showsPrec :: Int -> Ellipsoid -> ShowS
$cshowsPrec :: Int -> Ellipsoid -> ShowS
Show)

-- | @ellispoid eqr invf@: ellipsoid with equatorial radius @eqr@ and inverse flattening @invf@.

ellispoid :: Length -> Double -> Ellipsoid
ellispoid :: Length -> Double -> Ellipsoid
ellispoid Length
eqr Double
invf = Length -> Length -> Double -> Double -> Ellipsoid
Ellipsoid Length
eqr (Double -> Length
metres Double
b) Double
e Double
f
  where
    a :: Double
a = Length -> Double
toMetres Length
eqr
    f :: Double
f = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
invf
    b :: Double
b = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
f)
    e :: Double
e = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a))

-- | @sphere r@: ellipsoid with equatorial & polar radius radius @r@.

-- The returned ellipsoid is a sphere.

sphere :: Length -> Ellipsoid
sphere :: Length -> Ellipsoid
sphere Length
r = Length -> Length -> Double -> Double -> Ellipsoid
Ellipsoid Length
r Length
r Double
0.0 Double
0.0

-- | @toSphere e@: sphere from mean radius of ellipsoid @e@.

toSphere :: Ellipsoid -> Ellipsoid
toSphere :: Ellipsoid -> Ellipsoid
toSphere = Length -> Ellipsoid
sphere (Length -> Ellipsoid)
-> (Ellipsoid -> Length) -> Ellipsoid -> Ellipsoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipsoid -> Length
meanRadius

-- | @isSphere e@ returns True if ellipsoid @e@ is a sphere.

isSphere :: Ellipsoid -> Bool
isSphere :: Ellipsoid -> Bool
isSphere Ellipsoid
e = Ellipsoid -> Double
eccentricity Ellipsoid
e Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0

-- | @meanRadius e@ computes the mean radius of ellipsoid @e@.

meanRadius :: Ellipsoid -> Length
meanRadius :: Ellipsoid -> Length
meanRadius Ellipsoid
e = Double -> Length
metres ((Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3.0)
  where
    a :: Double
a = Length -> Double
toMetres (Length -> Double) -> (Ellipsoid -> Length) -> Ellipsoid -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipsoid -> Length
equatorialRadius (Ellipsoid -> Double) -> Ellipsoid -> Double
forall a b. (a -> b) -> a -> b
$ Ellipsoid
e
    b :: Double
b = Length -> Double
toMetres (Length -> Double) -> (Ellipsoid -> Length) -> Ellipsoid -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipsoid -> Length
polarRadius (Ellipsoid -> Double) -> Ellipsoid -> Double
forall a b. (a -> b) -> a -> b
$ Ellipsoid
e