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