Updates, fix for addVector

Geo/Computations/Basic.hs

@@ -37,10 +37,10 @@ import Geo.Types
 type Distance = Double
 
 -- |Angles are expressed in radians from North.
--- 	0	== North
--- 	pi/2	== West
--- 	pi 	== South
--- 	(3/2)pi	== East    == - (pi / 2)
+--      0       == North
+--      pi/2    == West
+--      pi      == South
+--      (3/2)pi == East    == - (pi / 2)
 type Heading = Double
 
 -- |Speed is hard coded as meters per second
@@ -69,8 +69,8 @@ distance x y =
 -- | Direction two points aim toward (0 = North, pi/2 = West, pi = South, 3pi/2 = East)
 heading         :: Point -> Point -> Heading
 heading a b =
-	atan2	(sin (diffLon) * cos (lat2))
-		(cos(lat1) * sin (lat2) - sin(lat1) * cos lat2 * cos (diffLon))
+        atan2   (sin (diffLon) * cos (lat2))
+                (cos(lat1) * sin (lat2) - sin(lat1) * cos lat2 * cos (diffLon))
  where
   (lat1, lon1) = getRadianPair a
   (lat2, lon2) = getRadianPair b
@@ -82,23 +82,23 @@ getVector a b = (distance a b, heading a b)
 -- |Given a vector and coordinate, computes a new coordinate.
 -- Within some epsilon it should hold that if
 --
--- 	@dest = addVector (dist,heading) start@
+--      @dest = addVector (dist,heading) start@
 --
 -- then
 --
--- 	@heading == heading start dest@
--- 	
--- 	@dist    == distance start dest@
+--      @heading == heading start dest@
+--      
+--      @dist    == distance start dest@
 addVector :: Vector -> Point -> Point
 addVector (d,h) p =
                   p { pntLon = toDegrees lon2
-		    , pntLat = toDegrees lat2
-			}
+                    , pntLat = toDegrees lat2
+                        }
   where
