Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Geodetics.Ellipsoids
Description
An Ellipsoid is a reasonable best fit for the surface of the Earth over some defined area. WGS84 is the standard used for the whole of the Earth. Other Ellipsoids are considered a best fit for some specific area.
Synopsis
- degree :: Double
- arcminute :: Double
- arcsecond :: Double
- kilometer :: Double
- _2 :: Int
- _3 :: Int
- _4 :: Int
- _5 :: Int
- _6 :: Int
- _7 :: Int
- data Helmert = Helmert {}
- inverseHelmert :: Helmert -> Helmert
- type ECEF = Vec3 Double
- applyHelmert :: Helmert -> ECEF -> ECEF
- class (Show a, Eq a) => Ellipsoid a where
- majorRadius :: a -> Double
- flatR :: a -> Double
- helmert :: a -> Helmert
- helmertToWGS84 :: a -> ECEF -> ECEF
- helmertFromWGS84 :: a -> ECEF -> ECEF
- data WGS84 = WGS84
- data LocalEllipsoid = LocalEllipsoid {}
- flattening :: Ellipsoid e => e -> Double
- minorRadius :: Ellipsoid e => e -> Double
- eccentricity2 :: Ellipsoid e => e -> Double
- eccentricity'2 :: Ellipsoid e => e -> Double
- normal :: Ellipsoid e => e -> Double -> Double
- latitudeRadius :: Ellipsoid e => e -> Double -> Double
- meridianRadius :: Ellipsoid e => e -> Double -> Double
- primeVerticalRadius :: Ellipsoid e => e -> Double -> Double
- isometricLatitude :: Ellipsoid e => e -> Double -> Double
- type Vec3 a = (a, a, a)
- type Matrix3 a = Vec3 (Vec3 a)
- add3 :: Num a => Vec3 a -> Vec3 a -> Vec3 a
- scale3 :: Num a => Vec3 a -> a -> Vec3 a
- negate3 :: Num a => Vec3 a -> Vec3 a
- transform3 :: Num a => Matrix3 a -> Vec3 a -> Vec3 a
- invert3 :: Fractional a => Matrix3 a -> Matrix3 a
- trans3 :: Matrix3 a -> Matrix3 a
- dot3 :: Num a => Vec3 a -> Vec3 a -> a
- cross3 :: Num a => Vec3 a -> Vec3 a -> Vec3 a
Useful constants
All distances in this library are in meters. This is one kilometer in meters.
Lots of geodetic calculations involve integer powers. Writing e.g. x ^ 2
causes
GHC to complain that the 2
has ambiguous type. x ** 2
doesn't complain
but is much slower. So for convenience, here are small integers with type Int
.
Lots of geodetic calculations involve integer powers. Writing e.g. x ^ 2
causes
GHC to complain that the 2
has ambiguous type. x ** 2
doesn't complain
but is much slower. So for convenience, here are small integers with type Int
.
Lots of geodetic calculations involve integer powers. Writing e.g. x ^ 2
causes
GHC to complain that the 2
has ambiguous type. x ** 2
doesn't complain
but is much slower. So for convenience, here are small integers with type Int
.
Lots of geodetic calculations involve integer powers. Writing e.g. x ^ 2
causes
GHC to complain that the 2
has ambiguous type. x ** 2
doesn't complain
but is much slower. So for convenience, here are small integers with type Int
.
Lots of geodetic calculations involve integer powers. Writing e.g. x ^ 2
causes
GHC to complain that the 2
has ambiguous type. x ** 2
doesn't complain
but is much slower. So for convenience, here are small integers with type Int
.
Lots of geodetic calculations involve integer powers. Writing e.g. x ^ 2
causes
GHC to complain that the 2
has ambiguous type. x ** 2
doesn't complain
but is much slower. So for convenience, here are small integers with type Int
.
Helmert transform between geodetic reference systems
The 7 parameter Helmert transformation. The monoid instance allows composition but is only accurate for the small values used in practical ellipsoids.
Constructors
Helmert | |
inverseHelmert :: Helmert -> Helmert Source #
The inverse of a Helmert transformation.
type ECEF = Vec3 Double Source #
Earth-centred, Earth-fixed coordinates as a vector. The origin and axes are not defined: use with caution.
applyHelmert :: Helmert -> ECEF -> ECEF Source #
Apply a Helmert transformation to earth-centered coordinates.
Ellipsoid models of the Geoid
class (Show a, Eq a) => Ellipsoid a where Source #
An Ellipsoid is defined by the major radius and the inverse flattening (which define its shape), and its Helmert transform relative to WGS84 (which defines its position and orientation).
The inclusion of the Helmert parameters relative to WGS84 actually make this a Terrestrial Reference Frame (TRF), but the term Ellipsoid will be used in this library for readability.
Minimum definition: majorRadius
, flatR
& helmert
.
Laws:
helmertToWGS84 = applyHelmert . helmert helmertFromWGS84 e . helmertToWGS84 e = id
Minimal complete definition
Methods
majorRadius :: a -> Double Source #
Arguments
:: a | |
-> Double | Inverse of the flattening. |
Arguments
:: a | |
-> Helmert | The Helmert parameters relative to WGS84, |
Instances
Ellipsoid LocalEllipsoid Source # | |
Defined in Geodetics.Ellipsoids Methods majorRadius :: LocalEllipsoid -> Double Source # flatR :: LocalEllipsoid -> Double Source # helmert :: LocalEllipsoid -> Helmert Source # helmertToWGS84 :: LocalEllipsoid -> ECEF -> ECEF Source # helmertFromWGS84 :: LocalEllipsoid -> ECEF -> ECEF Source # | |
Ellipsoid WGS84 Source # | |
Ellipsoid OSGB36 Source # | |
The WGS84 geoid, major radius 6378137.0 meters, flattening = 1 / 298.257223563 as defined in "Technical Manual DMA TM 8358.1 - Datums, Ellipsoids, Grids, and Grid Reference Systems" at the National Geospatial-Intelligence Agency (NGA).
The WGS84 has a special place in this library as the standard Ellipsoid against which all others are defined.
Constructors
WGS84 |
data LocalEllipsoid Source #
Ellipsoids other than WGS84, used within a defined geographical area where they are a better fit to the local geoid. Can also be used for historical ellipsoids.
The Show
instance just returns the name.
Creating two different local ellipsoids with the same name is a Bad Thing.
Constructors
LocalEllipsoid | |
Fields
|
Instances
Show LocalEllipsoid Source # | |
Defined in Geodetics.Ellipsoids Methods showsPrec :: Int -> LocalEllipsoid -> ShowS # show :: LocalEllipsoid -> String # showList :: [LocalEllipsoid] -> ShowS # | |
Ellipsoid LocalEllipsoid Source # | |
Defined in Geodetics.Ellipsoids Methods majorRadius :: LocalEllipsoid -> Double Source # flatR :: LocalEllipsoid -> Double Source # helmert :: LocalEllipsoid -> Helmert Source # helmertToWGS84 :: LocalEllipsoid -> ECEF -> ECEF Source # helmertFromWGS84 :: LocalEllipsoid -> ECEF -> ECEF Source # | |
Eq LocalEllipsoid Source # | |
Defined in Geodetics.Ellipsoids Methods (==) :: LocalEllipsoid -> LocalEllipsoid -> Bool # (/=) :: LocalEllipsoid -> LocalEllipsoid -> Bool # |
flattening :: Ellipsoid e => e -> Double Source #
Flattening (f) of an ellipsoid.
minorRadius :: Ellipsoid e => e -> Double Source #
The minor radius of an ellipsoid in meters.
eccentricity2 :: Ellipsoid e => e -> Double Source #
The eccentricity squared of an ellipsoid.
eccentricity'2 :: Ellipsoid e => e -> Double Source #
The second eccentricity squared of an ellipsoid.
Auxiliary latitudes and related Values
normal :: Ellipsoid e => e -> Double -> Double Source #
Distance in meters from the surface at the specified latitude to the
axis of the Earth straight down. Also known as the radius of
curvature in the prime vertical, and often denoted N
.
latitudeRadius :: Ellipsoid e => e -> Double -> Double Source #
Radius of the circle of latitude: the distance from a point at that latitude to the axis of the Earth, in meters.
meridianRadius :: Ellipsoid e => e -> Double -> Double Source #
Radius of curvature in the meridian at the specified latitude, in meters
Often denoted M
.
primeVerticalRadius :: Ellipsoid e => e -> Double -> Double Source #
Radius of curvature of the ellipsoid perpendicular to the meridian at the specified latitude, in meters.
isometricLatitude :: Ellipsoid e => e -> Double -> Double Source #
The isometric latitude. The isometric latitude is conventionally denoted by ψ (not to be confused with the geocentric latitude): it is used in the development of the ellipsoidal versions of the normal Mercator projection and the Transverse Mercator projection. The name "isometric" arises from the fact that at any point on the ellipsoid equal increments of ψ and longitude λ give rise to equal distance displacements along the meridians and parallels respectively.