diff --git a/Data/GPS.hs b/Data/GPS.hs --- a/Data/GPS.hs +++ b/Data/GPS.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, EmptyDataDecls #-} -- |Author: Thomas DuBuisson -- Copyright: Thomas DuBuisson -- License: BSD3 @@ -21,21 +21,28 @@ , Location(..) , DMSCoordinate(..) , DMS(..) + , Latitude + , Longitude , Heading , Speed , Vector , Trail + -- * Constants + , north + , south + , east + , west + , radiusOfEarth -- * Helper Functions , smoothTrails , longestSmoothTrail , restLocations , closestDistance , normalizeDMS - -- * KML Operations (Open format used by GoogleEarth, among others) - , KML - , trailToKML - , pointsToKML - , kmlToString + , dmsToDegreePair + , dmsToRadianPair + , degreePairToDMS + , addVector ) where import Data.Ord (comparing) @@ -51,79 +58,41 @@ import Data.Time import Data.Maybe (listToMaybe) -import Text.XML.Light - --- |The KML type and operations might be moved into a Data.KML module in the future -type KML = Element - --- |Converts the KML elements to a string and prepends the proper XML header, --- thus making it the correct format for saving as a file and opening it --- with other programs such as GoogleEarth. -kmlToString :: KML -> String -kmlToString = (++) xml_header . ppElement - -kmlTop = Element (QName "kml" Nothing Nothing) [Attr (basicName "xmlns") "http://www.opengis.net/kml/2.2"] [] Nothing - -addElem :: Element -> Element -> Element -addElem top child = top { elContent = Elem child : elContent top } +-- |Distances are expressed in meters +type Distance = Double -basicName :: String -> QName -basicName n = QName n Nothing Nothing +-- |Angles are expressed in radians from North. +-- 0 == North +-- pi/2 == West +-- pi == South +-- (3/2)pi == East == - (pi / 2) +type Heading = Double -basicElem :: String -> Element -basicElem n = Element (basicName n) [] [] Nothing +-- |Speed is hard coded as meters per second +type Speed = Double -filledElem :: String -> String -> Element -filledElem name val = Element (basicName name) [] [Text (CData CDataText val Nothing)] Nothing +type Vector = (Distance, Heading) +type Trail a = [a] --- |converts a given set of coordinates to a trail in KML format. --- Useful for saving as a file. -trailToKML :: Coordinate a => String -> Trail a -> KML -trailToKML name ps = addElem kmlTop doc - where - doc = foldl addElem (basicElem "Document") (nameElem : trailElem : []) - nameElem = filledElem "name" name - trailName = filledElem "name" (name ++ " trail") - trailElem = foldl addElem (basicElem "Placemark") [trailName, pointsElem] - pointsElem = addElem (basicElem "LineString") (filledElem "coordinates" points) - points :: String - points = concatMap packCoordinate ps - packCoordinate :: Coordinate a => a -> String - packCoordinate x = - let (lat, lon) = getDegreeLatLon x - in concat [lon, ",", lat, ",0 "] +-- |Empty declaration for phantom type +data Latitude --- |converts a given set of coordinates to points in KML format. --- Useful for saving as a file. -pointsToKML :: Coordinate a => String -> [a] -> [String] -> KML -pointsToKML name ps pointNames = addElem kmlTop doc - where - doc = foldl addElem (basicElem "Document") (nameElem : placemarkElems) - nameElem = filledElem "name" name - placemarkElems = map buildPoint (zip ps pointNames) - buildPoint (p,n) = - let (t,g) = getDegreeLatLon p - in foldl addElem (basicElem "Placemark") - [ filledElem "name" n - , foldl addElem (basicElem "LookAt") - [ filledElem "longitude" g - , filledElem "latitude" t - , filledElem "altitude" "0" - , filledElem "range" "500" - ] - , addElem (basicElem "Point") (filledElem "coordinates" (g ++ "," ++ t)) - ] +-- |Empty declaration for phantom type +data Longitude --- |Gets a pair of lat lon bytestrings (in degrees) -getDegreeLatLon :: Coordinate a => a -> (String,String) -getDegreeLatLon x = - let (lat,lon) = dmsToLatLon . toDMS $ x - f = show . toDecimal - in (f lat, f lon) +-- |DMSCoordinate is the typical degree minute second +-- for latitude/longitude used by most civilian GPS devices. +data DMSCoordinate = DMSCoord + { latitude :: DMS Latitude + , longitude :: DMS Longitude + } deriving (Eq, Ord, Show, Read) --- |radius of the earth in meters -radiusOfEarth :: Double -radiusOfEarth = 6378700 +-- |DMS is the degrees, minutes, seconds used for both latitude and longitude +data DMS a = DMS + { degrees :: Double + , minutes :: Double + , seconds :: Double } + deriving (Eq, Ord, Show, Read) -- |A coordinate is a place on earths surface. While twoDMS and fromDMS are the only -- required functions, coordinate systems may provide more accurate calculations @@ -133,10 +102,10 @@ fromDMS :: DMSCoordinate -> a distance :: a -> a -> Distance distance a b = - 3963000 * acos( sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon2 - lon1) ) + radiusOfEarth * acos( sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon2 - lon1) ) where - (lat1, lon1) = dmsToLatLon (toDMS a) - (lat2, lon2) = dmsToLatLon (toDMS b) + (lat1, lon1) = dmsToRadianPair (toDMS a) + (lat2, lon2) = dmsToRadianPair (toDMS b) heading :: a -> a -> Heading -- 0 = North, pi/2 = West... heading a b = dmsHeading (toDMS a) (toDMS b) getVector :: a -> a -> Vector @@ -151,32 +120,84 @@ speed a b = distMeter / timeSec where timeSec = realToFrac $ diffUTCTime (getUTC b) (getUTC a) - distMeter = distance (getDMS a) (getDMS b) + distMeter = distance (getCoordinate a) (getCoordinate b) -toDecimal = (*) (180 / pi) +instance Coordinate DMSCoordinate where + toDMS = id + fromDMS = id --- |Extract a lat/lon from a location. -getDMS :: (Location loc x y) => loc -> DMSCoordinate -getDMS = toDMS . getCoordinate +instance (Coordinate c) => Location (c, UTCTime) c UTCTime where + getCoordinate = fst + getTime = snd + getUTC = snd +instance (Coordinate c) => Coordinate (c,UTCTime) where + toDMS = toDMS . getCoordinate + fromDMS d = (fromDMS d , UTCTime (toEnum 0) 0) + +data TempTrail a = T (Trail a) a + +-- |radius of the earth in meters +radiusOfEarth :: Double +radiusOfEarth = 6378700 + +-- |North is 0 radians +north = 0 + +-- |South, being 180 degrees from North, is pi. +south = pi + +-- |East is 270 degrees from North +east = (3 / 2) * pi + +-- |West is 90 degrees (pi/2) +west = pi / 2 + +toDecimal = (*) (180 / pi) + -- |provides a heading in radians from North dmsHeading :: DMSCoordinate -> DMSCoordinate -> Heading dmsHeading a b = atan2 (sin (diffLon) * cos (lat2)) (cos(lat1) * sin (lat2) - sin(lat1) * cos lat2 * cos (diffLon)) where - (lat1, lon1) = dmsToLatLon a - (lat2, lon2) = dmsToLatLon b + (lat1, lon1) = dmsToRadianPair a + (lat2, lon2) = dmsToRadianPair b diffLon = lon1 - lon2 --- provides a lat/lon pair in radians -dmsToLatLon :: DMSCoordinate -> (Double, Double) -dmsToLatLon (DMSCoord (DMS latD latM latS) (DMS lonD lonM lonS)) = (lat, lon) +-- |Given a vector and coordinate, computes a new DMS coordinate. +-- within some epsilon it should hold that if +-- dest = addVector (dist,heading) start +-- then +-- heading == dmsHeading start dest +-- dist == distance start dest +addVector :: Vector -> DMSCoordinate -> DMSCoordinate +addVector (d,h) dms = degreePairToDMS (toDecimal lat2, toDecimal lon2) where + (lat,lon) = dmsToRadianPair dms + lat2 = lat + (cos h) * (d / radiusOfEarth) + lon2 = lon + acos ( (cos (d/radiusOfEarth) - sin lat * sin lat2) / (cos lat * cos lat2)) + +-- |Provides a lat/lon pair of doubles in radians +dmsToRadianPair :: DMSCoordinate -> (Double, Double) +dmsToRadianPair (DMSCoord (DMS latD latM latS) (DMS lonD lonM lonS)) = (lat, lon) + where lon = toRadians lonD lonM lonS lat = toRadians latD latM latS toRadians d m s = (d + m / 60 + s / 3600) * (pi / 180) +-- |Provides a lat/lon pair of doubles in degrees +dmsToDegreePair :: DMSCoordinate -> (Double,Double) +dmsToDegreePair (DMSCoord (DMS latD latM latS) (DMS lonD lonM lonS)) = (lat, lon) + where + lon = toDegrees lonD lonM lonS + lat = toDegrees latD latM latS + toDegrees d m s = (d + m / 60 + s / 3600) + +-- Given a lat/long pair of doubles in degrees, produces a DMSCoordinate +degreePairToDMS :: (Double,Double) -> DMSCoordinate +degreePairToDMS (lat,lon) = DMSCoord (DMS lat 0 0) (DMS lon 0 0) + -- |Typically useful for printing, normalizes degrees/minutes/seconds -- into just degrees and decimal minutes: -- DMSCoord (DMS 45 36.938455 0) (DMS ...) @@ -191,51 +212,7 @@ d' = fromIntegral (floor all) m' = (all-d') * 60 in DMS d' m' 0 - --- |Distances are expressed in meters -type Distance = Double --- |Angles are expressed in radians from North. --- 0 == North --- pi/2 == West --- pi == South --- (3/2)pi == East == - (pi / 2) -type Heading = Double - --- |Speed is hard coded as meters per second -type Speed = Double - -type Vector = (Distance, Heading) -type Trail a = [a] - --- |DMSCoordinate is the typical degree minute second --- for latitude/longitude used by most civilian GPS devices. -data DMSCoordinate = DMSCoord - { latitude :: DMS - , longitude :: DMS - } deriving (Eq, Ord, Show, Read) - --- |DMS is the degree, minute, seconds used for both latitude and longitude -data DMS = DMS { degrees :: Double - , minutes :: Double - , seconds :: Double } - deriving (Eq, Ord, Show, Read) - -instance Coordinate DMSCoordinate where - toDMS = id - fromDMS = id - -instance (Coordinate c) => Location (c, UTCTime) c UTCTime where - getCoordinate = fst - getTime = snd - getUTC = snd - -instance (Coordinate c) => Coordinate (c,UTCTime) where - toDMS = toDMS . getCoordinate - fromDMS d = (fromDMS d , UTCTime (toEnum 0) 0) - -data TempTrail a = T (Trail a) a - fromTemp :: TempTrail a -> Trail a fromTemp (T ps p) = reverse (p:ps) @@ -262,6 +239,7 @@ longestSmoothTrail :: Location a b c => Speed -> Trail a -> Trail a longestSmoothTrail metersPerSec trail = maximumBy (comparing length) ([] : smoothTrails metersPerSec trail) +-- |Filters out any points that go backward in time (thus must not be valid if this is a trail) linearTime :: Location a b c => Trail a -> Trail a linearTime [] = [] linearTime (p:ps) = go (getUTC p) ps diff --git a/Data/GPS/KML.hs b/Data/GPS/KML.hs new file mode 100644 --- /dev/null +++ b/Data/GPS/KML.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, EmptyDataDecls #-} +-- |Author: Thomas DuBuisson +-- Copyright: Thomas DuBuisson +-- License: BSD3 +module Data.GPS.KML + ( -- * KML Operations (Open format used by GoogleEarth, among others) + KML + , trailToKML + , pointsToKML + , kmlToString + ) where + +import Text.XML.Light +import Data.GPS + +-- |The KML type and operations might be moved into a Data.KML module in the future +type KML = Element + +-- |Converts the KML elements to a string and prepends the proper XML header, +-- thus making it the correct format for saving as a file and opening it +-- with other programs such as GoogleEarth. +kmlToString :: KML -> String +kmlToString = (++) xml_header . ppElement + +kmlTop = Element (QName "kml" Nothing Nothing) [Attr (basicName "xmlns") "http://www.opengis.net/kml/2.2"] [] Nothing + +addElem :: Element -> Element -> Element +addElem top child = top { elContent = Elem child : elContent top } + +basicName :: String -> QName +basicName n = QName n Nothing Nothing + +basicElem :: String -> Element +basicElem n = Element (basicName n) [] [] Nothing + +filledElem :: String -> String -> Element +filledElem name val = Element (basicName name) [] [Text (CData CDataText val Nothing)] Nothing + +-- |converts a given set of coordinates to a trail in KML format. +-- Useful for saving as a file. +trailToKML :: Coordinate a => String -> Trail a -> KML +trailToKML name ps = addElem kmlTop doc + where + doc = foldl addElem (basicElem "Document") (nameElem : trailElem : []) + nameElem = filledElem "name" name + trailName = filledElem "name" (name ++ " trail") + trailElem = foldl addElem (basicElem "Placemark") [trailName, pointsElem] + pointsElem = addElem (basicElem "LineString") (filledElem "coordinates" points) + points :: String + points = concatMap packCoordinate ps + packCoordinate :: Coordinate a => a -> String + packCoordinate x = + let (lat, lon) = getDegreeLatLon x + in concat [lon, ",", lat, ",0 "] + +-- |converts a given set of coordinates to points in KML format. +-- Useful for saving as a file. +pointsToKML :: Coordinate a => String -> [a] -> [String] -> KML +pointsToKML name ps pointNames = addElem kmlTop doc + where + doc = foldl addElem (basicElem "Document") (nameElem : placemarkElems) + nameElem = filledElem "name" name + placemarkElems = map buildPoint (zip ps pointNames) + buildPoint (p,n) = + let (t,g) = getDegreeLatLon p + in foldl addElem (basicElem "Placemark") + [ filledElem "name" n + , foldl addElem (basicElem "LookAt") + [ filledElem "longitude" g + , filledElem "latitude" t + , filledElem "altitude" "0" + , filledElem "range" "500" + ] + , addElem (basicElem "Point") (filledElem "coordinates" (g ++ "," ++ t)) + ] + +-- |Gets a pair of lat lon bytestrings (in degrees) +getDegreeLatLon :: Coordinate a => a -> (String,String) +getDegreeLatLon x = + let (lat,lon) = dmsToRadianPair . toDMS $ x + f = show . (*) (180 / pi) + in (f lat, f lon) + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +0,0 @@ -Copyright (c) Thomas DuBuisson - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - -3. Neither the name of the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS -OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, -STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN -ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. diff --git a/gps.cabal b/gps.cabal --- a/gps.cabal +++ b/gps.cabal @@ -1,5 +1,5 @@ name: gps -version: 0.2.4 +version: 0.3.0 license: BSD3 license-file: LICENSE author: Thomas DuBuisson @@ -17,13 +17,9 @@ Description: Choose the split-up base package. Library - if flag(small_base) - Build-Depends: base >= 3 && < 5, bytestring >= 0.9 && < 1.0, binary >= 0.4.0 && < 0.6.0, + Build-Depends: base >= 3 && < 5, bytestring >= 0.9 && < 1.0, binary >= 0.4.0 && < 0.6.0, pretty >= 1.0 && < 1.1 , prettyclass >= 1.0 && < 1.1, xml >= 1.3 && < 1.4, time >= 1.1.2 && < 1.2 - else - Build-Depends: base >= 3 && < 5, bytestring >= 0.9 && < 1.0, binary >= 0.4.0 && < 0.6.0, - pretty >= 1.0 && < 1.1 , prettyclass >= 1.0 && < 1.1, xml >= 1.3 && < 1.4 hs-source-dirs: - exposed-modules: Data.GPS + exposed-modules: Data.GPS, Data.GPS.KML ghc-options: