Copyright | (c) 2020 Cedric Liegeois |
---|---|
License | BSD3 |
Maintainer | Cedric Liegeois <ofmooseandmen@yahoo.fr> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Position of points in specified models (e.g. WGS84) and conversion functions between coordinate system (geodetic to/from geocentric).
All functions are implemented using the vector-based approached described in Gade, K. (2010). A Non-singular Horizontal Position Representation
Synopsis
- data Position a
- latitude :: Position a -> Angle
- longitude :: Position a -> Angle
- height :: Position a -> Length
- nvec :: Position a -> Vector3d
- gcvec :: Position a -> Vector3d
- model :: Position a -> a
- data NVector
- nx :: NVector -> Double
- ny :: NVector -> Double
- nz :: NVector -> Double
- nvector :: Model a => Position a -> NVector
- data Geocentric
- gx :: Geocentric -> Length
- gy :: Geocentric -> Length
- gz :: Geocentric -> Length
- geocentric :: Model a => Position a -> Geocentric
- latLongPos :: Model a => Double -> Double -> a -> Position a
- latLongHeightPos :: Model a => Double -> Double -> Length -> a -> Position a
- latLongPos' :: Model a => Angle -> Angle -> a -> Position a
- latLongHeightPos' :: Model a => Angle -> Angle -> Length -> a -> Position a
- wgs84Pos :: Double -> Double -> Length -> Position WGS84
- wgs84Pos' :: Angle -> Angle -> Length -> Position WGS84
- s84Pos :: Double -> Double -> Length -> Position S84
- s84Pos' :: Angle -> Angle -> Length -> Position S84
- nvectorPos :: Model a => Double -> Double -> Double -> a -> Position a
- nvectorHeightPos :: Model a => Double -> Double -> Double -> Length -> a -> Position a
- geocentricPos :: Model a => Length -> Length -> Length -> a -> Position a
- geocentricMetresPos :: Model a => Double -> Double -> Double -> a -> Position a
- nvh :: Model a => Vector3d -> Length -> a -> Position a
- readPosition :: Model a => String -> a -> Maybe (Position a)
- positionP :: Model a => a -> ReadP (Position a)
- nvectorFromLatLong :: (Angle, Angle) -> Vector3d
- nvectorToLatLong :: Vector3d -> (Angle, Angle)
- nvectorFromGeocentric :: Vector3d -> Ellipsoid -> (Vector3d, Length)
- nvectorToGeocentric :: (Vector3d, Length) -> Ellipsoid -> Vector3d
- antipode :: Model a => Position a -> Position a
- latLong :: Model a => Position a -> (Double, Double)
- latLong' :: Model a => Position a -> (Angle, Angle)
- northPole :: Model a => a -> Position a
- southPole :: Model a => a -> Position a
- nvNorthPole :: Vector3d
- nvSouthPole :: Vector3d
- module Data.Geo.Jord.Angle
- module Data.Geo.Jord.Ellipsoid
- module Data.Geo.Jord.Ellipsoids
- module Data.Geo.Jord.LatLong
- module Data.Geo.Jord.Length
- module Data.Geo.Jord.Model
- module Data.Geo.Jord.Models
- module Data.Geo.Jord.Quantity
- module Data.Geo.Jord.Vector3d
The Position
type
Coordinates of a position in a specified Model
.
A position provides both geodetic latitude & longitude, height and
geocentric coordinates. The horizontal position
(i.e. coordinates at the surface of the celestial body) is also provided
as n-vector.
The "show" instance gives position in degrees, minutes, seconds,
milliseconds (Angle
"show" instance), height (Length
"show" instance)
and the model (Model
"show" instance).
The "eq" instance returns True if and only if, both positions have the same horizontal position, height and model.
nvec :: Position a -> Vector3d Source #
n-vector representing the horizontal coordinates of the position
gcvec :: Position a -> Vector3d Source #
vector representing the geocentric coordinates of the position (metres)
n-vector
normal vector to the surface of a celestial body.
Orientation: z-axis points to the North Pole along the body's rotation axis, x-axis points towards the point where latitude = longitude = 0.
nvector :: Model a => Position a -> NVector Source #
nvector p
returns the horizontal position of p
as a n-vector.
Examples
>>>
import Data.Geo.Jord.Position
>>>
>>>
nvector (northPole S84)
n-vector {0.0, 0.0, 1.0}
>>>
nvector (wgs84Pos 54 154 (metres 1000))
n-vector {-0.5282978852629286, 0.2576680951131586, 0.8090169943749475}
Geocentric coordinates
data Geocentric Source #
Geocentric (cartesian) coordinates in the fixed-body coordinates system.
x-y
plane is the equatorial plane, x
is on the prime meridian, and z
on the polar axis.
On a spherical celestial body, an n-vector is equivalent to a normalised version of an geocentric cartesian coordinate.
Note: For Earth, this is known as the Earth-Centred Earth Fixed coordinates system (ECEF).
Instances
Show Geocentric Source # | |
Defined in Data.Geo.Jord.Position showsPrec :: Int -> Geocentric -> ShowS # show :: Geocentric -> String # showList :: [Geocentric] -> ShowS # |
gx :: Geocentric -> Length Source #
x-coordinate of the given Geocentric
coordinates.
gy :: Geocentric -> Length Source #
y-coordinate of the given Geocentric
coordinates.
gz :: Geocentric -> Length Source #
z-coordinate of the given Geocentric
coordinates.
geocentric :: Model a => Position a -> Geocentric Source #
geocentric p
returns the Geocentric
coordinates of position p
.
Examples
>>>
import Data.Geo.Jord.Position
>>>
>>>
geocentric (wgs84Pos 54 154 (metres 1000))
geocentric {-3377.4908375km, 1647.312349km, 5137.5528484km}
Smart constructors
latLongPos :: Model a => Double -> Double -> a -> Position a Source #
Ground Position
from given geodetic latitude & longitude in decimal degrees in
the given model.
Latitude & longitude values are first converted to Angle
to ensure a consistent resolution
with the rest of the API, then wrapped to their respective range.
This is equivalent to:
latLongHeightPos
lat lon zero model
latLongPos' :: Model a => Angle -> Angle -> a -> Position a Source #
Ground Position
from given geodetic latitude & longitude in
the given model.
Latitude & longitude values are wrapped to their respective range.
This is equivalent to:
latLongHeightPos'
lat lon zero model
latLongHeightPos' :: Model a => Angle -> Angle -> Length -> a -> Position a Source #
Position
from given geodetic latitude & longitude and height in the given model.
Latitude & longitude values are wrapped to their respective range.
wgs84Pos :: Double -> Double -> Length -> Position WGS84 Source #
Position
from given geodetic latitude & longitude in decimal degrees and height in
the WGS84 datum.
Latitude & longitude values are first converted to Angle
to ensure a consistent resolution
with the rest of the API, then wrapped to their respective range.
This is equivalent to:
latLongHeightPos
lat lon hWGS84
wgs84Pos' :: Angle -> Angle -> Length -> Position WGS84 Source #
Position
from given geodetic latitude & longitude and height in the WGS84 datum.
Latitude & longitude values are wrapped to their respective range.
This is equivalent to:
latLongHeightPos'
lat lon hWGS84
s84Pos :: Double -> Double -> Length -> Position S84 Source #
Position
from given latitude & longitude in decimal degrees and height in the
spherical datum derived from WGS84.
Latitude & longitude values are first converted to Angle
to ensure a consistent resolution
with the rest of the API, then wrapped to their respective range.
This is equivalent to:
latLongHeightPos
lat lon hS84
s84Pos' :: Angle -> Angle -> Length -> Position S84 Source #
Position
from given latitude & longitude and height in the spherical datum derived
from WGS84. Latitude & longitude values are wrapped to their respective range.
This is equivalent to:
latLongHeightPos'
lat lon hS84
nvectorPos :: Model a => Double -> Double -> Double -> a -> Position a Source #
Position
from given n-vector x, y, z coordinates in the given model.
Vector (x, y, z) will be normalised to a unit vector to get a valid n-vector.
This is equivalent to:
nvectorHeightPos
lat lon zero model
nvectorHeightPos :: Model a => Double -> Double -> Double -> Length -> a -> Position a Source #
Position
from given n-vector x, y, z coordinates and height in the given model.
Vector (x, y, z) will be normalised to a unit vector to get a valid n-vector.
geocentricPos :: Model a => Length -> Length -> Length -> a -> Position a Source #
Position
from given geocentric coordinates x, y and z in the given model.
nvh :: Model a => Vector3d -> Length -> a -> Position a Source #
position from n-vector, height and model; this method is to be used only if
Read/Show points
positionP :: Model a => a -> ReadP (Position a) Source #
Parses and returns a Position
.
Supported formats:
- DD(MM)(SS)[N|S]DDD(MM)(SS)[E|W] - e.g. 553621N0130002E or 0116S03649E or 47N122W
Angle
[N|S]Angle
[E|W] - e.g. 55°36'21''N 13°0'02''E or 11°16'S 36°49'E or 47°N 122°W
Additionally the string may end by a valid Length
.
Examples
>>>
import Data.Geo.Jord.Position
>>>
>>>
readPosition "55°36'21''N 013°00'02''E" WGS84
Just 55°36'21.000"N,13°0'2.000"E 0.0m (WGS84)>>>
>>>
readPosition "55°36'21''N 013°00'02''E 1500m" WGS84
Just 55°36'21.000"N,13°0'2.000"E 1500.0m (WGS84)
Vector3d conversions
nvectorFromLatLong :: (Angle, Angle) -> Vector3d Source #
nvectorFromLatLong ll
returns n-vector equivalent to the given (latitude, longitude) pair ll
.
You should prefer using:
nvector
(latLongPos
lat lon model)
nvectorToLatLong :: Vector3d -> (Angle, Angle) Source #
nvectorToLatLong nv
returns (latitude, longitude) pair equivalent to the given n-vector nv
.
You should prefer using:
latLong
(nvectorPos
x y z model)
Latitude is always in [-90°, 90°] and longitude in [-180°, 180°].
nvectorFromGeocentric :: Vector3d -> Ellipsoid -> (Vector3d, Length) Source #
nvectorFromGeocentric g e
returns the n-vector equivalent to the geocentric
coordinates g
using the ellispoid e
.
You should prefer using:
nvector
(geocentricMetresPos
x y z model)
nvectorToGeocentric :: (Vector3d, Length) -> Ellipsoid -> Vector3d Source #
nvectorToGeocentric (nv, h) e
returns the geocentric coordinates equivalent to the given
n-vector nv
and height h
using the ellispoid e
.
You should prefer using:
geocentric
(nvectorHeightPos
x y z h model)
Misc.
antipode :: Model a => Position a -> Position a Source #
antipode p
computes the antipodal position of p
: the position which is diametrically
opposite to p
.
latLong :: Model a => Position a -> (Double, Double) Source #
(latitude, longitude) pair in decimal degrees from given position.
latLong' :: Model a => Position a -> (Angle, Angle) Source #
(latitude, longitude) pair from given position.
northPole :: Model a => a -> Position a Source #
Horizontal position of the North Pole in the given model.
southPole :: Model a => a -> Position a Source #
Horizontal position of the South Pole in the given model.
nvNorthPole :: Vector3d Source #
Horizontal position of the North Pole (n-vector).
nvSouthPole :: Vector3d Source #
Horizontal position of the South Pole (n-vector).
re-exported for convenience
module Data.Geo.Jord.Angle
module Data.Geo.Jord.Ellipsoid
module Data.Geo.Jord.Ellipsoids
module Data.Geo.Jord.LatLong
module Data.Geo.Jord.Length
module Data.Geo.Jord.Model
module Data.Geo.Jord.Models
module Data.Geo.Jord.Quantity
module Data.Geo.Jord.Vector3d