astro 0.4.1.1 → 0.4.1.2
raw patch · 21 files changed
+1655/−328 lines, 21 filesdep −aesondep −bytestringdep −optparse-applicativedep ~basePVP ok
version bump matches the API change (PVP)
Dependencies removed: aeson, bytestring, optparse-applicative
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- README.md +1/−0
- app/Main.hs +0/−314
- astro.cabal +21/−14
- test/Data/Astro/CelestialObject/RiseSetTest.hs +81/−0
- test/Data/Astro/CelestialObjectTest.hs +32/−0
- test/Data/Astro/CoordinateTest.hs +180/−0
- test/Data/Astro/Effects/ParallaxTest.hs +47/−0
- test/Data/Astro/EffectsTest.hs +86/−0
- test/Data/Astro/MoonTest.hs +74/−0
- test/Data/Astro/Planet/PlanetDetailsTest.hs +25/−0
- test/Data/Astro/Planet/PlanetMechanicsTest.hs +131/−0
- test/Data/Astro/Sun/SunInternalsTest.hs +35/−0
- test/Data/Astro/SunTest.hs +181/−0
- test/Data/Astro/Time/ConvTest.hs +50/−0
- test/Data/Astro/Time/GregorianCalendarTest.hs +57/−0
- test/Data/Astro/Time/JulianDateTest.hs +161/−0
- test/Data/Astro/Time/SiderealTest.hs +112/−0
- test/Data/Astro/TimeTest.hs +42/−0
- test/Data/Astro/TypesTest.hs +168/−0
- test/Data/Astro/UtilsTest.hs +86/−0
- test/Test/HUnit/Approx.hs +85/−0
README.md view
@@ -3,6 +3,7 @@ [](https://travis-ci.org/Alexander-Ignatyev/astro) [](https://coveralls.io/github/Alexander-Ignatyev/astro) [](https://alexander-ignatyev.github.io/astro-docs/doc/index.html)+[](https://hackage.haskell.org/package/astro) ## Usage
− app/Main.hs
@@ -1,314 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-module Main where--import GHC.Generics-import Data.Aeson-import qualified Data.ByteString.Lazy.Char8 as B-import Data.Maybe (fromMaybe)-import Data.Time.LocalTime (ZonedTime, getZonedTime)-import Options.Applicative-import Data.Monoid((<>))---- Astro Imports-import Data.Astro.Time.JulianDate-import Data.Astro.Time.Conv (zonedTimeToLCT, zonedTimeToLCD, lctToZonedTime)--import Data.Astro.Effects (refract)-import Data.Astro.CelestialObject.RiseSet(riseAndSetLCT, riseAndSet2, RiseSetMB(..), RiseSetLCT(..))--import Data.Astro.Sun--import Data.Astro.Star--import Data.Astro.Types-import Data.Astro.Coordinate--import Data.Astro.Moon (moonPosition1, moonDistance1, moonAngularSize)-import Data.Astro.Moon.MoonDetails (j2010MoonDetails, mduToKm)--import Data.Astro.Planet (Planet(..), planetPosition, planetTrueAnomaly1, planetDistance1, planetAngularDiameter)-import Data.Astro.Planet.PlanetDetails (j2010PlanetDetails)---main :: IO ()-main = execParser opts >>= run- where opts = info (cmdOptions <**> helper)- ( progDesc "Amateur astronomical computations"- <> header "Astro" )---run :: CmdOptions -> IO ()-run cmdOptions = do- defParams <- defaultParams- let params = fromMaybe defParams $ fromMaybe defParams <$> decode <$> B.pack <$> cmdJson cmdOptions- res = processQuery params- B.putStrLn $ encode res----- Calcs-calculateSunResult :: Params -> PlanetaiResult-calculateSunResult params = PR {- riseSet = riseSet- , distance = DR distance "km"- , angularSize = angularSize- , position = hcPosition- }- where coords = paramsCoordinates params- date = paramsDate params- lct = paramsDateTime params- jd = lctUniversalTime lct- rs = sunRiseAndSet coords 0.833333 date- riseSet = toRiseSetResult rs- distance = sunDistance jd- DD angularSize = sunAngularSize jd- ec1 = sunPosition2 jd- hcPosition = toHorizonCoordinatesResult coords jd ec1---calculateMoonResult :: Params -> PlanetaiResult-calculateMoonResult params = PR {- riseSet = riseSet- , distance = DR distance "km"- , angularSize = angularSize- , position = hcPosition- }- where position = moonPosition1 j2010MoonDetails- coords = paramsCoordinates params- verticalShift = refract (DD 0) 12 1012- date = paramsDate params- lct = paramsDateTime params- jd = lctUniversalTime lct- rs = riseAndSet2 0.000001 position coords verticalShift date- riseSet = toRiseSetResult rs- mdu = moonDistance1 j2010MoonDetails jd- distance = mduToKm mdu- DD angularSize = moonAngularSize mdu- ec1 = position jd- hcPosition = toHorizonCoordinatesResult coords jd ec1---calculatePlanetResult :: Params -> Planet -> PlanetaiResult-calculatePlanetResult params planet = PR {- riseSet = riseSet- , distance = DR distance "AU"- , angularSize = angularSize- , position = hcPosition- }- where coords = paramsCoordinates params- verticalShift = refract (DD 0) 12 1012- date = paramsDate params- lct = paramsDateTime params- jd = lctUniversalTime lct- planetDetails = j2010PlanetDetails planet- earthDetails = j2010PlanetDetails Earth- position = planetPosition planetTrueAnomaly1 planetDetails earthDetails- rs = riseAndSet2 0.000001 position coords verticalShift date- riseSet = toRiseSetResult rs- au = planetDistance1 planetDetails earthDetails jd- AU distance = au- DD angularSize = planetAngularDiameter planetDetails au- ec1 = position jd- hcPosition = toHorizonCoordinatesResult coords jd ec1---calculateStarResult :: Params -> Star -> StarResult-calculateStarResult params star = SR {- starRiseSet = riseSet- , starPosition = hcPosition- }- where coords = paramsCoordinates params- verticalShift = refract (DD 0) 12 1012- date = paramsDate params- lct = paramsDateTime params- jd = lctUniversalTime lct- ec1 = starCoordinates star- rs = riseAndSetLCT coords date verticalShift ec1- riseSet = fromRiseSetLCT rs- hcPosition = toHorizonCoordinatesResult coords jd ec1---toRiseSetResult :: RiseSetMB -> RiseSetResult-toRiseSetResult rs = case rs of- RiseSet rise set -> RSR { rise = lctToZonedTime <$> fst <$> rise- , riseAzimuth = ddValue <$> snd <$> rise- , set = lctToZonedTime <$> fst <$> set- , setAzimuth = ddValue <$> snd <$> set- , state = "Rise and/or set"- }- Circumpolar -> RSR Nothing Nothing Nothing Nothing "Circumpolar"- NeverRises -> RSR Nothing Nothing Nothing Nothing "NeverRises"---fromRiseSetLCT :: RiseSetLCT -> RiseSetResult-fromRiseSetLCT rs = case rs of- RiseSet rise set -> RSR { rise = Just $ lctToZonedTime $ fst rise- , riseAzimuth = Just $ ddValue $ snd $ rise- , set = Just $ lctToZonedTime $ fst set- , setAzimuth = Just $ ddValue $ snd $ set- , state = "Rise and Set"- }- Circumpolar -> RSR Nothing Nothing Nothing Nothing "Circumpolar"- NeverRises -> RSR Nothing Nothing Nothing Nothing "NeverRises"---ddValue :: DecimalDegrees -> Double-ddValue (DD value) = value--toHorizonCoordinatesResult :: GeographicCoordinates- -> JulianDate- -> EquatorialCoordinates1- -> HorizonCoordinatesResult-toHorizonCoordinatesResult (GeoC lat long) jd (EC1 delta alpha) = HCR altitude azimuth- where ec2 = EC2 delta (raToHA alpha long jd)- hc = equatorialToHorizon lat ec2- HC (DD altitude) (DD azimuth) = hc- - - --processQuery :: Params -> AstroResult-processQuery params = AstroResult {- request = params- , sun = calculateSunResult params- , moon = calculateMoonResult params- , mercury = calculatePlanetResult params Mercury- , venus = calculatePlanetResult params Venus- , mars = calculatePlanetResult params Mars- , jupiter = calculatePlanetResult params Jupiter- , saturn = calculatePlanetResult params Saturn- , uranus = calculatePlanetResult params Uranus- , neptune = calculatePlanetResult params Neptune- , polaris = calculateStarResult params Polaris- , alphaCrucis = calculateStarResult params AlphaCrucis- , sirius = calculateStarResult params Sirius- , betelgeuse = calculateStarResult params Betelgeuse- , rigel = calculateStarResult params Rigel- , vega = calculateStarResult params Vega- , antares = calculateStarResult params Antares- , canopus = calculateStarResult params Canopus- , pleiades = calculateStarResult params Pleiades- }----- Command Line Options-data CmdOptions = CmdOptions {- cmdJson :: Maybe String- }---cmdOptions :: Parser CmdOptions-cmdOptions = CmdOptions- <$> (optional $ strOption ( long "json" <> short 'j' <> help "JSON-encoded params") )----- Params-data CoordinatesParam = CoordinatesParam {- latitude :: Double- , longitude :: Double- } deriving (Generic, Show)--instance ToJSON CoordinatesParam-instance FromJSON CoordinatesParam---data Params = Params {- coordinates :: CoordinatesParam- , datetime :: ZonedTime- } deriving (Generic, Show)--instance ToJSON Params-instance FromJSON Params---paramsCoordinates :: Params -> GeographicCoordinates-paramsCoordinates params = GeoC (DD $ latitude coords) (DD $ longitude coords)- where coords = coordinates params---paramsDateTime :: Params -> LocalCivilTime-paramsDateTime = zonedTimeToLCT . datetime---paramsDate :: Params -> LocalCivilDate-paramsDate = zonedTimeToLCD . datetime---greenwichCoordinates :: CoordinatesParam-greenwichCoordinates = CoordinatesParam 51.4768 0---defaultParams :: IO (Params)-defaultParams = do- time <- getZonedTime- return Params {- coordinates = greenwichCoordinates- , datetime = time- }----- Result-data HorizonCoordinatesResult = HCR {- altitude :: Double- , azimuth :: Double- } deriving (Generic, Show)--instance ToJSON HorizonCoordinatesResult--data RiseSetResult = RSR {- rise :: Maybe ZonedTime- , riseAzimuth :: Maybe Double- , set :: Maybe ZonedTime- , setAzimuth :: Maybe Double- , state :: String- } deriving (Generic, Show)--instance ToJSON RiseSetResult---data DistanceResult = DR {- value :: Double- , units :: String- } deriving (Generic, Show)--instance ToJSON DistanceResult--data PlanetaiResult = PR {- riseSet :: RiseSetResult- , distance :: DistanceResult- , angularSize:: Double- , position :: HorizonCoordinatesResult - } deriving (Generic, Show)--instance ToJSON PlanetaiResult--data StarResult = SR {- starRiseSet :: RiseSetResult- , starPosition :: HorizonCoordinatesResult- } deriving (Generic, Show)--instance ToJSON StarResult--data AstroResult = AstroResult {- request :: Params- , sun :: PlanetaiResult- , moon :: PlanetaiResult- , mercury :: PlanetaiResult- , venus :: PlanetaiResult- , mars :: PlanetaiResult- , jupiter :: PlanetaiResult- , saturn :: PlanetaiResult- , uranus :: PlanetaiResult- , neptune :: PlanetaiResult- , polaris :: StarResult- , alphaCrucis :: StarResult- , sirius :: StarResult- , betelgeuse :: StarResult- , rigel :: StarResult- , vega :: StarResult- , antares :: StarResult- , canopus :: StarResult- , pleiades :: StarResult- } deriving (Generic, Show)--instance ToJSON AstroResult
astro.cabal view
@@ -1,6 +1,6 @@ name: astro-version: 0.4.1.1-synopsis: Astro+version: 0.4.1.2+synopsis: Amateur astronomical computations description: Please see README.md homepage: https://github.com/alexander-ignatyev/astro license: BSD3@@ -45,22 +45,29 @@ , matrix default-language: Haskell2010 -executable astro-app- hs-source-dirs: app- main-is: Main.hs- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends: base- , bytestring- , time- , aeson- , optparse-applicative- , astro- default-language: Haskell2010- test-suite astro-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs+ other-modules: Data.Astro.CelestialObject.RiseSetTest+ , Data.Astro.CelestialObjectTest+ , Data.Astro.CoordinateTest+ , Data.Astro.Effects.ParallaxTest+ , Data.Astro.EffectsTest+ , Data.Astro.MoonTest+ , Data.Astro.Planet.PlanetDetailsTest+ , Data.Astro.Planet.PlanetMechanicsTest+ , Data.Astro.Sun.SunInternalsTest+ , Data.Astro.SunTest+ , Data.Astro.Time.ConvTest+ , Data.Astro.Time.GregorianCalendarTest+ , Data.Astro.Time.JulianDateTest+ , Data.Astro.Time.SiderealTest+ , Data.Astro.TimeTest+ , Data.Astro.TypesTest+ , Data.Astro.UtilsTest+ , Test.HUnit.Approx+ build-depends: base , astro , time
+ test/Data/Astro/CelestialObject/RiseSetTest.hs view
@@ -0,0 +1,81 @@+module Data.Astro.CelestialObject.RiseSetTest+(+ tests+)++where++ +import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Control.Monad (unless)++import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..), fromDMS, fromHMS)+import Data.Astro.Coordinate (EquatorialCoordinates1(..))+import Data.Astro.Time.Sidereal (lstToDH, dhToLST)+import Data.Astro.CelestialObject.RiseSet+import Data.Astro.Star++tests = [testGroup "riseAndSet" [+ testRiseAndSet "a star, NH"+ 0.000001+ (RiseSet (dhToLST 16.721731, DD 64.362370) (dhToLST 6.589380, DD 295.637630))+ (riseAndSet (EC1 (fromDMS 21 42 0) (fromHMS 23 39 20)) verticalShift (DD 30))+ , testRiseAndSet "Polaris, NH"+ 0.000001+ Circumpolar+ (riseAndSet ecPolaris verticalShift (DD 30))+ , testRiseAndSet "Polaris, SH"+ 0.000001+ NeverRises+ (riseAndSet ecPolaris verticalShift (DD $ -30))+ , testRiseAndSet "Alpha Crucis, NH"+ 0.000001+ NeverRises+ (riseAndSet ecAlphaCrucis verticalShift (DD 30))+ , testRiseAndSet "Alpha Crucis, SH"+ 0.000001+ Circumpolar+ (riseAndSet ecAlphaCrucis verticalShift (DD $ -30))+ , testRiseAndSet "Sirius, NH"+ 0.000001+ (RiseSet (dhToLST 2.507612, DD 120.857651) (dhToLST 10.997344, DD 239.142349))+ (riseAndSet ecSirius verticalShift (DD 57))+ , testRiseAndSet "Sirius, SH"+ 0.000001+ (RiseSet (dhToLST 23.390844, DD 116.158877) (dhToLST 14.114111, DD 243.841123))+ (riseAndSet ecSirius verticalShift (DD $ -48))+ ]+ ]+++ecPolaris = starCoordinates Polaris+ecAlphaCrucis = starCoordinates AlphaCrucis+ecSirius = starCoordinates Sirius++verticalShift = (fromDMS 0 34 0)++testRiseAndSet msg eps expected actual =+ testCase msg $ assertRiseAndSet eps expected actual++assertRiseAndSet eps expected@(RiseSet (etr, DD ear) (ets, DD eas)) actual@(RiseSet (atr, DD aar) (ats, DD aas)) =+ unless (eqLST eps etr atr && abs(ear-aar) <= eps+ && eqLST eps ets ats && abs(eas-aas) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"+assertRiseAndSet _ Circumpolar Circumpolar = assertString ""+assertRiseAndSet _ Circumpolar actual = assertString msg+ where msg = "expected: Circumpolar\n but got: " ++ show actual+assertRiseAndSet _ NeverRises NeverRises = assertString ""+assertRiseAndSet _ NeverRises actual = assertString msg+ where msg = "expected: NeverRises\n but got: " ++ show actual++eqLST eps lst1 lst2 =+ let DH dh1 = lstToDH lst1+ DH dh2 = lstToDH lst2+ in abs (dh1 - dh2) < eps
+ test/Data/Astro/CelestialObjectTest.hs view
@@ -0,0 +1,32 @@+module Data.Astro.CelestialObjectTest+(+ tests+)++where++ +import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Astro.TypesTest (testDecimalDegrees)++import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..))+import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..))+import Data.Astro.CelestialObject++tests = [testGroup "angle" [+ testDecimalDegrees "Equatorial: Orionis and Canis Majoris"+ 0.000000001+ (DD 23.673849422164192)+ (angleEquatorial (EC1 (DD (-8.225)) (DH 5.225472222222222)) (EC1 (DD (-16.68638888888889)) (DH 6.737055555555555)))+ , testDecimalDegrees "Ecliptic: Orionis and Canis Majoris"+ 0.000000001+ (DD 23.673849422164192)+ (angleEcliptic (EcC (DD (-31.12290508933333)) (DD 76.53651836408739)) (EcC (DD (-39.597832824969665)) (DD 103.79168740150627)))+ ]+ ]
+ test/Data/Astro/CoordinateTest.hs view
@@ -0,0 +1,180 @@+module Data.Astro.CoordinateTest+(+ tests+ , testEC1+ , testEcC+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Control.Monad (unless)++import Data.Astro.TypesTest (testDecimalDegrees, testDecimalHours)+import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..)+ , fromYMDHMS, lctFromYMDHMS)+import Data.Astro.Coordinate+import Data.Astro.Types+import Data.Astro.Utils (reduceToZeroRange)++ro :: GeographicCoordinates+ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))++dt :: LocalCivilTime+dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0++jd :: JulianDate+jd = lctUniversalTime dt++sunHC :: HorizonCoordinates+sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53)++sunEC1 :: EquatorialCoordinates1+sunEC1 = EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224}+++tests = [testGroup "RA <-> HA" [+ testDecimalHours "RA 18.53 in 1980-04-22 18:36:51.67 to HA"+ 0.0000001+ (DH 9.873237)+ (raToHA (DH 18.539167) (DD (-64.0)) $ fromYMDHMS 1980 4 22 18 36 51.67)+ , testDecimalHours "HA 9.87 in 1980-04-22 18:36:51.67 to RA"+ 0.0000001+ (DH 9.873237)+ (raToHA (DH 18.539167) (DD (-64.0)) $ fromYMDHMS 1980 4 22 18 36 51.67)+ , testProperty "RA <-> HA property for Novosibirsk" $ prop_HARAConv (DD 83) (JD 2457607.97281)+ , testProperty "RA <-> HA property for Rio de Janeiro" $ prop_HARAConv (DD (-43)) (JD 2457607.97281)+ ]+ , testGroup "EC2 <-> HC" [+ testHC "EC2 23.219 5.862 -> HC 19.334 283.271"+ 0.00000001+ (HC (DD 19.334345224) (DD 283.27102726))+ (equatorialToHorizon (DD 52) (EC2 (DD 23.219444444) (DH 5.862222222222222)))+ , testEC2 "HC 19.334 283.271 -> EC2 23.219 5.862"+ 0.00000001+ (EC2 (DD 23.219444444) (DH 5.862222222222222))+ (horizonToEquatorial (DD 52) (HC (DD 19.334345224) (DD 283.27102726)))+ , testProperty "property" prop_EC2HCConv+ ]+ , testGroup "EC1 <-> HC" [+ testHC "sunEC1 -> sunHC" 0.00000001 sunHC (ec1ToHC ro jd sunEC1)+ , testEC1 "sunHC -> sunEC1" 0.00000001 sunEC1 (hcToEC1 ro jd sunHC)+ ]+ , testGroup "obliquity" [+ testDecimalDegrees "2009-07-06"+ 0.000001+ (DD 23.43925285)+ (obliquity $ JD 2455018.5)+ , testDecimalDegrees "2016-08-12"+ 0.000001+ (DD 23.434706359)+ (obliquity $ JD 2457612.5)+ ]+ , testGroup "Ecliptic <-> Equatorial" [+ testEC1 "EcC 4.875 139.6861 on 2009-07-06 to EC1"+ 0.000001+ (EC1 (DD 19.535712) (DH 9.581501))+ (eclipticToEquatorial (EcC (DD 4.875277777777778) (DD 139.6861111111111)) (JD 2455018.5))+ , testEcC "EC1 19.535 9.581 to EcC on 2009-07-06"+ 0.000001+ (EcC (DD 4.875278) (DD 139.686111))+ (equatorialToEcliptic (EC1 (DD 19.535712) (DH 9.581501)) (JD 2455018.5))+ , testProperty "property" prop_EC1EcCConv+ ]+ , testGroup "Galactic <-> Equatorial" [+ testGC "EC 10.053 10.35 -> GC"+ 0.000001+ (GC (DD 51.12226779935766) (DD 232.24788348766026))+ (equatorialToGalactic (EC1 (DD 10.053055555555556) (DH 10.35)))+ , testEC1 "GC 51.122 232.247 -> EC"+ 0.000001+ (EC1 (DD 10.053055555555556) (DH 10.35))+ (galacticToEquatorial (GC (DD 51.12226779935766) (DD 232.24788348766026)))+ , testProperty "property" prop_EC1GCConv+ ]+ ]++++prop_HARAConv longitude ut dh =+ let dh' = reduceToZeroRange 24 dh+ DH ra = haToRA (raToHA (DH dh') longitude ut) longitude ut+ DH ha = raToHA (haToRA (DH dh') longitude ut) longitude ut+ eps = 0.00000001+ in abs (ra - dh') < eps && (ha - dh') < eps+ where types = (dh::Double)++testHC msg eps expected actual =+ testCase msg $ assertHC eps expected actual++assertHC eps expected@(HC (DD eAlt) (DD eAz)) actual@(HC (DD aAlt) (DD aAz)) =+ unless (abs(eAlt-aAlt) <= eps && abs(eAz-aAz) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++testEC2 msg eps expected actual =+ testCase msg $ assertEC2 eps expected actual++assertEC2 eps expected@(EC2 (DD eDec) (DH eHa)) actual@(EC2 (DD aDec) (DH aHa)) =+ unless (abs(eDec-aDec) <= eps && abs(eHa-aHa) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++prop_EC2HCConv (latitude, up, round) =+ let latitude' = DD $ reduceToZeroRange 180 latitude+ up' = (reduceToZeroRange 89.9 up) + 0.1+ round' = (reduceToZeroRange 359.9 round) + 0.1+ HC (DD up'') (DD round'') = equatorialToHorizon latitude' $ horizonToEquatorial latitude' (HC (DD up') (DD round'))+ eps = 0.00001+ in abs(up'-up'') < eps && abs(round'-round'') < eps+ where types = ((latitude, up, round)::(Double, Double, Double))+++testEC1 msg eps expected actual =+ testCase msg $ assertEC1 eps expected actual++assertEC1 eps expected@(EC1 (DD e1) (DH e2)) actual@(EC1 (DD a1) (DH a2)) =+ unless (abs(e1-a1) <= eps && abs(e2-a2) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"+++testEcC msg eps expected actual =+ testCase msg $ assertEcC eps expected actual++assertEcC eps expected@(EcC (DD eLat) (DD eLon)) actual@(EcC (DD aLat) (DD aLon)) =+ unless (abs(eLat-aLat) <= eps && abs(eLon-aLon) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++prop_EC1EcCConv (jd, up, round) =+ let jd' = JD $ (reduceToZeroRange 10000 jd) + 2455018.5+ up' = (reduceToZeroRange 90 up)+ round' = (reduceToZeroRange 359 round)+ EcC (DD up'') (DD round'') = equatorialToEcliptic (eclipticToEquatorial (EcC (DD up') (DD round')) jd') jd'+ eps = 0.000001+ in abs(up'-up'') < eps && abs(round'-round'') < eps+ where types = ((jd, up, round)::(Double, Double, Double))+++testGC msg eps expected actual =+ testCase msg $ assertGC eps expected actual++assertGC eps expected@(GC (DD eLat) (DD eLon)) actual@(GC (DD aLat) (DD aLon)) =+ unless (abs(eLat-aLat) <= eps && abs(eLon-aLon) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++prop_EC1GCConv (up, round) =+ let up' = (reduceToZeroRange 90 up)+ round' = (reduceToZeroRange 359 round)+ GC (DD up'') (DD round'') = equatorialToGalactic $ galacticToEquatorial (GC (DD up') (DD round'))+ eps = 0.000001+ in abs(up'-up'') < eps && abs(round'-round'') < eps+ where types = ((up, round)::(Double, Double))
+ test/Data/Astro/Effects/ParallaxTest.hs view
@@ -0,0 +1,47 @@+module Data.Astro.Effects.ParallaxTest+(+ tests+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.HUnit+import Test.HUnit.Approx++import Control.Monad (unless)++import Data.Astro.CoordinateTest (testEC1)++import Data.Astro.Types (GeographicCoordinates(..), fromDMS, fromHMS)+import Data.Astro.Time.JulianDate (JulianDate(..))+import Data.Astro.Coordinate (EquatorialCoordinates1(..))+import Data.Astro.Effects.Parallax++tests = [testGroup "parallaxQuantities" [+ testPairOfDoubles "DD 50, 60 metres"+ 0.000001+ (0.762422, 0.644060)+ (parallaxQuantities 50 60)+ , testPairOfDoubles "DD -70, 10 metres"+ 0.000001+ (-0.936174, 0.3430361)+ (parallaxQuantities (-70) 10)+ ]+ , testGroup "parallax" [+ testEC1 "the Sun"+ 0.0000001+ (EC1 (-(fromDMS 8 44 31.4303)) (fromHMS 22 36 44.2044))+ (parallax (GeoC 50 (-100)) 60 0.9901 (JD 2443931.1979166665) (EC1 (-(fromDMS 8 44 24)) (fromHMS 22 36 44)))+ ]+ ]+++testPairOfDoubles msg eps expected actual =+ testCase msg $ assertPairOfDoubles eps expected actual++assertPairOfDoubles eps expected@(e1, e2) actual@(a1, a2) =+ unless (abs(e1-a1) <= eps && abs(e2-a2) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"
+ test/Data/Astro/EffectsTest.hs view
@@ -0,0 +1,86 @@+module Data.Astro.EffectsTest+(+ tests+)++where+++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.QuickCheck++import Control.Monad (unless)++import Data.Astro.TypesTest (testDecimalDegrees)+import Data.Astro.CoordinateTest (testEC1, testEcC)++import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..), fromDMS, fromHMS)+import Data.Astro.Time.JulianDate (JulianDate(..))+import Data.Astro.Time.Epoch (b1950)+import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..))+import Data.Astro.Effects++tests = [testGroup "refraction" [+ testDecimalDegrees "19.33"+ 0.000001+ (DD 0.045403)+ (refract (DD 19.334345) 13 1008)+ , testDecimalDegrees "horizon"+ 0.000001+ (DD 0.566569)+ (refract (DD 0) 12 1013)+ , testDecimalDegrees "azimuth"+ 0.000001+ (DD 0)+ (refract (DD 90) 12 1012)+ , testDecimalDegrees "azimuth"+ 0.000001+ (DD 0.007905)+ (refract (DD 63.5) 15.5 1012)+ ]+ , testGroup "precession" [+ testEC1 "low-precision method"+ 0.0000001+ (EC1 (fromDMS 14 16 7.8329) (fromHMS 9 12 20.4707))+ (precession1 B1950 (EC1 (fromDMS 14 23 25) (fromHMS 9 10 43)) (JD 2444057.2985))+ , testEC1 "rigorous method"+ 0.0000001+ (EC1 (fromDMS 14 16 6.3489) (fromHMS 9 12 20.4458))+ (precession2 b1950 (EC1 (fromDMS 14 23 25) (fromHMS 9 10 43)) (JD 2444057.2985))+ ]+ , testGroup "nutation" [+ testDecimalDegrees "Longitude at 1988-09-01 00:00:00"+ 0.0000000001+ (DD 0.0015258101)+ (nutationLongitude (JD 2447405.5))+ , testDecimalDegrees "Obliquity at 1988-09-01 00:00:00"+ 0.0000000001+ (DD 0.0025670999)+ (nutationObliquity (JD 2447405.5))+ , testDecimalDegrees "Longitude at 2016-08-12 00:00:00"+ 0.0000000001+ (DD (-0.0009839730))+ (nutationLongitude (JD 2457612.5))+ , testDecimalDegrees "Obliquity at 2016-08-12 00:00:00"+ 0.0000000001+ (DD (-0.0024250649))+ (nutationObliquity (JD 2457612.5))+ ]+ , testGroup "aberration" [+ testEcC "Mars at 1988-09-08"+ 0.00000001+ (EcC (-(fromDMS 1 32 56.3319)) (fromDMS 352 37 30.4521))+ (includeAberration (EcC (-(fromDMS 1 32 56.4)) (fromDMS 352 37 10.1)) (JD 2447412.5) (fromDMS 165 33 44.1))+ ]+ ]++testPairOfDD msg eps expected actual =+ testCase msg $ assertPairOfDD eps expected actual++assertPairOfDD eps expected@((DD e1), (DD e2)) actual@((DD a1), (DD a2)) =+ unless (abs(e1-a1) <= eps && abs(e2-a2) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"
+ test/Data/Astro/MoonTest.hs view
@@ -0,0 +1,74 @@+module Data.Astro.MoonTest+(+ tests+)++where+++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Astro.TypesTest (testDecimalDegrees)+import Data.Astro.CoordinateTest (testEC1)++import Data.Astro.Time.JulianDate (fromYMD)+import Data.Astro.Coordinate (EquatorialCoordinates1(..))+import Data.Astro.Moon.MoonDetails (MoonDetails(..), j2010MoonDetails, MoonDistanceUnits(..))+import Data.Astro.Moon++tests = [testGroup "moonPosition1"[+ testEC1 "at 2003-09-01 00:00:00 UT"+ 0.000001+ (EC1 (-11.525750) 14.211486)+ (moonPosition1 j2010MoonDetails (fromYMD 2003 9 1))+ ]+ , testGroup "moonDistance" [+ testMDU "at 2016-08-27 00:00:00"+ 0.000001+ (MDU 0.953425)+ (moonDistance1 j2010MoonDetails (fromYMD 2016 8 26))+ ]+ , testGroup "moonAngularSize" [+ testDecimalDegrees "at 0.953425 MDU"+ 0.000001+ 0.543409+ (moonAngularSize (MDU 0.953425))+ , testDecimalDegrees "at 1 MDU"+ 0.000001+ (mdBigTheta j2010MoonDetails)+ (moonAngularSize (MDU 1))+ ]+ , testGroup "moonHorizontalParallax" [+ testDecimalDegrees "at 0.953425 MDU"+ 0.000001+ 0.997142+ (moonHorizontalParallax (MDU 0.953425))+ , testDecimalDegrees "at 1 MDU"+ 0.000001+ (mdPi j2010MoonDetails)+ (moonHorizontalParallax (MDU 1))+ ]+ , testGroup "moonPhase" [+ testCase "at 2016-08-01 00:00:00" $ assertApproxEqual ""+ 0.000001+ 0.042498+ (moonPhase j2010MoonDetails (fromYMD 2016 8 1))+ , testCase "at 2016-08-21 00:00:00" $ assertApproxEqual ""+ 0.000001+ 0.911818+ (moonPhase j2010MoonDetails (fromYMD 2016 8 21))+ ]+ , testGroup "moonBrightLimbPositionAngle" [+ testDecimalDegrees "at 2016-08-28 00:00:00"+ 0.000001+ 82.479138+ (moonBrightLimbPositionAngle (EC1 17.386905 4.897826) (EC1 10.329324 10.342354))+ ]+ ]++testMDU msg eps (MDU e) (MDU a) = testCase msg $ assertApproxEqual "" eps e a
+ test/Data/Astro/Planet/PlanetDetailsTest.hs view
@@ -0,0 +1,25 @@+module Data.Astro.Planet.PlanetDetailsTest+(+ tests+)++where+++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Astro.Planet.PlanetDetails++tests = [testGroup "inner planets" [+ testCase "Mercury" $ isInnerPlanet (j2010PlanetDetails Mercury) @?= True+ , testCase "Venus" $ isInnerPlanet (j2010PlanetDetails Venus) @?= True+ , testCase "Jupiter" $ isInnerPlanet (j2010PlanetDetails Jupiter) @?= False+ , testCase "Uranus" $ isInnerPlanet (j2010PlanetDetails Uranus) @?= False+ , testCase "Earth" $ isInnerPlanet (j2010PlanetDetails Earth) @?= False+ ]+ ]
+ test/Data/Astro/Planet/PlanetMechanicsTest.hs view
@@ -0,0 +1,131 @@+module Data.Astro.Planet.PlanetMechanicsTest+(+ tests+)++where+++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck+++import Data.Astro.TypesTest (testDecimalDegrees)+import Data.Astro.CoordinateTest (testEC1)++import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..), fromDMS)+import Data.Astro.Time.JulianDate (JulianDate(..))+import Data.Astro.Time.Epoch (j2010)+import Data.Astro.Coordinate (EquatorialCoordinates1(..))+import Data.Astro.Planet.PlanetDetails (Planet(..), j2010PlanetDetails)+import Data.Astro.Planet.PlanetMechanics++nov222003 = JD 2452965.5+jupiterDetails = j2010PlanetDetails Jupiter+earthDetails = j2010PlanetDetails Earth+mercuryDetails = j2010PlanetDetails Mercury+sunPositionOnNov222003 = EC1 {e1Declination = DD (-19.99330355916915), e1RightAscension = DH 15.803416251173122}++tests = [testGroup "mechanics" [+ testDecimalDegrees "jupiter mean anomaly"+ 0.0000001+ 137.8097641+ (planetMeanAnomaly jupiterDetails nov222003)+ , testDecimalDegrees "jupiter true anomaly"+ 0.0000001+ 141.5736000+ (planetTrueAnomaly1 jupiterDetails nov222003)+ , testDecimalDegrees "planetHeliocentricLongitude"+ 0.0000001+ 114.6633+ (planetHeliocentricLongitude jupiterDetails 100)+ , testDecimalDegrees "planetHeliocentricLatitude"+ 0.0000001+ 1.1220101+ (planetHeliocentricLatitude jupiterDetails 160)+ , testCase "planetHeliocentricRadiusVector" $ assertApproxEqual ""+ 0.0000001+ 5.4403612+ (planetHeliocentricRadiusVector jupiterDetails 160)+ , testDecimalDegrees "planetProjectedLongitude"+ 0.0000001+ 159.9935029+ (planetProjectedLongitude jupiterDetails 160)+ , testCase "planetProjectedRadiusVector" $ assertApproxEqual ""+ 0.0000001+ 5.4387668+ (planetProjectedRadiusVector jupiterDetails 1.22 5.44)+ , testDecimalDegrees "planetEclipticLongitude: Jupiter"+ 0.0000001+ 169.793671+ (planetEclipticLongitude jupiterDetails 160 5.43 59 0.988)+ , testDecimalDegrees "planetEclipticLongitude: Mercury"+ 0.000001+ 253.929762+ (planetEclipticLongitude mercuryDetails 287.824406 0.448159 59.274748 0.987847)+ , testDecimalDegrees "planetEclipticLatitude: Jupiter"+ 0.0000001+ 1.1861236+ (planetEclipticLatitude 1.22 160 5.43 59 0.988 170)+ , testDecimalDegrees "planetEclipticLatitude: Mercury"+ 0.000001+ (-2.044058)+ (planetEclipticLatitude (-6.035842) 287.824406 0.448159 59.274748 0.987847 253.929762)+ , testEC1 "planetPosition1: Jupiter"+ 0.0000001+ (EC1 (DD 6.3569686) (DH 11.1871664))+ (planetPosition1 jupiterDetails earthDetails nov222003)+ , testEC1 "planetPosition1: Mercury"+ 0.0000001+ (EC1 (DD (-24.5023748)) (DH 16.8200600))+ (planetPosition1 mercuryDetails earthDetails nov222003)+ , testEC1 "planetPosition"+ 0.0000001+ (planetPosition1 jupiterDetails earthDetails nov222003)+ (planetPosition planetTrueAnomaly1 jupiterDetails earthDetails nov222003)+ , testDecimalDegrees "pertubations: Jupiter"+ 0.0000001+ 0.0371214+ (planetPertubations Jupiter nov222003)+ , testDecimalDegrees "pertubations: Saturn"+ 0.0000001+ 0.1317895 -- not sure if this is the right result+ (planetPertubations Saturn nov222003)+ , testDecimalDegrees "pertubations: Mars"+ 0.0000001+ 0+ (planetPertubations Mars nov222003)+ , testCase "planetDistance1" $ assertApproxEqual ""+ 0.0000001+ 5.6033062+ (planetDistance1 jupiterDetails earthDetails nov222003)+ , testDecimalDegrees "planetAngularDiameter"+ 0.0000001+ (fromDMS 0 0 35.1114)+ (planetAngularDiameter jupiterDetails 5.6033062)+ ]+ , testGroup "planetPhase" [+ testCase "Jupiter" $ assertApproxEqual ""+ 0.0000001+ 0.9922919+ (planetPhase1 jupiterDetails earthDetails nov222003)+ , testCase "Mercury" $ assertApproxEqual ""+ 0.0000001+ 0.9141158+ (planetPhase1 mercuryDetails earthDetails nov222003)+ ]+ , testGroup "planetBrightLimbPositionAngle" [+ testDecimalDegrees "Jupiter"+ 0.0000001+ 113.2029600+ (planetBrightLimbPositionAngle (EC1 (DD 6.3569686) (DH 11.1871664)) sunPositionOnNov222003)+ , testDecimalDegrees "Mercury"+ 0.0000001+ 284.7106531+ (planetBrightLimbPositionAngle (EC1 (-24.502375) 16.820060) sunPositionOnNov222003)+ ]+ ]
+ test/Data/Astro/Sun/SunInternalsTest.hs view
@@ -0,0 +1,35 @@+module Data.Astro.Sun.SunInternalsTest+(+ tests+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Astro.Utils (reduceToZeroRange)+import Data.Astro.Sun.SunInternals++tests = [testGroup "solveKeplerEquation" [+ testCase "a" $ assertApproxEqual ""+ 1e-7+ 3.5220041+ (solveKeplerEquation 0.016714 3.528210 1e-7)+ , testProperty "property" prop_solveKeplerEquation+ ]+ ]++prop_solveKeplerEquation (e, m) =+ let eps = 1e-7+ (_, e') = properFraction e+ e'' =( e' * 0.01) + 0.1+ m' = (reduceToZeroRange 17 e) - 7+ x = solveKeplerEquation e'' m' eps+ dx = x - e''*(sin x) - m'+ in abs dx < eps+ where types = ((e,m)::(Double, Double))
+ test/Data/Astro/SunTest.hs view
@@ -0,0 +1,181 @@+module Data.Astro.SunTest+(+ tests+)++where+++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Control.Monad (unless)++import Data.Astro.TypesTest (testDecimalDegrees, testDecimalHours)+import Data.Astro.CoordinateTest (testEC1)+++import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..), GeographicCoordinates(..), fromDMS, fromHMS)+import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), lctFromYMDHMS, LocalCivilDate(..), lcdFromYMD)+import Data.Astro.Time.Epoch (j2010)+import Data.Astro.Coordinate (EquatorialCoordinates1(..))+import Data.Astro.Sun++tests = [testGroup "sunDetails" [+ testSunDetails "J2010.0"+ 0.000001+ (SunDetails j2010 (DD 279.557208) (DD 283.112438) 0.016705)+ (sunDetails j2010)+ ]+ , testGroup "the Sun's coordinates" [+ -- The Astronomycal Almanach gives (EC1 (fromDMS 19 21 16) (fromHMS 8 23 33))+ testEC1 "(1) at 2003-07-27 00:00:00"+ 0.000001+ (EC1 (fromDMS 19 21 17.4394) (fromHMS 8 23 32.8286))+ (sunPosition1 j2010SunDetails (JD 2452847.5))+ , testEC1 "(1) at 2016-08-11 13:30:00"+ 0.000001+ (EC1 (fromDMS 15 2 5.1480) (fromHMS 9 26 49.9629))+ (sunPosition1 j2010SunDetails (JD 2457612.0625))+ -- The Astronomycal Almanach gives (EC1 (fromDMS 19 12 52) (fromHMS 8 26 3))+ , testEC1 "(1) at 1988-07-27 00:00:00"+ 0.000001+ (EC1 (fromDMS 19 12 50.6369) (fromHMS 8 26 3.6147))+ (sunPosition1 j2010SunDetails (JD 2447369.5))+ -- The Astronomycal Almanach gives (EC1 (fromDMS 19 12 52) (fromHMS 8 26 3))+ , testEC1 "(2) at 1988-07-27 00:00:00"+ 0.000001+ (EC1 (fromDMS 19 12 48.9604) (fromHMS 8 26 4.1004))+ (sunPosition2 (JD 2447369.5))+ -- The Astronomycal Almanach gives (EC1 (fromDMS 19 21 16) (fromHMS 8 23 33))+ , testEC1 "(2) at 2003-07-27 00:00:00"+ 0.000001+ (EC1 (fromDMS 19 21 9.2633) (fromHMS 8 23 35.2376))+ (sunPosition2 (JD 2452847.5))+ ]+ , testGroup "distance" [+ testCase "at 1988-07-27 00:00:00" $ assertApproxEqual ""+ 1+ 151920130+ (sunDistance (JD 2447369.5))+ , testCase "at 2016-08-12 13:30:00" $ assertApproxEqual ""+ 1+ 151577454+ (sunDistance (JD 2457613.0625))+ , testCase "at 2010-10-10 18:00:00" $ assertApproxEqual ""+ 1+ 149373939+ (sunDistance (JD 2455480.25))+ ]+ , testGroup "angular size" [+ testDecimalDegrees "at 1988-07-27 00:00:00"+ 0.000001+ (fromDMS 0 31 29.9308)+ (sunAngularSize (JD 2447369.5))+ , testDecimalDegrees "at 2016-08-12 13:30:00"+ 0.000001+ (fromDMS 0 31 34.2034)+ (sunAngularSize (JD 2457613.0625))+ , testDecimalDegrees "at 2010-10-10 18:00:00"+ 0.000001+ (fromDMS 0 32 2.1461)+ (sunAngularSize (JD 2455480.25))+ ]+ , testGroup "Sun's rise and set" [+ -- sunrise/set times are from http://timeanddate.com+ -- coordinates are from http://dateandtime.info+ testRiseSet "Venice at 2016-08-12; Rise: 06:08, DD 68; Set: 20:22, DD 292"+ 0.000001+ (RiseSet+ (Just (lctFromYMDHMS 2 2016 8 12 6 8 1.2955, DD 67.6609383))+ (Just (lctFromYMDHMS 2 2016 8 12 20 22 17.5593, DD 292.0714064)))+ (sunRiseAndSet (GeoC (DD 45.43713) (12.33265)) 0.833333 (lcdFromYMD 2 2016 8 12))+ , testRiseSet "Ulaanbaatar at 2016-08-13; Rise: 06:45, DD 67; Set: 21:09, DD 293"+ 0.000001+ (RiseSet+ (Just (lctFromYMDHMS 9 2016 8 13 6 44 43.1358, DD 66.8644763))+ (Just (lctFromYMDHMS 9 2016 8 13 21 8 49.7896, DD 292.8475000)))+ (sunRiseAndSet (GeoC (DD 47.90771) (106.88324)) 0.833333 (lcdFromYMD 9 2016 8 13))+ , testRiseSet "Lima at 2016-08-12; Rise: 06:22, DD 75; Set: 18:04, DD 285"+ 0.000001+ (RiseSet+ (Just (lctFromYMDHMS (-5) 2016 8 12 6 22 22.2308, DD 75.0822853))+ (Just (lctFromYMDHMS (-5) 2016 8 12 18 3 41.7631, DD 284.7661756)))+ (sunRiseAndSet (GeoC (DD $ -12.04318) (DD $ -77.02824)) 0.833333 (lcdFromYMD (-5) 2016 8 12))+ , testRiseSet "Longyearbyen at 2016-08-12; Circumpolar"+ 0.000001+ Circumpolar+ (sunRiseAndSet (GeoC (DD 78.22) (DD 15.65)) 0.833333 (lcdFromYMD 2 2016 8 12))+ , testRiseSet "Longyearbyen at 2017-01-12; Down all day"+ 0.000001+ NeverRises+ (sunRiseAndSet (GeoC (DD 78.22) (DD 15.65)) 0.833333 (lcdFromYMD 2 2017 1 12))+ , testRiseSet "Anchorage at 2016-08-13; Rise: 06:05, DD 57; Set: 22:02, DD 302"+ 0.000001+ (RiseSet+ (Just (lctFromYMDHMS (-8) 2016 8 13 6 4 29.3945, DD 57.0595036))+ (Just (lctFromYMDHMS (-8) 2016 8 13 22 2 8.3067, DD 302.4495529)))+ (sunRiseAndSet (GeoC (DD 61.21806) (-149.90028)) 0.833333 (lcdFromYMD (-8) 2016 8 13))+ , testRiseSet "Kazan at 2016-08-18; Rise: 04:21, DD 65; Set: 19:12, DD 295"+ 0.000001+ (RiseSet+ (Just (lctFromYMDHMS 3 2016 8 18 4 21 19.3153, DD 65.0507218))+ (Just (lctFromYMDHMS 3 2016 8 18 19 11 46.7175,DD 294.5658995)))+ (sunRiseAndSet (GeoC 55.78874 49.1221400) 0.833333 $ lcdFromYMD 3 2016 8 18)+ ],+ testGroup "equationOfTime" [+ testDecimalHours "zero at June"+ (1/3600)+ (-(fromHMS 0 0 1))+ (equationOfTime $ JD 2457551.5)+ , testDecimalHours "minimum at February"+ (1/3600)+ (-(fromHMS 0 14 7))+ (equationOfTime $ JD 2457429.5)+ , testDecimalHours "maximum at November"+ (1/3600)+ (fromHMS 0 16 18)+ (equationOfTime $ JD 2457694.5)+ ]+ , testGroup "solarElongation" [+ testDecimalDegrees "Mars at 2010-07-27 20:00:00 UT"+ 0.0000001+ (DD 24.7905087)+ (solarElongation (EC1 (fromDMS 11 57 27) (fromHMS 10 6 45)) (JD 2455405.3333333335))+ ]+ ]++testSunDetails msg eps expected actual =+ testCase msg $ assertSunDetails eps expected actual++assertSunDetails eps expected@(SunDetails (JD eJd) (DD eEps) (DD eOm) eE) actual@(SunDetails (JD aJd) (DD aEps) (DD aOm) aE) =+ unless (abs(eJd-aJd) <= eps && abs(eEps-aEps) <= eps+ && abs(eOm-aOm) <= eps && abs(eE-aE) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++testRiseSet msg eps expected actual =+ testCase msg $ assertRiseSet eps expected actual++assertRiseSet eps expected@(RiseSet er es) actual@(RiseSet ar as) =+ unless (eqMaybeRS eps er ar && eqMaybeRS eps es as) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++assertRiseSet _ Circumpolar Circumpolar = assertString ""+assertRiseSet _ Circumpolar actual = assertString msg+ where msg = "expected: Circumpolar\n but got: " ++ show actual+assertRiseSet _ NeverRises NeverRises = assertString ""+assertRiseSet _ NeverRises actual = assertString msg+ where msg = "expected: NeverRises\n but got: " ++ show actual+++eqMaybeRS eps (Just rs1) (Just rs2) = eqRS eps rs1 rs2+eqMaybeRS _ Nothing Nothing = True+eqMaybeRS _ _ _ = False++eqRS eps (LCT (DH tz1) (JD j1), DD d1) (LCT (DH tz2) (JD j2), DD d2) = abs (j1-j2) < eps && abs (tz1-tz2) < eps && abs (d1-d2) < eps
+ test/Data/Astro/Time/ConvTest.hs view
@@ -0,0 +1,50 @@+module Data.Astro.Time.ConvTest+(+ tests+)++where++import Data.Astro.Types+import Data.Time.LocalTime+import Data.Astro.Time.Conv+import Data.Astro.Time.JulianDate+import Data.Astro.Time.JulianDateTest (testJD)++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck+++tests = [ testGroup "LCT conversion properties" [+ testProperty "TZ: -5" $ prop_LCTConversion 4+ , testProperty "TZ: 0" $ prop_LCTConversion 0+ , testProperty "TZ: 3" $ prop_LCTConversion 3+ ]+ , testGroup "LCD Conversion properties" [+ testProperty "TZ: -5" $ prop_LCDConversion 4+ , testProperty "TZ: 0" $ prop_LCDConversion 0+ , testProperty "TZ: 3" $ prop_LCDConversion 3+ ]+ ]++prop_LCTConversion tz = forAll (choose (0, 999999999)) check+ where check n = + let jd = LCT (DH tz) (JD n)+ jd2 = zonedTimeToLCT $ lctToZonedTime jd+ LCT _ (JD n2) = jd2+ in abs(n - n2) < 0.00000001+++prop_LCDConversion tz = forAll (choose (0, 999999999)) check+ where check n = + let (jd, _) = splitToDayAndTime (JD n) -- drop time part+ lct = LCT (DH tz) jd+ lcd2 = zonedTimeToLCD $ lctToZonedTime lct+ LCD _ (JD n2) = lcd2+ JD n1 = jd+ in abs(n1 - n2) < 0.00000001+
+ test/Data/Astro/Time/GregorianCalendarTest.hs view
@@ -0,0 +1,57 @@+module Data.Astro.Time.GregorianCalendarTest+(+ tests+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.QuickCheck++import Data.Time.Calendar (fromGregorian, toGregorian)++import Data.Astro.Time.GregorianCalendar+++tests = [testGroup "easter day" [+ testCase "2009" easterDay2009+ , testCase "2016" easterDay2016+ , testCase "2027" easterDay2027+ , testProperty "easter properties" prop_Easter+ ]+ , testGroup "leap year" [+ testCase "2016" (isLeapYear 2016 @?= True)+ , testCase "2000" (isLeapYear 2000 @?= True)+ , testCase "2015" (isLeapYear 2015 @?= False)+ , testCase "1900" (isLeapYear 1900 @?= False)+ , testCase "1800" (isLeapYear 1800 @?= False)+ ]+ , testGroup "day number" [+ testCase "1 Jan of leap year" (dayNumber (fromGregorian 2016 1 1) @?= 1)+ , testCase "11 Feb of leap year" (dayNumber (fromGregorian 2016 2 11) @?= 42)+ , testCase "10 Mar of leap year" (dayNumber (fromGregorian 2016 3 10) @?= 70)+ , testCase "15 Nov of leap year" (dayNumber (fromGregorian 2016 11 15) @?= 320)+ , testCase "31 Dec of leap year" (dayNumber (fromGregorian 2016 12 31) @?= 366)+ , testCase "1 Jan of non-leap year" (dayNumber (fromGregorian 2015 1 1) @?= 1)+ , testCase "11 Feb of non-leap year" (dayNumber (fromGregorian 2015 2 11) @?= 42)+ , testCase "10 Mar of non-leap year" (dayNumber (fromGregorian 2015 3 10) @?= 69)+ , testCase "15 Nov of non-leap year" (dayNumber (fromGregorian 2015 11 15) @?= 319)+ , testCase "31 Dec of non-leap year" (dayNumber (fromGregorian 2015 12 31) @?= 365)+ ]+ ]+++easterDay2009 = easterDayInYear 2009 @?= fromGregorian 2009 4 12+easterDay2016 = easterDayInYear 2016 @?= fromGregorian 2016 3 27+easterDay2027 = easterDayInYear 2027 @?= fromGregorian 2027 3 28++prop_Easter =+ forAll (choose (1583, 999900)) $ checkEasterProperties++checkEasterProperties year = let date = easterDayInYear year+ (y, m, _) = toGregorian date+ in fromIntegral y == year && (m == 3 || m == 4)+
+ test/Data/Astro/Time/JulianDateTest.hs view
@@ -0,0 +1,161 @@+module Data.Astro.Time.JulianDateTest+(+ tests+ , testJD+ , testLCT+)++where+++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Control.Monad (unless)++import Data.Astro.Types (DecimalHours(..))+import Data.Astro.Time.Epoch (b1950, j2000)+import Data.Astro.Time.JulianDate++tests = [testGroup "to julian day" [+ testCase "19 Jun 2009 18:00" $ fromYMDHMS 2009 6 19 18 0 0 @?= JD 2455002.25+ , testCase "1 Aug 2009 12:00" $ fromYMDHMS 2016 8 1 12 0 0 @?= JD 2457602+ , testCase "Gregorian start day" $ fromYMDHMS 1582 10 15 0 0 0 @?= JD 2299160.5+ , testCase "Gregorian before start" $ fromYMDHMS 1582 10 14 12 0 0 @?= JD 2299170+ , testCase "19 Jun 2009" $ fromYMD 2009 6 19 @?= JD 2455001.5+ , testCase "1 Aug 2009" $ fromYMD 2016 8 1 @?= JD 2457601.5+ ]+ , testGroup "from julian day" [+ testCase "19 Jun 2009 18:00" (toYMDHMS (JD 2455002.25) @?= (2009, 6, 19, 18, 0, 0))+ , testCase "1 Aug 2009 12:00" (toYMDHMS (JD 2457602) @?= (2016, 8, 1, 12, 0, 0))+ , testCase "Gregorian start day" (toYMDHMS (JD 2299160.5) @?= (1582, 10, 15, 0, 0, 0))+ , testCase "Gregorian before start" (toYMDHMS (JD 2299160) @?= (1582, 10, 4, 12, 0, 0))+ ]+ , testGroup "julian conversion properties" [+ testProperty "before George" prop_JulianConversionsBeforeGeorge+ , testProperty "after George" prop_JulianConversionsAfterGeorge+ ]+ , testGroup "day of the week" [+ testCase "friday at midnight" $ dayOfWeek (JD 2455001.5) @?= 5+ , testCase "friday before moon" $ dayOfWeek (JD 2455001.75) @?= 5+ , testCase "friday after moon" $ dayOfWeek (JD 2455002.25) @?= 5+ , testCase "thursday after moon" $ dayOfWeek (JD 2455001.3) @?= 4+ , testCase "sunday at midnight" $ dayOfWeek (JD 2455003.5) @?= 0+ ]+ , testGroup "spliToDayAndTime" [+ testCase "100000.5" $ splitToDayAndTime (JD 100000.5) @?= (JD 100000.5, JD 0)+ , testCase "100000.7" $ assertJDPair 0.00001 (JD 100000.5, JD 0.2) $ splitToDayAndTime (JD 100000.7)+ , testCase "100001.3" $ assertJDPair 0.00001 (JD 100000.5, JD 0.8) $ splitToDayAndTime (JD 100001.3)+ , testCase "2444352.108931"+ $ assertJDPair 0.00001 (JD 2444351.5, JD 0.608931)+ $ splitToDayAndTime (JD 2444352.108931)+ , testProperty "property" prop_splitToDayAndTime+ ]+ , testGroup "UT <-> LCT" [+ testLCT "2016-08-07 02:10:10 +4 LCT -> UT"+ 0.000000001+ (LCT 4 (JD 2457607.423726852))+ (lctFromYMDHMS 4 2016 8 7 2 10 10)+ ]+ , testGroup "numberOfCenturies" [+ testCase "J2000..2009-06-06" $ assertApproxEqual ""+ 0.000000001+ 0.095099247+ (numberOfCenturies j2000 $ JD 2455018.5)+ ]+ , testGroup "numberOfYears" [+ testCase "B1950..1979-07-02" $ assertApproxEqual ""+ 0.000000001+ 29.5+ (numberOfYears b1950 $ JD 2444057.2985)+ ]+ , testGroup "numberOfDays" [+ testCase "10 .. 15" $ assertApproxEqual ""+ 0.000000001+ 5+ (numberOfDays 10 15)+ ]+ , testGroup "add hours" [+ testJD "+ 12H"+ 0.000000001+ (JD 110.5)+ (addHours 12 110)+ , testJD "+ 0H"+ 0.000000001+ (JD 110)+ (addHours 0 110)+ , testJD "- 6H"+ 0.000000001+ (JD 109.75)+ (addHours (-6) 110)+ ]+ , testJD "julian start date" 0.000001 (JD 0) julianStartDateTime+ , testGroup "print" [+ testCase "show" $ "1999-09-19 19:29:59.0000 -2.0" @=? show (lctFromYMDHMS (-2) 1999 9 19 19 29 59)+ , testCase "printLtcHs" $ "lctFromYMDHMS (-2) 1999 9 19 19 29 59.0000" @=? printLctHs (lctFromYMDHMS (-2) 1999 9 19 19 29 59)+ ]+ , testCase "lctToYMDHMS" $ (1999, 9, 19, 12, 0, 0) @=? lctToYMDHMS (lctFromYMDHMS (-2) 1999 9 19 12 0 0)+ , testGroup "JD: Num instance" [+ testCase "+" $ (JD 17.5) @=? (JD 15.5) + (JD 2)+ , testCase "-" $ (JD 13.5) @=? (JD 15.5) - (JD 2)+ , testCase "*" $ (JD 31) @=? (JD 15.5) * (JD 2)+ , testCase "negate" $ (JD 15.5) @=? negate (JD $ -15.5)+ , testCase "abs" $ (JD 15.7) @=? abs (JD (-15.7))+ , testCase "signum > 0" $ (JD 1.0) @=? signum (JD 15.5)+ , testCase "signum = 0" $ (JD 0.0) @=? signum (JD 0.0)+ , testCase "signum < 0" $ (JD $ -1.0) @=? signum (JD $ -15.5)+ , testCase "fromInteger" $ (JD 17) @=? fromInteger 17+ ]+ ]++prop_JulianConversionsAfterGeorge =+ forAll (choose (2299161, 999999999)) $ checkJulianConverionProperties+++prop_JulianConversionsBeforeGeorge =+ forAll (choose (0, 2299161)) $ checkJulianConverionProperties+++checkJulianConverionProperties :: Double -> Bool+checkJulianConverionProperties n =+ let jd = JD n+ (y, m, d, hs, ms, ss) = toYMDHMS jd+ jd2 = fromYMDHMS y m d hs ms ss+ JD n2 = jd2+ in abs(n - n2) < 0.00000001++assertJDPair :: Double -> (JulianDate, JulianDate) -> (JulianDate, JulianDate) -> Assertion+assertJDPair eps e@(JD e1, JD e2) a@(JD a1, JD a2) = + unless (abs(a1-e1) <= eps && abs(a2-e2) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show e ++ "\n but got: " ++ show a +++ "\n (maximum margin of error: " ++ show eps ++ ")"++prop_splitToDayAndTime =+ forAll (choose (0, 999999999)) $ check+ where check jd =+ let (JD d, JD t) = splitToDayAndTime $ JD jd+ eps = 0.0000001+ in abs(jd-d-t) < eps && t >= 0 && t < 1++testJD msg eps expected actual =+ testCase msg $ assertJD eps expected actual++assertJD eps (JD expected) (JD actual) =+ unless (abs(expected-actual) <= eps) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++testLCT msg eps expected actual =+ testCase msg $ assertLCT eps expected actual+++assertLCT eps expected actual =+ unless (eqLCT eps expected actual) (assertFailure msg)+ where msg = "expected: " ++ show expected ++ "\nbut got: " ++ show actual +++ "\n (maximum margin of error: " ++ show eps ++ ")"++eqLCT eps (LCT (DH tze) (JD jde)) (LCT (DH tza) (JD jda)) = abs (jde-jda) < eps && abs(tze-tza) < eps
+ test/Data/Astro/Time/SiderealTest.hs view
@@ -0,0 +1,112 @@+module Data.Astro.Time.SiderealTest+(+ tests+ , testLST+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.QuickCheck++import Control.Monad (unless)++import Data.Astro.TypesTest (testDecimalHours)+import Data.Astro.Time.JulianDateTest (testJD)++import Data.Astro.Utils (reduceToZeroRange)+import Data.Astro.Types (DecimalHours(..), fromHMS)+import Data.Astro.Coordinate (DecimalDegrees(..))+import Data.Astro.Time.JulianDate (JulianDate(..), splitToDayAndTime)+import Data.Astro.Time.Sidereal+++eps = 1/(24*60*60*10)++tests = [testGroup "GST <-> UT conversions" [+ testGST "1980-04-22 14:36:51.67 UT -> 1980-04-22 04:40:05.23 GST"+ eps+ (hmsToGST 4 40 5.23)+ (utToGST $ JD 2444352.108931366)+ , testGST "2016-08-04 19:28:43.15 UT -> 2016-08-04 16:23:52.94 GST"+ eps+ (hmsToGST 16 23 52.94)+ (utToGST $ JD 2457605.3116105325)+ , testJD "1980-04-22 04:40:05.23 GST -> 1980-04-22 14:36:51.67 UT"+ eps+ (JD 2444352.108931366)+ (gstToUT (JD 2444351.5) (hmsToGST 4 40 05.23))+ , testJD "2016-08-04 16:23:52.94 GST -> 2016-08-04 19:28:43.15 UT"+ eps+ (JD 2457605.3116105325)+ (gstToUT (JD 2457604.5) (hmsToGST 16 23 52.94))+ , testProperty "property" prop_siderealTimeConversions+ ]+ , testGroup "GST <-> LST converions" [+ testLST "04:40:05.23 GST -> 00:24:05.23 LST"+ eps+ (hmsToLST 0 24 5.23)+ (gstToLST (DD $ -64) (hmsToGST 4 40 5.23))+ , testLST "15:25:35.12 GST -> 20:20:27.92 LST"+ eps+ (hmsToLST 20 20 27.92)+ (gstToLST (DD 73.72) (hmsToGST 15 25 35.12))+ , testLST "21:41:25.78 GST -> 04:36:13.78 LST"+ eps+ (hmsToLST 4 36 13.78)+ (gstToLST (DD 103.7) (hmsToGST 21 41 25.78))+ , testGST "00:24:05.23 LST -> 04:40:05.23 GST"+ eps+ (hmsToGST 4 40 5.23)+ (lstToGST (DD $ -64) (hmsToLST 0 24 5.23))+ , testGST "20:20:27.92 LST -> 15:25:35.12 GST"+ eps+ (hmsToGST 15 25 35.12)+ (lstToGST (DD 73.72) (hmsToLST 20 20 27.92))+ ]+ , testGST "04:36:13.78 LST -> 21:41:25.78 GST (w/ DC)"+ eps+ (hmsToGST (-2) (-18) (-34.22))+ (lstToGSTwDC (DD 103.7) (hmsToLST 4 36 13.78))+ , testGST "04:36:13.78 LST -> 21:41:25.78 GST"+ eps+ (hmsToGST 21 41 25.78)+ (lstToGST (DD 103.7) (hmsToLST 4 36 13.78))+ , testProperty "property longitude=-101.13" $ prop_localGlobalConverions (DD $ -101.13)+ , testProperty "property longitude=31.7" $ prop_localGlobalConverions (DD 31.7)+ ]++testLST msg eps expected actual = testDecimalHours msg eps (lstToDH expected) (lstToDH actual)+testGST msg eps expected actual = testDecimalHours msg eps (gstToDH expected) (gstToDH actual)++prop_siderealTimeConversions =+ forAll (choose (0, 999999999)) $ check+ where check utN =+ let utJd = JD utN+ gst = utToGST utJd+ utJd'@(JD utN') = gstToUT utJd gst+ (JD utD, _) = splitToDayAndTime utJd+ (_, JD utT') = splitToDayAndTime utJd'+ DH diff = fromHMS 0 3 57+ hasAmbigity = utT' < diff+ eps = 0.0000001+ in (hasAmbigity || abs(utN-utN') < eps)+++prop_localGlobalConverions longitude =+ forAll (choose (0, 24)) $ check+ where check n =+ let dh = (DH n)+ gst = lstToGST24 longitude $ gstToLST longitude $ dhToGST dh+ lst = gstToLST longitude $ lstToGST24 longitude $ dhToLST dh+ eps = 0.000000001+ DH a1 = gstToDH gst+ DH a2 = lstToDH lst+ in abs(n-a1) < eps && abs(n-a2) < eps+ lstToGST24 longitude lst =+ let gst = lstToGST longitude lst+ dh24 = reduceToZeroRange 24 $ gstToDH gst+ in dhToGST dh24
+ test/Data/Astro/TimeTest.hs view
@@ -0,0 +1,42 @@+module Data.Astro.TimeTest+(+ tests+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Astro.Time.SiderealTest (testLST)+import Data.Astro.Time.JulianDateTest (testJD, testLCT)+import Data.Astro.Time+import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), lctFromYMDHMS, lcdFromYMD)+import Data.Astro.Types+import Data.Astro.Time.Sidereal++tests = [testGroup "LCT <-> LST" [+ testLST "1980-04-22 14:36:51.67 LCT -> 1980-04-22 04:24:44.65 LST"+ 0.0000001+ (hmsToLST 4 24 44.655)+ (lctToLST (DD (-64.0)) (LCT (-4) (JD 2444352.2755980324)))+ , testLCT "1980-04-22 04:24:44.65 LST -> 1980-04-22 14:36:51.67 LCT"+ 0.001+ (lctFromYMDHMS (-4) 1980 4 22 14 35 51.6704)+ (lstToLCT (DD (-64.0)) (lcdFromYMD (-4) 1980 4 22) (hmsToLST 04 24 44.655))+ ]+ , testGroup "UT -> LST" [+ testLST "1980-04-22 18:36:51.67 UT -> 04:24:44.65 LST"+ 0.0000001+ (hmsToLST 4 24 44.655)+ (utToLST (DD (-64.0)) (JD 2444352.2755980324))+ , testLST "1979-02-26 16:45:00 UT -> 04:24:44.65 LST"+ 0.0000001+ (hmsToLST 20 28 44.7994)+ (utToLST (-100.0) (JD 2443931.1979166665))+ ]+ ]
+ test/Data/Astro/TypesTest.hs view
@@ -0,0 +1,168 @@+module Data.Astro.TypesTest+(+ tests+ , testDecimalDegrees+ , testDecimalHours+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Ratio ((%))+import Data.Astro.Types++tests = [testGroup "DecimalDegrees <-> DecimalHours" [+ testDecimalDegrees "12.03 H -> 180.45 D" 0.000001 (DD 180.45) $ fromDecimalHours (DH 12.03)+ , testDecimalHours "180.45 D -> 12.03 H" 0.000001 (DH 12.03) $ toDecimalHours (DD 180.45)+ , testProperty "property" prop_DHConversion+ ]+ , testGroup "DecimalDegrees <-> Radians" [+ testCase "0 -> 0 (rad)" $ assertApproxEqual "" 0.000000001 0 $ toRadians (DD 0)+ , testCase "45 -> PI/4" $ assertApproxEqual "" 0.000000001 (pi*0.25) $ toRadians (DD 45)+ , testCase "90 -> PI/2" $ assertApproxEqual "" 0.000000001 (pi*0.5) $ toRadians (DD 90)+ , testCase "180 -> PI" $ assertApproxEqual "" 0.000000001 pi $ toRadians (DD 180)+ , testCase "360 -> 2*PI" $ assertApproxEqual "" 0.000000001 (pi*2) $ toRadians (DD 360)+ , testDecimalDegrees "0 -> 0 (deg)" 0.000000001 (DD 0) (fromRadians 0)+ , testDecimalDegrees "pi/4 -> 45" 0.000000001 (DD 45) (fromRadians (pi*0.25))+ , testDecimalDegrees "pi/2 -> 90" 0.000000001 (DD 90) (fromRadians (pi*0.5))+ , testDecimalDegrees "pi -> 180" 0.000000001 (DD 180) (fromRadians pi)+ , testDecimalDegrees "2*pi -> 360" 0.000000001 (DD 360) (fromRadians (pi*2))+ ]+ , testGroup "DecimalDegrees <-> DMS" [+ testDecimalDegrees "182 31' 27''" 0.00001 (DD 182.52417) $ fromDMS 182 31 27+ , testCase "182.5" $ toDMS (DD 182.5) @?= (182, 30, 0)+ , testProperty "property" prop_DMSConversion+ ]+ , testGroup "DecimalHours <-> HMS" [+ testDecimalHours "HMS -> DH 6:00" 0.00000001 (DH 6.0) (fromHMS 6 0 0)+ , testDecimalHours "HMS -> DH 18:00" 0.00000001 (DH 18.0) (fromHMS 18 0 0)+ , testDecimalHours "HMS -> DH 18:30" 0.00000001 (DH $ (18*2 + 1) / 2) (fromHMS 18 30 0)+ , testDecimalHours "HMS -> DH 00:00:30" 0.00000001 (DH $ 30 / (60*60)) (fromHMS 0 0 30) + , testDecimalHours "HMS -> DH 00:00:10" 0.00000001 (DH 0.002777777778) $ fromHMS 0 0 10+ , testDecimalHours "HMS -> DH 23:59:59.99999" 0.00000001 (DH 24.0) $ fromHMS 23 59 59.99999+ , testCase "DH -> HMS 6:00" $ toHMS (DH 6.0) @?= (6, 0, 0)+ , testCase "DH -> HMS 18:00" $ toHMS (DH 18.0) @?= (18, 0, 0)+ , testCase "DH -> HMS 18:30" $ toHMS (DH $ (18*2 + 1) / 2) @?= (18, 30, 0)+ , testCase "DH -> HMS 00:00:30" $ toHMS (DH $ (30 / (60*60))) @?= (0, 0, 30)+ , testProperty "property" prop_HMSConversion + ]+ , testGroup "Light travel time" [+ testDecimalHours "7.7 AU" 0.0000001 1.06722 (lightTravelTime 7.7)+ ]+ , testGroup "DD: standard typeclasses" [+ testCase "show" $ "DD 15.5" @=? show (DD 15.5)+ , testCase "showList" $ "[DD 15.3,DD 15.7]" @=? showList [DD 15.3, DD 15.7] ""+ , testCase "showsPrec" $ "DD 15.5" @=? showsPrec 0 (DD 15.5) ""+ , testCase "== (True)" $ True @=? (DD 15.5) == (DD 15.5)+ , testCase "== (False)" $ False @=? (DD 15.3) == (DD 15.5)+ , testCase "/= (True)" $ True @=? (DD 15.3) /= (DD 15.5)+ , testCase "/= (False)" $ False @=? (DD 15.5) /= (DD 15.5)+ , testCase "compare: LT" $ LT @=? (DD 15.3) `compare` (DD 15.5)+ , testCase "compare: EQ" $ EQ @=? (DD 15.5) `compare` (DD 15.5)+ , testCase "compare: GT" $ GT @=? (DD 15.7) `compare` (DD 15.5)+ , testCase "<" $ True @=? (DD 15.3) < (DD 15.7)+ , testCase "<=" $ True @=? (DD 15.3) <= (DD 15.7)+ , testCase ">" $ False @=? (DD 15.3) > (DD 15.7)+ , testCase ">=" $ False @=? (DD 15.3) >= (DD 15.7)+ , testCase "max" $ (DD 15.7) @=? max (DD 15.3) (DD 15.7)+ , testCase "min" $ (DD 15.3) @=? min (DD 15.3) (DD 15.7)+ , testCase "abs" $ (DD 15.7) @=? abs (DD (-15.7))+ , testCase "signum > 0" $ (DD 1.0) @=? signum (DD 15.5)+ , testCase "signum = 0" $ (DD 0.0) @=? signum (DD 0.0)+ , testCase "signum < 0" $ (DD $ -1.0) @=? signum (DD $ -15.5)+ , testCase "toRational" $ (31 % 2) @=? toRational (DD 15.5)+ , testCase "recip" $ (DD 0.01) @=? recip (DD 100)+ , testCase "properFraction" $ (15, DD 0.5) @=? properFraction (DD 15.5)+ ]+ , testGroup "DH: standard typeclasses" [+ testCase "show" $ "DH 15.5" @=? show (DH 15.5)+ , testCase "showList" $ "[DH 15.3,DH 15.7]" @=? showList [DH 15.3, DH 15.7] ""+ , testCase "showsPrec" $ "DH 15.5" @=? showsPrec 0 (DH 15.5) ""+ , testCase "== (True)" $ True @=? (DH 15.5) == (DH 15.5)+ , testCase "== (False)" $ False @=? (DH 15.3) == (DH 15.5)+ , testCase "/= (True)" $ True @=? (DH 15.3) /= (DH 15.5)+ , testCase "/= (False)" $ False @=? (DH 15.5) /= (DH 15.5)+ , testCase "compare: LT" $ LT @=? (DH 15.3) `compare` (DH 15.5)+ , testCase "compare: EQ" $ EQ @=? (DH 15.5) `compare` (DH 15.5)+ , testCase "compare: GT" $ GT @=? (DH 15.7) `compare` (DH 15.5)+ , testCase "<" $ True @=? (DH 15.3) < (DH 15.7)+ , testCase "<=" $ True @=? (DH 15.3) <= (DH 15.7)+ , testCase ">" $ False @=? (DH 15.3) > (DH 15.7)+ , testCase ">=" $ False @=? (DH 15.3) >= (DH 15.7)+ , testCase "max" $ (DH 15.7) @=? max (DH 15.3) (DH 15.7)+ , testCase "min" $ (DH 15.3) @=? min (DH 15.3) (DH 15.7)+ , testCase "abs" $ (DH 15.7) @=? abs (DH (-15.7))+ , testCase "signum > 0" $ (DH 1.0) @=? signum (DH 15.5)+ , testCase "signum = 0" $ (DH 0.0) @=? signum (DH 0.0)+ , testCase "signum < 0" $ (DH $ -1.0) @=? signum (DH $ -15.5)+ , testCase "toRational" $ (31 % 2) @=? toRational (DH 15.5)+ , testCase "recip" $ (DH 0.01) @=? recip (DH 100)+ , testCase "properFraction" $ (15, DH 0.5) @=? properFraction (DH 15.5)+ ]+ , testGroup "AU: standard typeclasses" [+ testCase "show" $ "AU 15.5" @=? show (AU 15.5)+ , testCase "showList" $ "[AU 15.3,AU 15.7]" @=? showList [AU 15.3, AU 15.7] ""+ , testCase "showsPrec" $ "AU 15.5" @=? showsPrec 0 (AU 15.5) ""+ , testCase "== (True)" $ True @=? (AU 15.5) == (AU 15.5)+ , testCase "== (False)" $ False @=? (AU 15.3) == (AU 15.5)+ , testCase "/= (True)" $ True @=? (AU 15.3) /= (AU 15.5)+ , testCase "/= (False)" $ False @=? (AU 15.5) /= (AU 15.5)+ , testCase "compare: LT" $ LT @=? (AU 15.3) `compare` (AU 15.5)+ , testCase "compare: EQ" $ EQ @=? (AU 15.5) `compare` (AU 15.5)+ , testCase "compare: GT" $ GT @=? (AU 15.7) `compare` (AU 15.5)+ , testCase "<" $ True @=? (AU 15.3) < (AU 15.7)+ , testCase "<=" $ True @=? (AU 15.3) <= (AU 15.7)+ , testCase ">" $ False @=? (AU 15.3) > (AU 15.7)+ , testCase ">=" $ False @=? (AU 15.3) >= (AU 15.7)+ , testCase "max" $ (AU 15.7) @=? max (AU 15.3) (AU 15.7)+ , testCase "min" $ (AU 15.3) @=? min (AU 15.3) (AU 15.7)+ , testCase "+" $ (AU 17.5) @=? (AU 15.5) + (AU 2)+ , testCase "-" $ (AU 13.5) @=? (AU 15.5) - (AU 2)+ , testCase "*" $ (AU 31) @=? (AU 15.5) * (AU 2)+ , testCase "negate" $ (AU 15.5) @=? negate (AU $ -15.5)+ , testCase "abs" $ (AU 15.7) @=? abs (AU (-15.7))+ , testCase "signum > 0" $ (AU 1.0) @=? signum (AU 15.5)+ , testCase "signum = 0" $ (AU 0.0) @=? signum (AU 0.0)+ , testCase "signum < 0" $ (AU $ -1.0) @=? signum (AU $ -15.5)+ , testCase "fromInteger" $ (AU 17) @=? fromInteger 17+ , testCase "toRational" $ (31 % 2) @=? toRational (AU 15.5)+ , testCase "/" $ (AU 10) @=? (AU 30) / (AU 3)+ , testCase "recip" $ (AU 0.01) @=? recip (AU 100)+ , testCase "properFraction" $ (15, AU 0.5) @=? properFraction (AU 15.5)+ ]+ ]+++testDecimalDegrees msg eps (DD expected) (DD actual) =+ testCase msg $ assertApproxEqual "" eps expected actual++testDecimalHours msg eps (DH expected) (DH actual) =+ testCase msg $ assertApproxEqual "" eps expected actual++prop_DHConversion n =+ let DH h = toDecimalHours . fromDecimalHours $ DH n+ DD d = fromDecimalHours . toDecimalHours $ DD n+ eps = 0.00000001+ in abs(n-h) < eps && abs(n-d) < eps+ where types = (n::Double) ++prop_DMSConversion dd =+ let (d, m, s) = toDMS $ DD dd+ DD d' = fromDMS d m s+ in abs(dd-d') < 0.0000001+ where types = (dd::Double)++prop_HMSConversion =+ forAll (choose (0, 1.0)) $ checkHMSConversionProperties++checkHMSConversionProperties :: Double -> Bool+checkHMSConversionProperties n =+ let (h, m, s) = toHMS $ DH n+ DH n2 = fromHMS h m s+ in abs (n-n2) < 0.00000001
+ test/Data/Astro/UtilsTest.hs view
@@ -0,0 +1,86 @@+module Data.Astro.UtilsTest+(+ tests+)++where++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit+import Test.HUnit.Approx+import Test.QuickCheck++import Data.Fixed(Pico(..))++import Data.Astro.Utils++tests = [testGroup "fromFixed" [+ testProperty "property" prop_fromFixed+ , testCase "5.111123" $ assertApproxEqual "" 0.000000001 5.111123 $ fromFixed (toPico 5.111123)+ , testCase "-999.9999" $ assertApproxEqual "" 0.000000001 (-999.9999) $ fromFixed (toPico (-999.9999))+ ]+ , testGroup "fraction" [+ testProperty "property" prop_fraction+ , testCase "5.562" $ assertFraction 5.562+ , testCase "-7.93" $ assertFraction (-7.93)+ , testCase "-999.9999" $ assertFraction (-999.9999)+ ]+ , testGroup "trunc" [+ testProperty "property" prop_trunc+ , testCase "5.562" $ 5.0 @=? trunc 5.562+ , testCase "-7.93" $ (-7.0) @=? trunc (-7.93)+ ]+ , testGroup "reduceToZeroRange" [+ testCase "24 -465.986246" $ assertApproxEqual "" 0.000000001 14.013754 $ reduceToZeroRange 24 (-465.986246)+ , testProperty "property for r = 24" $ prop_reduceToZeroRange 24+ , testProperty "property for r = 1" $ prop_reduceToZeroRange 1+ ]+ , testGroup "Degrees <-> Radians" [+ testCase "0 -> 0 (rad)" $ assertApproxEqual "" 0.000000001 0 $ toRadians 0+ , testCase "45 -> PI/4" $ assertApproxEqual "" 0.000000001 (pi*0.25) $ toRadians 45+ , testCase "90 -> PI/2" $ assertApproxEqual "" 0.000000001 (pi*0.5) $ toRadians 90+ , testCase "180 -> PI" $ assertApproxEqual "" 0.000000001 pi $ toRadians 180+ , testCase "360 -> 2*PI" $ assertApproxEqual "" 0.000000001 (pi*2) $ toRadians 360+ , testCase "0 -> 0 (deg)" $ assertApproxEqual "" 0.000000001 0 $ fromRadians 0+ , testCase "pi/4 -> 45" $ assertApproxEqual "" 0.000000001 45 $ fromRadians (pi*0.25)+ , testCase "pi/2 -> 90" $ assertApproxEqual "" 0.000000001 90 $ fromRadians (pi*0.5)+ , testCase "pi -> 180" $ assertApproxEqual "" 0.000000001 180 $ fromRadians pi+ , testCase "2*pi -> 360" $ assertApproxEqual "" 0.000000001 360 $ fromRadians (pi*2)+ ]+ , testGroup "roundToN" [+ testCase "10.12341234 -> 10.12341" $ assertApproxEqual "" 0.000000001 10.12341 $ roundToN 5 10.12341234+ , testCase "-10.123456789 -> -10.123" $ assertApproxEqual "" 0.000000001 (-10.123) $ roundToN 3 (-10.123456789)+ , testCase "10.9876543 -> 10.987" $ assertApproxEqual "" 0.000000001 10.988 $ roundToN 3 10.9876543+ , testCase "-10.9876543 -> -10.987" $ assertApproxEqual "" 0.000000001 (-10.9877) $ roundToN 4 (-10.9876543)+ ]+ ]++toPico :: Real a => a -> Pico+toPico = realToFrac++fromFraction :: Real a => (Int, a) -> a+fromFraction (i, f) = f + fromIntegral i++assertFraction d = assertApproxEqual "" 0.0000001 d $ fromFraction $ fraction d++prop_fromFixed d =+ abs((fromFixed ((realToFrac d)::Pico))-d) < 0.0000001+ where types = (d::Double)++prop_fraction d =+ let (i, f) = fraction d+ f' = d - fromIntegral i+ in i == truncate d && abs(f'-f) < 0.0000001+ where types = (d::Double)++prop_trunc d =+ let d' = fromIntegral $ truncate d+ in abs(d' - trunc d) < 0.0000001+ where types = (d::Double)++prop_reduceToZeroRange r n =+ let k = reduceToZeroRange r n+ in k < r && k >= 0+ where types = (n::Double)
+ test/Test/HUnit/Approx.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE ImplicitParams, CPP #-}+#if __GLASGOW_HASKELL__ >= 707+{-# LANGUAGE Safe #-} -- Test.HUnit is not Safe in 7.6 and below+#endif+-----------------------------------------------------------------------------+-- |+-- Module : Test.HUnit.Approx+-- Copyright : (C) 2014 Richard Eisenberg+-- License : BSD-style (see LICENSE)+-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu)+-- Stability : intended to be stable+-- Portability : not portable (uses implicit parameters)+--+-- This module exports combinators to allow approximate equality of+-- floating-point values in HUnit tests.+-----------------------------------------------------------------------------++module Test.HUnit.Approx (+ -- * Assertions+ assertApproxEqual, (@~?), (@?~),++ -- * Tests+ (~~?), (~?~)+ ) where++import Test.HUnit+import Control.Monad ( unless )++-- | Asserts that the specified actual value is approximately equal to the+-- expected value. The output message will contain the prefix, the expected+-- value, the actual value, and the maximum margin of error.+-- +-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted+-- and only the expected and actual values are output.+assertApproxEqual :: (Ord a, Num a, Show a)+ => String -- ^ The message prefix+ -> a -- ^ Maximum allowable margin of error+ -> a -- ^ The expected value + -> a -- ^ The actual value+ -> Assertion+assertApproxEqual preface epsilon expected actual =+ unless (abs (actual - expected) <= epsilon) (assertFailure msg)+ where msg = (if null preface then "" else preface ++ "\n") +++ "expected: " ++ show expected ++ "\n but got: " ++ show actual +++ "\n (maximum margin of error: " ++ show epsilon ++ ")"++-- | Asserts that the specified actual value is approximately equal to the+-- expected value (with the expected value on the right-hand side). The margin+-- of error is specified with the implicit parameter @epsilon@.+(@?~) :: (Ord a, Num a, Show a, ?epsilon :: a)+ => a -- ^ The actual value+ -> a -- ^ The expected value+ -> Assertion+x @?~ y = assertApproxEqual "" ?epsilon y x+infix 1 @?~++-- | Asserts that the specified actual value is approximately equal to the+-- expected value (with the expected value on the left-hand side). The margin+-- of error is specified with the implicit parameter @epsilon@.+(@~?) :: (Ord a, Num a, Show a, ?epsilon :: a)+ => a -- ^ The expected value+ -> a -- ^ The actual value+ -> Assertion+x @~? y = assertApproxEqual "" ?epsilon x y+infix 1 @~?++-- | Shorthand for a test case that asserts approximate equality (with the+-- expected value on the left-hand side, and the actual value on the+-- right-hand side).+(~~?) :: (Ord a, Num a, Show a, ?epsilon :: a)+ => a -- ^ The expected value+ -> a -- ^ The actual value+ -> Test+expected ~~? actual = TestCase (expected @~? actual)+infix 1 ~~?++-- | Shorthand for a test case that asserts approximate equality (with the+-- actual value on the left-hand side, and the expected value on the+-- right-hand side).+(~?~) :: (Ord a, Num a, Show a, ?epsilon :: a)+ => a -- ^ The actual value+ -> a -- ^ The expected value + -> Test+actual ~?~ expected = TestCase (actual @?~ expected)+infix 1 ~?~