diff --git a/Data/GPS/Core.hs b/Data/GPS/Core.hs --- a/Data/GPS/Core.hs +++ b/Data/GPS/Core.hs @@ -8,6 +8,7 @@ , Trail , Circle , Arc + , Coordinate (..) -- * Constants , north , south @@ -47,6 +48,15 @@ import Data.Geo.GPX import Data.Lens.Common +class (LatL a, LonL a) => Coordinate a where + lat :: a -> Latitude + lat = (^. latL) + lon :: a -> Longitude + lon = (^. lonL) + +instance Coordinate Wpt +instance Coordinate Pt + -- |Distances are expressed in meters type Distance = Double @@ -73,7 +83,7 @@ getUTCTime :: (TimeL a) => a -> Maybe UTCTime getUTCTime = fmap toUTCTime . (^. timeL) -distance :: (LatL a, LonL a, LatL b, LonL b) => a -> b -> Distance +distance :: (Coordinate a, Coordinate b) => a -> b -> Distance distance x y = let (lat1,lon1) = getRadianPairD x (lat2,lon2) = getRadianPairD y @@ -84,7 +94,7 @@ in radiusOfEarth * c -- | Direction two points aim toward (0 = North, pi/2 = West, pi = South, 3pi/2 = East) -heading :: (LatL a, LonL a, LatL b, LonL b) => a -> b -> Heading +heading :: (Coordinate a, Coordinate b) => a -> b -> Heading heading a b = atan2 (sin (diffLon) * cos (lat2)) (cos(lat1) * sin (lat2) - sin(lat1) * cos lat2 * cos (diffLon)) @@ -93,7 +103,7 @@ (lat2, lon2) = getRadianPairD b diffLon = lon2 - lon1 -getVector :: (LatL a, LonL a, LatL b, LonL b) => a -> b -> Vector +getVector :: (Coordinate a, Coordinate b) => a -> b -> Vector getVector a b = (distance a b, heading a b) -- |Given a vector and coordinate, computes a new coordinate. @@ -106,7 +116,7 @@ -- @heading == heading start dest@ -- -- @dist == distance start dest@ -addVector :: (LatL c, LonL c) => Vector -> c -> c +addVector :: (Coordinate c) => Vector -> c -> c addVector (d,h) p = (lonL ^= longitude (toDegrees lon2)) . (latL ^= latitude (toDegrees lat2)) $ p @@ -118,7 +128,7 @@ (cos (d/radiusOfEarth) - sin lat * sin lat2) -- | Speed in meters per second, only if a 'Time' was recorded for each waypoint. -speed :: (LatL loc, LonL loc, TimeL loc, LatL b, LonL b, TimeL b) => loc -> b -> Maybe Speed +speed :: (Coordinate loc, TimeL loc, Coordinate b, TimeL b) => loc -> b -> Maybe Speed speed a b = case (getUTCTime b, getUTCTime a) of (Just x, Just y) -> @@ -152,14 +162,14 @@ toDegrees = (*) (180 / pi) -getRadianPairD :: (LatL c, LonL c) => c -> (Double,Double) +getRadianPairD :: (Coordinate c) => c -> (Double,Double) getRadianPairD = (\(a,b) -> (realToFrac a, realToFrac b)) . getRadianPair -getDMSPair :: (LatL c, LonL c) => c -> (Latitude, Longitude) +getDMSPair :: (Coordinate c) => c -> (Latitude, Longitude) getDMSPair c = (c ^. latL, c ^. lonL) -- |Provides a lat/lon pair of doubles in radians -getRadianPair :: (LatL p, LonL p) => p -> (Latitude, Longitude) +getRadianPair :: (Coordinate p) => p -> (Latitude, Longitude) getRadianPair p = (toRadians (p ^. latL), toRadians (p ^. lonL)) toRadians :: Floating f => f -> f @@ -168,7 +178,7 @@ -- | @interpolate c1 c2 w@ where @0 <= w <= 1@ Gives a point on the line -- between c1 and c2 equal to c1 when @w == 0@ (weighted linearly -- toward c2). -interpolate :: (LatL a, LonL a) => a -> a -> Double -> a +interpolate :: (Coordinate a) => a -> a -> Double -> a interpolate c1 c2 w | w < 0 || w > 1 = error "Interpolate only works with a weight between zero and one" | otherwise = @@ -178,7 +188,7 @@ -- | Compute the points at which two circles intersect (assumes a flat plain). If -- the circles do not intersect or are identical then the result is @Nothing@. -circleIntersectionPoints :: (LatL a, LonL a) => (a, Distance) -> (a, Distance) -> Maybe (a,a) +circleIntersectionPoints :: (Coordinate a) => (a, Distance) -> (a, Distance) -> Maybe (a,a) circleIntersectionPoints (a,r1) (b,r2) | a ^. latL == b ^. latL && a ^. lonL == b ^. lonL && r1 == r2 = Nothing -- FIXME need approx eq | r1 + r2 < ab = Nothing @@ -196,7 +206,7 @@ -- | Find the area in which all given circles intersect. The resulting -- area is described in terms of the bounding arcs. All cirlces must -- intersect at two points. -intersectionArcsOf :: (LatL a, LonL a) => [Circle a] -> [Arc a] +intersectionArcsOf :: (Coordinate a) => [Circle a] -> [Arc a] intersectionArcsOf cs = let isArcWithinCircle circ arc = maximumDistanceOfArc (fst circ) arc <= (snd circ) isArcWithinAllCircles arc = all ($ arc) (map isArcWithinCircle cs) @@ -211,7 +221,7 @@ in [(c1,c1h1,c1h2), (c1,c1h2, c1h1), (c2,c2h1,c2h2), (c2,c2h2,c2h1)] in filter isArcWithinAllCircles . concatMap (uncurry getArcs) . choose2 $ cs -maximumDistanceOfArc :: (LatL a, LonL a) => a -> Arc a -> Distance +maximumDistanceOfArc :: (Coordinate a) => a -> Arc a -> Distance maximumDistanceOfArc pnt ((c,r), h1, h2) = let pcHeading = heading pnt c in if ((pcHeading < h1 || pcHeading > h2) && h1 < h2) || ((pcHeading > h2 && pcHeading < h1) && h1 > h2) @@ -227,7 +237,7 @@ -- southeast point (se). Because this uses floating point there might be a -- different number of points in some rows (the last might be too far east based -- on a heading from the se point). -divideArea :: (LatL c, LonL c) => Distance -> Distance -> c -> c -> [[c]] +divideArea :: (Coordinate c) => Distance -> Distance -> c -> c -> [[c]] divideArea vDist hDist nw se = let (top,left) = (nw ^. latL, nw ^. lonL) (btm,right) = (se ^. latL, se ^. lonL) diff --git a/Data/GPS/Trail.hs b/Data/GPS/Trail.hs --- a/Data/GPS/Trail.hs +++ b/Data/GPS/Trail.hs @@ -82,12 +82,12 @@ -- | @avgSpeeds n points@ -- Average speed using a window of up to @n@ seconds and averaging by taking the -- Median ('AvgMedian'). -avgSpeeds :: (LatL a, LonL a, TimeL a) => NominalDiffTime -> Trail a -> [(UTCTime, Speed)] +avgSpeeds :: (Coordinate a, TimeL a) => NominalDiffTime -> Trail a -> [(UTCTime, Speed)] avgSpeeds = slidingAverageSpeed AvgHarmonicMean -- | @slidingAverageSpeed m n@ Average speed using a moving window of up to @n@ seconds -- and an 'AvgMethod' of @m@. -slidingAverageSpeed :: (LatL a, LonL a, TimeL a) => +slidingAverageSpeed :: (Coordinate a, TimeL a) => AvgMethod a -> NominalDiffTime -> Trail a -> [(UTCTime, Speed)] slidingAverageSpeed _ _ [] = [] slidingAverageSpeed m minTime xs = @@ -175,7 +175,7 @@ -- and all others outside of the speed. The "speed" from point p(i) -- to p(i+1) is associated with p(i) (execpt for the first speed -- value, which is associated with both the first and second point) -betweenSpeeds :: (LatL a, LonL a, TimeL a) => Double -> Double -> PointGrouping a +betweenSpeeds :: (Coordinate a, TimeL a) => Double -> Double -> PointGrouping a betweenSpeeds low hi ps = let spds = concatMap maybeToList $ zipWith speed ps (drop 1 ps) psSpds = [(p,s) | p <- ps, s <- maybeToList (listToMaybe spds) ++ spds] @@ -189,7 +189,7 @@ -- | A "rest point" means the coordinates remain within a given distance -- for at least a particular amount of time. -restLocations :: (LatL a, LonL a, TimeL a) => Distance -> NominalDiffTime -> PointGrouping a +restLocations :: (Coordinate a, TimeL a) => Distance -> NominalDiffTime -> PointGrouping a restLocations d s ps = let consToFirst x [] = [NotSelect [x]] consToFirst x (a:as) = (fmap (x:) a) : as @@ -208,7 +208,7 @@ -- |chunking points into groups spanning at most the given time -- interval. -spansTime :: (LatL a, LonL a, TimeL a) => NominalDiffTime -> PointGrouping a +spansTime :: (Coordinate a, TimeL a) => NominalDiffTime -> PointGrouping a spansTime n ps = let times = mkTimePair ps chunk [] = [] @@ -218,7 +218,7 @@ in map (Select . map fst) $ chunk times -- | intersects the given groupings -intersectionOf :: (LatL a, LonL a, TimeL a) => [PointGrouping a] -> PointGrouping a +intersectionOf :: (Coordinate a, TimeL a) => [PointGrouping a] -> PointGrouping a intersectionOf gs ps = let groupings = map ($ ps) gs -- chunk :: [[Selected [pnts]]] -> pnts -> [pnts] @@ -231,7 +231,7 @@ in chunk groupings ps -- | Union all the groupings -unionOf :: (LatL a, LonL a, TimeL a) => [PointGrouping a] -> PointGrouping a +unionOf :: (Coordinate a, TimeL a) => [PointGrouping a] -> PointGrouping a unionOf gs ps = let groupings = map ($ ps) gs chunk _ [] = [] @@ -338,7 +338,7 @@ -- The current implementation assumes the times of the input -- coordinates are available and all equal (Ex: all points are 5 -- seconds apart), the results will be poor if this is not the case! -bezierCurveAt :: (LatL a, LonL a, TimeL a) => [UTCTime] -> Trail a -> Trail a +bezierCurveAt :: (Coordinate a, TimeL a) => [UTCTime] -> Trail a -> Trail a bezierCurveAt _ [] = [] bezierCurveAt selectedTimes xs = let timesDef = mkTimePair xs @@ -357,7 +357,7 @@ newTimes = [addUTCTime t (snd top) | t <- diffTimes] in zipWith ((timeL ^=) . Just . fromUTCTime) newTimes curvePoints -bezierPoint :: (LatL a, LonL a) => [a] -> Double -> a +bezierPoint :: (Coordinate a) => [a] -> Double -> a bezierPoint pnts t = go pnts where go [] = error "GPS Package: Can not create a bezier point from an empty list" @@ -368,12 +368,12 @@ -- exponentially more expensive with the length of the segement being -- transformed - it is not advisable to perform this operation on -- trail segements with more than ten points! -bezierCurve :: (LatL a, LonL a, TimeL a) => [Selected (Trail a)] -> Trail a +bezierCurve :: (Coordinate a, TimeL a) => [Selected (Trail a)] -> Trail a bezierCurve = concatMap (onSelected (bezierCurveAt []) Prelude.id) -- |Filters out any points that go backward in time (thus must not be -- valid if this is a trail) -linearTime :: (LonL a, LatL a, TimeL a) => [a] -> [a] +linearTime :: (Coordinate a, TimeL a) => [a] -> [a] linearTime [] = [] linearTime (p:ps) = go (getUTCTime p) ps where @@ -383,11 +383,11 @@ -- |Returns the closest distance between two trails (or Nothing if a -- trail is empty). Inefficient implementation: -- O( (n * m) * log (n * m) ) -closestDistance :: (LatL a, LonL a) => Trail a -> Trail a -> Maybe Distance +closestDistance :: (Coordinate a) => Trail a -> Trail a -> Maybe Distance closestDistance as bs = listToMaybe $ L.sort [distance a b | a <- as, b <- bs] -- | Find the total distance traveled -totalDistance :: (LatL a, LonL a) => [a] -> Distance +totalDistance :: (Coordinate a) => [a] -> Distance totalDistance as = sum $ zipWith distance as (drop 1 as) totalTime :: TimeL a => Trail a -> NominalDiffTime @@ -397,7 +397,7 @@ -- | Uses Grahams scan to compute the convex hull of the given points. -- This operation requires sorting of the points, so don't try it unless -- you have notably more memory than the list of points will consume. -convexHull :: (Eq c, LatL c, LonL c) => [c] -> [c] +convexHull :: (Eq c, Coordinate c) => [c] -> [c] convexHull xs = let first = southMost xs in case first of @@ -417,12 +417,12 @@ Straight -> grahamScan (x:p2:p1:ps) xs _ -> grahamScan (p1:ps) (x:xs) -eastZeroHeading :: (LatL c, LonL c) => c -> c -> Heading +eastZeroHeading :: (Coordinate c) => c -> c -> Heading eastZeroHeading s = (`mod'` (2*pi)) . (+ pi/2) . heading s data Turn = LeftTurn | RightTurn | Straight deriving (Eq, Ord, Show, Read, Enum) -turn :: (LatL c, LonL c) => c -> c -> c -> Turn +turn :: (Coordinate c) => c -> c -> c -> Turn turn a b c = let h1 = eastZeroHeading a b h2 = eastZeroHeading b c @@ -440,10 +440,10 @@ -- users or as instructional examples. ------------------------------------------ -smoothRests :: (LatL a, LonL a, TimeL a) => Trail a -> Trail a +smoothRests :: (Coordinate a, TimeL a) => Trail a -> Trail a smoothRests = bezierCurve . refineGrouping (everyNPoints 8) . restLocations 30 60 -smoothSome :: (LatL a, LonL a, TimeL a) => Trail a -> Trail a +smoothSome :: (Coordinate a, TimeL a) => Trail a -> Trail a smoothSome = gSmoothSome 7 gSmoothSome n = bezierCurve . everyNPoints n @@ -453,7 +453,7 @@ (h,t) = splitAt k ps' in h ++ gSmoothSome n t -smoothMore :: (LatL a, LonL a, TimeL a) => Trail a -> Trail a +smoothMore :: (Coordinate a, TimeL a) => Trail a -> Trail a smoothMore = gSmoothMore 7 3 . gSmoothMore 3 1 . gSmoothMore 5 2 . gSmoothMore 3 1 . gSmoothMore 5 2 . gSmoothMore 7 3 diff --git a/gps.cabal b/gps.cabal --- a/gps.cabal +++ b/gps.cabal @@ -1,5 +1,5 @@ name: gps -version: 0.9 +version: 1.0 license: BSD3 license-file: LICENSE author: Thomas DuBuisson