-	(lat,lon) = getRadianPair p
-	lat2 = asin (sin lat * cos (d / radiusOfEarth) + cos lat
+        (lat,lon) = getRadianPair p
+        lat2 = asin (sin lat * cos (d / radiusOfEarth) + cos lat
                      * sin(d/radiusOfEarth) * cos h)
-        lon2 = lon - atan2 (sin h * sin (d / radiusOfEarth) * cos lat)
+        lon2 = lon + atan2 (sin h * sin (d / radiusOfEarth) * cos lat)
                            (cos (d/radiusOfEarth) - sin lat * sin lat2)
 
 -- | Speed in meters per second, only if a 'Time' was recorded for each waypoint.

Test/GpsTest.hs

@@ -1,24 +1,14 @@
-import Data.GPS
+import Geo.Computations
 import Data.Time
 import Data.List
 import Data.Ord
 import Data.Fixed
 import Test.QuickCheck
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Text.XML.XSD.DateTime
 import Control.Applicative
 import Control.Monad
 
-instance Arbitrary LatitudeType where
-  arbitrary = liftM (latitudeType . flip mod' 180) arbitrary
-
-instance Arbitrary LongitudeType where
-  arbitrary = liftM (longitudeType . flip mod' 180) arbitrary
-
-instance Arbitrary DateTime where
-  arbitrary = liftM fromUTCTime arbitrary
-
 instance Arbitrary UTCTime where
   arbitrary = UTCTime <$> arbitrary <*> liftM (secondsToDiffTime . abs) (arbitrary :: Gen Integer)
 
@@ -27,53 +17,35 @@ instance Arbitrary Day where
 
 instance Arbitrary NominalDiffTime where
   arbitrary = liftM fromIntegral (arbitrary :: Gen Int)
-instance Arbitrary WptType where
+
+instance Arbitrary Point where
   arbitrary =
-    wptType <$> arbitrary -- Lat
-            <*> arbitrary -- Lon
+    pt      <$> fmap (`mod'` 90) arbitrary -- Lat
+            <*> fmap (`mod'` 90) arbitrary -- Lon
             <*> arbitrary -- Time
             <*> arbitrary -- elevation
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return []           -- LinkType
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
-            <*> return Nothing
 
-newtype Trl = Trl [WptType]
+newtype Trl = Trl [Point]
   deriving (Show)
 
 instance Arbitrary Trl where
   arbitrary = do
-    b <- arbitrary :: Gen [Int]
-    u_ts_d <- mapM (\i -> (,,) <$> arbitrary <*> replicateM i arbitrary <*> arbitrary) b :: Gen [(UTCTime, [WptType],NominalDiffTime)]
-    let u_ts_d' = sortBy (comparing (\(a,_,_) -> a)) u_ts_d
-        xs = concat [zipWith (setTime' . fromUTCTime) (iterate (addUTCTime d) u) x | (u,x,d) <- u_ts_d']
-    return $ Trl xs
+    b <- (`mod` 5) `fmap` arbitrary :: Gen Int
+    pnts <- mapM (\_ -> arbitrary) [0..abs b]
+    return $ Trl (sortBy (comparing pntTime) pnts)
 
-approxEq :: WptType -> WptType -> Bool
+approxEq :: Point -> Point -> Bool
 approxEq a b = distance a b <= 0.2 -- error of 13cm has been observed due to floating point issues when using add vector.
 
-pSaneDistance :: WptType -> WptType -> Bool
+pSaneDistance :: Point -> Point -> Bool
 pSaneDistance a b = distance a b <= circumferenceOfEarth / 2
 
-pTriangleTheorem :: WptType -> WptType -> WptType -> Bool
+pTriangleTheorem :: Point -> Point -> Point -> Bool
 pTriangleTheorem a b c = 
     distance a b + distance b c >= distance a c  -- Traditional flat-surface geometry
  || distance a b + distance b c + distance c a == 2 * pi * radiusOfEarth
 
-pAddVector_DistanceHeading_ident :: WptType -> WptType -> Bool
+pAddVector_DistanceHeading_ident :: Point -> Point -> Bool
 pAddVector_DistanceHeading_ident a b =
   let v = (distance a b, heading a b)
       c = addVector v a
@@ -82,7 +54,7 @@ pAddVector_DistanceHeading_ident a b =
 pConvexHull_Has_Extreme_Points :: Trl -> Bool
 pConvexHull_Has_Extreme_Points (Trl ts) =
   let ch = convexHull ts
-      ts' = sortBy (comparing lat) ts
+      ts' = sortBy (comparing pntLat) ts
       northMost = last ts'
       southMost = head ts'
   in length ts < 3 || (northMost `elem` ch && southMost `elem` ch)
@@ -105,9 +77,11 @@ tests =
     , testProperty "TriangleTheorem" pTriangleTheorem
     , testProperty "Vector identity" pAddVector_DistanceHeading_ident
     ]
-  , testGroup "Trail Computations"
-    [ testProperty "Hull has extreme points" pConvexHull_Has_Extreme_Points
-    , testProperty "HullContainsBezier" pConvexHull_Bezier_Const]
+-- These might make some sense in a local scope, but in a global range what
+-- is the "left most" point?  On a sphere what is a convex hull?
+--  , testGroup "Trail Computations"
+--    [ testProperty "Hull has extreme points" pConvexHull_Has_Extreme_Points
+--    , testProperty "HullContainsBezier" pConvexHull_Bezier_Const]
   ]
 
 

gps.cabal

@@ -34,9 +34,9 @@ test-suite gps-tests
   build-depends:
     base >= 4.0,
     QuickCheck >= 2.4.0.1,
-    test-framework >= 0.3.3 && < 0.5,
-    test-framework-quickcheck2 >= 0.2.9 && < 0.3,
-    time, GPX, hxt, xsd, vector, statistics, gps
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9,
+    time, vector, statistics, gps, gpx-conduit
 
   ghc-options: -Wall
 source-repository head