hcoord-1.0.0.0: src/MGRSRef.hs
{-# LANGUAGE CPP #-}
{-|
To represent a Military Grid Reference System (MGRS) reference.
Military Grid Reference System (MGRS)
The Military Grid Reference System (MGRS) is an extension of the Universal
Transverse Mercator (UTM) reference system. An MGRS reference is made from 5
parts:
UTM Longitude Zone
This is a number indicating which UTM longitude zone the reference falls
into. Zones are numbered from 1 (starting at 180°W) through 60. Each zone
is 6° wide.
UTM Latitude Zone
Latitude is split into regions that are 8° high, starting at 80°S.
Latitude zones are lettered using C through X, but omitting I and O as they
can easily be confused with the numbers 1 and 0.
100,000m Square identification
Each UTM zone is treated as a square 100,000m to a side. The 50,000m easting
is centred on the centre-point of the UTM zone. 100,000m squares are
identified using two characters - one to identify the row and one to identify
the column.
Row identifiers use the characters A through V (omitting I and O again). The
sequence is repeated every 2,000,000m from the equator. If the UTM longitude
zone is odd, then the lettering is advanced by five characters to start at F.
Column identifiers use the characters A through Z (again omitting I and O).
Easting and northing
Each 100,000m grid square is further divided into smaller squares
representing 1m, 10m, 100m, 1,000m and 10,000m precision. The easting and
northing are given using the numeric row and column reference of the square,
starting at the bottom-left corner of the square.
MGRS Reference Example
18SUU8362601432 is an example of an MGRS reference. '18' is the UTM longitude
zone, 'S' is the UTM latitude zone, 'UU' is the 100,000m square
identification, 83626 is the easting reference to 1m precision and 01432 is
the northing reference to 1m precision.
MGRSRef
Methods are provided to query an MGRSRef object for its
parameters. As MGRS references are related to UTM references, a
{@link MGRSRef#toUTMRef() toUTMRef()} method is provided to
convert an MGRSRef object into a {@link UTMRef}
object. The reverse conversion can be made using the
{@link #MGRSRef(UTMRef) MGRSRef(UTMRef)} constructor.
MGRSRef objects can be converted to {@link LatLng LatLng}
objects using the {@link MGRSRef#toLatLng() toLatLng()} method. The reverse
conversion is made using the {@link LatLng#toMGRSRef() LatLng.toMGRSRef()} method.
Some MGRS references use the Bessel 1841 ellipsoid rather than the Geodetic
Reference System 1980 (GRS 1980), International or World Geodetic System 1984
(WGS84) ellipsoids. Use the constructors with the optional boolean parameter
to be able to specify whether your MGRS reference uses the Bessel 1841
ellipsoid. Note that no automatic determination of the correct ellipsoid to
use is made.
Important note: There is currently no support for MGRS references in
polar regions north of 84°N and south of 80°S. There is also no
account made for UTM zones with slightly different sizes to normal around
Svalbard and Norway.
-}
module MGRSRef where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad.Except
import Data.Char
import Data.Fixed
import Text.Regex.PCRE
import Datum
import qualified UTMRef as U
data MGRSRef = MGRSRef { easting :: Int
, northing :: Int
, eastingId :: Char
, northingId :: Char
, utmZoneNumber :: Int
, utmZoneChar :: Char
, precision :: Precision
, isBessel :: Bool
, datum :: Datum
} deriving (Eq)
data Precision = M1 -- ^ precision of 1m
| M10 -- ^ precision of 10m
| M100 -- ^ precision of 100m
| M1000 -- ^ precision of 1000m (1km)
| M10000 -- ^ precision of 10000m (10km)
deriving (Eq)
instance Enum Precision where
fromEnum M1 = 1
fromEnum M10 = 10
fromEnum M100 = 100
fromEnum M1000 = 1000
fromEnum M10000 = 10000
toEnum 1 = M1
toEnum 10 = M10
toEnum 100 = M100
toEnum 1000 = M1000
toEnum 10000 = M10000
-- | Northing characters
northingIds :: [Char]
northingIds = [ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'J', 'K'
, 'L', 'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'U', 'V' ]
instance Show MGRSRef where
show m@(MGRSRef _ _ _ _ _ _ precision _ _) = showWithPrecision m precision
-- | Return a String representation of this MGRS reference to 1m, 10m, 100m, 1000m or 10000m precision.
showWithPrecision :: MGRSRef
-> Precision -- ^ One of MGRSRef.PRECISION_1M, MGRSRef.PRECISION_10M, MGRSRef.PRECISION_100M, MGRSRef.PRECISION_1000M, MGRSRef.PRECISION_10000M.
-> String -- ^ ~ String representation of this MGRS reference to the required precision.
showWithPrecision (MGRSRef easting northing eastingId northingId utmZoneNumber utmZoneChar _ _ _) precision = do
let
p = fromEnum precision
eastingR = easting `div` p
northingR = northing `div` p
padding = case precision of
M1 -> 5
M10 -> 4
M100 -> 3
M1000 -> 2
M10000 -> 1
eastingRs = padWithZeros (show eastingR) padding
northingRs = padWithZeros (show northingR) padding
utmZonePadding = if (utmZoneNumber < 10) then "0" else ""
utmZonePadding ++ show utmZoneNumber ++ [utmZoneChar] ++ [eastingId] ++ [northingId] ++ eastingRs ++ northingRs
where padWithZeros :: String -> Int -> String
padWithZeros text padding =
if (padding - length text > 0) then padWithZeros ('0' : text) padding
else text
{-|
Create a new MGRS reference object from the given UTM reference. It is
assumed that this MGRS reference represents a point using the GRS 1980,
International or WGS84 ellipsoids. It is assumed that the UTMRef object is
valid.
-}
toMGRSRef :: U.UTMRef -- ^ UTM reference.
-> Bool -- ^ True if the parameters represent an MGRS reference using the Bessel 1841 ellipsoid; false is the parameters represent an MGRS reference using the GRS 1980, International or WGS84 ellipsoids.
-> MGRSRef
toMGRSRef (U.UTMRef easting northing latZone lngZone _) isBessel = do
let
set = (lngZone - 1) `mod` 6 + 1
eId = (\x -> x + (if x > 14 then 1 else 0))
. (\x -> x + (if x > 8 then 1 else 0))
$ (floor (easting / 100000.0) + 8 * ((set - 1) `mod` 3))
eIdC = chr $ eId + 64
nId = (\x -> x - (if x > 19 then 20 else 0))
. (\x -> x + (if isBessel then 10 else 0))
. (\x -> x + (if even set then 5 else 0))
$ floor ((northing `mod'` 2000000) / 100000.0)
nIdC = northingIds !! nId
MGRSRef (round(easting) `mod` 100000) (round(northing) `mod` 100000) eIdC nIdC lngZone latZone M1 isBessel wgs84Datum
mkMGRSRef :: Int -- ^ The easting in metres. Must be greater than or equal to 0.0 and less than 100000.
-> Int -- ^ The northing in metres. Must be greater than or equal to 0.0 and less than or equal to 500000.0.
-> Char -- ^ The character representing the 100,000km easting square.
-> Char -- ^ The character representing the 100,000km northing square.
-> Int -- ^ The UTM zone number representing the longitude.
-> Char -- ^ The UTM zone character representing the latitude.
-> Precision -- ^ The precision of the given easting and northing.
-> Bool -- ^ True if the parameters represent an MGRS reference using the Bessel 1841 ellipsoid; False is the parameters represent an MGRS reference using the GRS 1980, International or WGS84 ellipsoids.
-> Except String MGRSRef -- ^ Throws an exception if any of the given parameters are invalid. Note that the parameters are only checked for the range of values that they can take on. Being able to create an MGRSRef object does not necessarily imply that the reference is valid.
mkMGRSRef e n eId nId un uc p b = do
est <- withExcept (const "Invalid easting") (evalEasting e)
nrt <- withExcept (const "Invalid northing") (evalNorthing n)
estId <- withExcept (const "Invalid eastingId") (evalEastingId eId)
nrtId <- withExcept (const "Invalid northingId") (evalNorthingId nId)
uzn <- withExcept (const "Invalid utmZoneNumber") (evalUtmZoneNumber un)
uzc <- withExcept (const "Invalid utmZoneChar") (evalUtmZoneChar uc)
pure MGRSRef { easting = est
, northing = nrt
, eastingId = estId
, northingId = nrtId
, utmZoneNumber = uzn
, utmZoneChar = uzc
, precision = p
, isBessel = b
, datum = wgs84Datum }
where evalEasting :: Int -> Except String Int
evalEasting e | e < 0 || e > 99999 = throwError ("Invalid easting (" ++ show e ++ ")")
| otherwise = pure (e)
evalNorthing :: Int -> Except String Int
evalNorthing n | n < 0 || n > 99999 = throwError ("Invalid northing (" ++ show n ++ ")")
| otherwise = pure (n)
evalUtmZoneNumber :: Int -> Except String Int
evalUtmZoneNumber u | u < 1 || u > 60 = throwError ("Invalid utmZoneNumber (" ++ show u ++ ")")
| otherwise = pure (u)
evalUtmZoneChar :: Char -> Except String Char
evalUtmZoneChar u | u < 'A' || u > 'Z' = throwError ("Invalid utmZoneChar (" ++ show u ++ ")")
| otherwise = pure (u)
evalEastingId :: Char -> Except String Char
evalEastingId e | e < 'A' || e > 'Z' || e == 'I' || e == 'O' = throwError ("Invalid eastingId (" ++ show e ++ ")")
| otherwise = pure (e)
evalNorthingId :: Char -> Except String Char
evalNorthingId n | n < 'A' || n > 'Z' || n == 'I' || n == 'O' = throwError ("Invalid northingId (" ++ show n ++ ")")
| otherwise = pure (n)
{-|
Create a new MGRS reference object from the given String. Must be correctly
formatted otherwise an IllegalArgumentException will be thrown.
-}
mkMGRSRef' :: String -- ^ A String to create an MGRS reference from.
-> Except String MGRSRef -- ^ Throws an exception if the given String is not correctly formatted.
mkMGRSRef' ref = do
groups <- withExcept (const "Invalid easting") (evalRefMatch ref)
let
group = head groups
en = group !! 5
enlh = length en `div` 2
p = 10 ^ (5 - enlh)
pure MGRSRef { easting = p * (read (take enlh en) :: Int)
, northing = p * (read (drop enlh en) :: Int)
, eastingId = (group !! 3) !! 0
, northingId = (group !! 4) !! 0
, utmZoneNumber = read (group !! 1) :: Int
, utmZoneChar = (group !! 2) !! 0
, precision = toEnum p
, isBessel = False
, datum = wgs84Datum }
where evalRefMatch :: String -> Except String [[String]]
evalRefMatch ref = do
let groups = ref =~ "(\\d{1,2})((?![IO])[C-X])((?![IO])[A-Z])((?![IO])[A-Z])(\\d{2,10})" :: [[String]]
case groups of
[] -> throwError ("No matches")
[_,_,_,_,_,en]
| odd $ length en -> throwError ("Invalid ref")
| otherwise -> pure groups
_ -> pure groups
-- | Convert this MGRS reference to an equivelent UTM reference.
toUTMRef :: MGRSRef -> Except String U.UTMRef
toUTMRef (MGRSRef easting northing eastingId northingId utmZoneNumber utmZoneChar _ _ _) = do
let
set = (utmZoneNumber - 1) `mod` 6 + 1
isOffset = even set
e = (\x -> if (x > 9) then x - 1 else x)
. (\x -> if (x > 15) then x - 1 else x)
$ ord eastingId - 65
ex = (easting + ((e `mod` 8 + 1) * 100000)) `mod` 1000000
n = (\x -> if (x < 0) then x + 16 else x)
. (\x -> if isOffset then x - 5 else x)
. (\x -> if (x > 9) then x - 1 else x)
. (\x -> if (x > 15) then x - 1 else x)
$ ord northingId - 64
nn = case utmZoneChar of
'Q'
| (not(isOffset) && northingId < 'T') || (isOffset && (northingId < 'C' || northingId > 'E')) -> 2000000
| otherwise -> 0
'R' -> 2000000
'S'
| (not(isOffset) && northingId < 'R') || (isOffset && northingId > 'E') -> 4000000
| otherwise -> 2000000
'T' -> 4000000
'U'
| (not(isOffset) && northingId < 'P') || (isOffset && northingId > 'U') -> 6000000
| otherwise -> 4000000
'V' -> 6000000
'W' -> 6000000
'X' -> 8000000
nx = nn + (100000 * (n - 1)) + northing
U.mkUTMRef (fromIntegral ex) (fromIntegral nx) utmZoneChar utmZoneNumber