astro 0.4.2.1 → 0.4.3.0
raw patch · 48 files changed
+5368/−5308 lines, 48 filessetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Data.Astro.Planet: planetDistance :: (PlanetDetails -> JulianDate -> DecimalDegrees) -> PlanetDetails -> PlanetDetails -> JulianDate -> AstronomicalUnits
+ Data.Astro.Planet: planetTrueAnomaly2 :: PlanetDetails -> JulianDate -> DecimalDegrees
+ Data.Astro.Planet.PlanetMechanics: planetDistance :: (PlanetDetails -> JulianDate -> DecimalDegrees) -> PlanetDetails -> PlanetDetails -> JulianDate -> AstronomicalUnits
+ Data.Astro.Planet.PlanetMechanics: planetTrueAnomaly2 :: PlanetDetails -> JulianDate -> DecimalDegrees
- Data.Astro.Types: toDMS :: (Integral b, Integral a) => DecimalDegrees -> (a, b, Double)
+ Data.Astro.Types: toDMS :: (Integral a, Integral b) => DecimalDegrees -> (a, b, Double)
- Data.Astro.Types: toHMS :: (Integral b, Integral a) => DecimalHours -> (a, b, Double)
+ Data.Astro.Types: toHMS :: (Integral a, Integral b) => DecimalHours -> (a, b, Double)
Files
- LICENSE +30/−30
- README.md +515/−509
- Setup.hs +2/−2
- astro.cabal +89/−88
- src/Data/Astro/CelestialObject.hs +42/−42
- src/Data/Astro/CelestialObject/RiseSet.hs +191/−191
- src/Data/Astro/Coordinate.hs +362/−362
- src/Data/Astro/Effects.hs +50/−50
- src/Data/Astro/Effects/Aberration.hs +32/−32
- src/Data/Astro/Effects/Nutation.hs +59/−59
- src/Data/Astro/Effects/Parallax.hs +70/−70
- src/Data/Astro/Effects/Precession.hs +117/−117
- src/Data/Astro/Moon.hs +234/−234
- src/Data/Astro/Moon/MoonDetails.hs +47/−47
- src/Data/Astro/Planet.hs +102/−100
- src/Data/Astro/Planet/PlanetDetails.hs +72/−72
- src/Data/Astro/Planet/PlanetMechanics.hs +308/−286
- src/Data/Astro/Star.hs +104/−104
- src/Data/Astro/Sun.hs +252/−252
- src/Data/Astro/Sun/SunInternals.hs +28/−28
- src/Data/Astro/Time.hs +60/−60
- src/Data/Astro/Time/Conv.hs +74/−74
- src/Data/Astro/Time/Epoch.hs +51/−51
- src/Data/Astro/Time/GregorianCalendar.hs +86/−86
- src/Data/Astro/Time/JulianDate.hs +240/−240
- src/Data/Astro/Time/Sidereal.hs +143/−143
- src/Data/Astro/Types.hs +224/−224
- src/Data/Astro/Utils.hs +68/−68
- test/Data/Astro/CelestialObject/RiseSetTest.hs +81/−81
- test/Data/Astro/CelestialObjectTest.hs +32/−32
- test/Data/Astro/CoordinateTest.hs +180/−180
- test/Data/Astro/Effects/ParallaxTest.hs +47/−47
- test/Data/Astro/EffectsTest.hs +86/−86
- test/Data/Astro/MoonTest.hs +81/−81
- test/Data/Astro/Planet/PlanetDetailsTest.hs +25/−25
- test/Data/Astro/Planet/PlanetMechanicsTest.hs +131/−131
- test/Data/Astro/Sun/SunInternalsTest.hs +35/−35
- test/Data/Astro/SunTest.hs +181/−181
- test/Data/Astro/Time/ConvTest.hs +50/−50
- test/Data/Astro/Time/EpochTest.hs +27/−0
- test/Data/Astro/Time/GregorianCalendarTest.hs +57/−57
- test/Data/Astro/Time/JulianDateTest.hs +161/−161
- test/Data/Astro/Time/SiderealTest.hs +112/−112
- test/Data/Astro/TimeTest.hs +42/−42
- test/Data/Astro/TypesTest.hs +172/−172
- test/Data/Astro/UtilsTest.hs +86/−86
- test/Main.hs +45/−43
- test/Test/HUnit/Approx.hs +85/−85
LICENSE view
@@ -1,30 +1,30 @@-Copyright Alexander Ignatyev (c) 2016--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * Neither the name of Author name here nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright Alexander Ignatyev (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,509 +1,515 @@-# Amateur astronomical computations--[](https://travis-ci.org/aligusnet/astro)-[](https://coveralls.io/github/aligusnet/astro)-[](https://aligusnet.github.io/astro-docs/doc/index.html)-[](https://hackage.haskell.org/package/astro) ---## Usage--### Build the project-- stack build--### Run unit tests-- stack tests--## Documentation--### Useful types--#### Decimal hours and Decimal degrees--Types to represent hours (used in celestial coordinate systems and as time zone) and degrees (used in coordinate systems).--```haskell-import Data.Astro.Types---- 10h 15m 19.7s-dh :: DecimalHours-dh = fromHMS 10 15 19.7--- DH 10.255472222222222--(h, m, s) = toHMS dh--- (10,15,19.699999999999562)----- 51°28′40″-dd :: DecimalDegrees-dd = fromDMS 51 28 40--- DD 51.477777777777774--(d, m, s) = toDMS dd--- (51,28,39.999999999987494)-```--#### Geographic Coordinates--```haskell-import Data.Astro.Types---- the Royal Observatory, Greenwich-ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--- GeoC {geoLatitude = DD 51.4778, geoLongitude = DD (-0.0014)}-```--### Time--The main time datetime type used in the library is `JulianDate` defined in `Data.Astro.Time.JulianDate`. JulianDate is just a number of days since noon of 1 January 4713 BC:--```haskell-import Data.Astro.Time.JulianDate---- 2017-06-25 9:29:00 (GMT)-jd :: JulianDate-jd = fromYMDHMS 2017 6 25 9 29 0--- JD 2457929.895138889-```--`LocalCiviTime` and `LocalCivilDate` are Julian dates with time zones:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Types---- 2017-06-25 10:29:00 +0100 (BST)-lct :: LocalCivilTime-lct = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--- 2017-06-25 10:29:00.0000 +1.0--lctJD :: JulianDate-lctJD = lctUniversalTime lct--- JD 2457929.895138889--lctTZ :: DecimalHours-lctTZ = lctTimeZone lct--- DH 1.0--lcd :: LocalCivilDate-lcd = lcdFromYMD (DH 1) 2017 6 25--lcdJD :: JulianDate-lcdJD = lcdDate lcd--- JD 2457929.5--lcdTZ :: DecimalHours-lcdTZ = lcdTimeZone lcd--- DH 1.0-```--### Celestial coordinate systems--The celestical coordinate systems are defined in `Data.Astro.Coordinate`.--If you would like to locate Sirius in the sky you need to know the altitude or 'how far up' angle in the sky and azimuth - 'how far round' angle from the north direction to the east. this describes the __Horizontal coordinate system__:-----```haskell-import Data.Astro.Coordinate-import Data.Astro.Types--hc :: HorizonCoordinates-hc = HC (DD 30.5) (DD 180)--- HC {hAltitude = DD 30.0, hAzimuth = DD 180.0}-```--Unfortunately the Horizontal coordinate system values depend on the position of the observer. And it's not handy when you need to share coordinates of some celestial object with your friend in Japan.--The second coordinate system is the __Equatorial coordinate system__. This coordinate system uses the location of the centre of the Earth as the zero point so it does not depend on the observer's location.--We have two flavours of equatorial coordinates:--* the first one uses the _vernal equinox_ as a starting direction for the 'how far round' coordinate (__right ascension, α__),--* the second one uses the _meridian_ instead of the vernal equinox (__hour angle__).--We can consider the second one as a transition coordinate system between the horizontal one and the 'true' equatorial one.---```haskell-import Data.Astro.Coordinate-import Data.Astro.Types--ec1 :: EquatorialCoordinates1-ec1 = EC1 (DD 71.7) (DH 8)--- EC1 {e1Declination = DD 71.7, e1RightAscension = DH 8.0}--ec2 :: EquatorialCoordinates2-ec2 = EC1 (DD 77.7) (DH 11)--- EC2 {e2Declination = DD 77.7, e2HoursAngle = DH 11.0}-```--#### Transformations--Say, now is 2017-06-25 10:29 BST and we are somewhere near the Royal Observatory, Greenwich.--Let convert the current location of the Sun in horizon coordinates (altitude: 49°18′21.77″, azimuth: 118°55′19.53″) to equatorial coordinates and back to horizon ones:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--sunHC :: HorizonCoordinates-sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53)--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}--sunEC2 :: EquatorialCoordinates2-sunEC2 = horizonToEquatorial (geoLatitude ro) sunHC--- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537}--sunEC1 :: EquatorialCoordinates1-sunEC1 = EC1 (e2Declination sunEC2) (haToRA (e2HoursAngle sunEC2) (geoLongitude ro) (lctUniversalTime dt))--- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224}---sunEC2' :: EquatorialCoordinates2-sunEC2' = EC2 (e1Declination sunEC1) (raToHA (e1RightAscension sunEC1) (geoLongitude ro) (lctUniversalTime dt))--- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537}--sunHC' :: HorizonCoordinates-sunHC' = equatorialToHorizon (geoLatitude ro) sunEC2'--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}-```--You can use function-shortcuts to simplify transformation EquatorialCoordinates1 <-> HorizonCoordinates: `ec1ToHC` and `hcToEC1`:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--sunHC :: HorizonCoordinates-sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53)--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}--sunEC1 :: EquatorialCoordinates1-sunEC1 = hcToEC1 ro (lctUniversalTime dt) sunHC--- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224}--sunHC' :: HorizonCoordinates-sunHC' = ec1ToHC ro (lctUniversalTime dt) sunEC1--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}-```--### Stars--The ancient astronomers noted that there were 2 types of stars: some of them were fixed, travelling the same way across the sky every sidereal day and another were wanderers (planetai in ancient Greek).--Of course, stars are not fixed, they are travelling with high speeds but distances to them are so high that their movement is very difficult to note. So we can assume that they are fixed for our purposes.--Given the "fixed" equatorial coordinates of the star we only need to transform them to the horizon coordinates to find out where the star in the sky.--In the example below we will use `Data.Astro.Star` module which defines equatorial coordinates of some stars:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Star---ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0---- Calculate location of Betelgeuse--betelgeuseEC1 :: EquatorialCoordinates1-betelgeuseEC1 = starCoordinates Betelgeuse--- EC1 {e1Declination = DD 7.407064, e1RightAscension = DH 5.919529}--betelgeuseHC :: HorizonCoordinates-betelgeuseHC = ec1ToHC ro (lctUniversalTime dt) betelgeuseEC1--- HC {hAltitude = DD 38.30483892505852, hAzimuth = DD 136.75755644642248}-```--#### Rise and Set--`Data.Astro.CelestialObject.RiseSet` module defines `RiseSet` type to represent time and azimuth of rise and set.--Let calculate rise and set time of Rigel:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Effects-import Data.Astro.CelestialObject.RiseSet-import Data.Astro.Star---ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25---- Calculate location of Betelgeuse--rigelEC1 :: EquatorialCoordinates1-rigelEC1 = starCoordinates Rigel--verticalShift :: DecimalDegrees-verticalShift = refract (DD 0) 12 1012--- DD 0.5660098245614035--rigelRiseSet :: RiseSetLCT-rigelRiseSet = riseAndSetLCT ro today verticalShift rigelEC1--- RiseSet (2017-06-25 06:38:18.4713 +1.0,DD 102.51249855335433) (2017-06-25 17:20:33.4902 +1.0,DD 257.48750144664564)-```--As we can see Rigel rose today at 06:38:18 and will set at 17:20:33, azimuths of rise and set 102.51° and 257.49° correspondingly.--We used `refract` function of `Data.Astro.Effects` module with reasonable default parameters to calculate vertical shift.--### Planets--The planets is completely different story. We cannot assume that the planets have "fixed" location in equatorial coordinates like stars.--What we can do is to describe details of the planets' orbit and calculate their positions at any given moment.--Planets and planet details are defined in `Data.Astro.Planet` module. `j2010PlanetDetails` returns details for the given planet.-This module also defines `planetPosition`, `planetDistance1` and `planetAngularDiameter` to calculate position of the given planet, distance to the planet and angular size of the planet correspondingly.--`1` at the end of the `planetDistance1` means that this function uses not very precise method to do calculations. Sometimes there are `2`-methods available in the library, but not always.--Let us do some planets-related calculations.--Do some initialisation:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Effects-import Data.Astro.CelestialObject.RiseSet-import Data.Astro.Planet--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25--jupiterDetails :: PlanetDetails-jupiterDetails = j2010PlanetDetails Jupiter--earthDetails :: PlanetDetails-earthDetails = j2010PlanetDetails Earth--jupiterPosition :: JulianDate -> EquatorialCoordinates1-jupiterPosition = planetPosition planetTrueAnomaly1 jupiterDetails earthDetails--```--Calculate Jupiter's coordinates:--```haskell-jupiterEC1 :: EquatorialCoordinates1-jupiterEC1 = jupiterPosition (lctUniversalTime dt)--- EC1 {e1Declination = DD (-4.104626810672402), e1RightAscension = DH 12.863365504382228}--jupiterHC :: HorizonCoordinates-jupiterHC = ec1ToHC ro (lctUniversalTime dt) jupiterEC1--- HC {hAltitude = DD (-30.67914598469227), hAzimuth = DD 52.29376845044007}-```--As be can see Jupiter is below the horizon now (the altitude is negative), that's unfortunate.--Now let us calculate distance to Jupiter:--```haskell-jupiterDistance :: AstronomicalUnits-jupiterDistance = planetDistance1 jupiterDetails earthDetails (lctUniversalTime dt)--- AU 5.193435872521039-```--1 Astronomical Unit is an average distance from the Earth to the Sun.--and calculate an angular size now:--```haskell-jupiterAngularSize :: DecimalDegrees-jupiterAngularSize = planetAngularDiameter jupiterDetails jupiterDistance--- DD 1.052289877865987e-2--toDMS jupiterAngularSize--- (0,0,37.88243560317554)-```--#### Rise and Set--Calculate rise and set times of planets are not easy task, because planets change their equatorial coordinates during the day.--`riseAndSet2` function of `Data.Astro.CelestialObject.RiseSet` module applies iterative approach: calculates rise and set date for midday coordinates and then recalculates rise time for rise coordinates and set for set coordinates obtained from the previous step:--```haskell-verticalShift :: DecimalDegrees-verticalShift = refract (DD 0) 12 1012--- DD 0.5660098245614035--jupiterRiseSet :: RiseSetMB-jupiterRiseSet = riseAndSet2 0.000001 jupiterPosition ro verticalShift today--- RiseSet--- (Just (2017-06-25 13:53:27.3109 +1.0,DD 95.88943953535569))--- (Just (2017-06-25 01:21:23.5835 +1.0,DD 264.1289033612776))-```--We can see now why at 10 am Jupiter is below horizon because it will rise only at 1:53 pm.---### Sun--Some examples of doing the Sun's related calculations:--```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Sun--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25--jd :: JulianDate-jd = lctUniversalTime dt--verticalShift :: DecimalDegrees-verticalShift = refract (DD 0) 12 1012---- distance from the Earth to the Sun in kilometres-distance :: Double-distance = sunDistance jd--- 1.5206375976421073e8---- Angular Size-angularSize :: DecimalDegrees-angularSize = sunAngularSize jd--- DD 0.5244849215333616---- The Sun's coordinates-ec1 :: EquatorialCoordinates1-ec1 = sunPosition2 jd--- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748}--hc :: HorizonCoordinates-hc = ec1ToHC ro jd ec1--- HC {hAltitude = DD 49.312050979507404, hAzimuth = DD 118.94723825710143}----- Rise and Set-riseSet :: RiseSetMB-riseSet = sunRiseAndSet ro 0.833333 today--- RiseSet--- (Just (2017-06-25 04:44:04.3304 +1.0,DD 49.043237261724215))--- (Just (2017-06-25 21:21:14.4565 +1.0,DD 310.91655607595595))-```---### Moon--The Moon's related calculations. `Data.Astro.Moon` module defines 2 new types of functions we haven't seen before: `moonPhase` and `moonBrightLimbPositionAngle` which calculate the phase (the area of the visible segment expressed as a fraction of the whole disk) and the position-angle which is the angle of the midpoint of the illuminated limb measured eastwards from the north point of the disk.---```haskell-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Effects-import Data.Astro.CelestialObject.RiseSet-import Data.Astro.Moon--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25--jd :: JulianDate-jd = lctUniversalTime dt---- distance from the Earth to the Moon in kilometres-mdu :: MoonDistanceUnits-mdu = moonDistance1 j2010MoonDetails jd--- MDU 0.9550170577020396--distance :: Double-distance = mduToKm mdu--- 367109.51199772174---- Angular Size-angularSize :: DecimalDegrees-angularSize = moonAngularSize mdu--- DD 0.5425033990980761---- The Moon's coordinates-position :: JulianDate -> EquatorialCoordinates1-position = moonPosition1 j2010MoonDetails--ec1 :: EquatorialCoordinates1-ec1 = position jd--- EC1 {e1Declination = DD 18.706180658927323, e1RightAscension = DH 7.56710547682055}--hc :: HorizonCoordinates-hc = ec1ToHC ro jd ec1--- HC {hAltitude = DD 34.57694951316064, hAzimuth = DD 103.91119101451832}---- Rise and Set-riseSet :: RiseSetMB-riseSet = riseAndSet2 0.000001 position ro verticalShift today--- RiseSet--- (Just (2017-06-25 06:22:51.4858 +1.0,DD 57.81458864497365))--- (Just (2017-06-25 22:28:20.3023 +1.0,DD 300.4168238905249))---- Phase-phase :: Double-phase = moonPhase j2010MoonDetails jd--- 2.4716141948212922e-2---sunEC1 :: EquatorialCoordinates1-sunEC1 = sunPosition2 jd--- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748}--limbAngle :: DecimalDegrees-limbAngle = moonBrightLimbPositionAngle ec1 sunEC1--- DD 287.9869373767473-```+# Amateur astronomical computations + +[](https://travis-ci.org/aligusnet/astro) +[](https://coveralls.io/github/aligusnet/astro) +[](https://aligusnet.github.io/astro-docs/doc/index.html) +[](https://hackage.haskell.org/package/astro) + + +## Usage + +### Install stack + +It will take care of everything. + +[Get started with Stack](https://www.fpcomplete.com/haskell/get-started/) + +### Build the project + + stack build + +### Run unit tests + + stack test + +## Documentation + +### Useful types + +#### Decimal hours and Decimal degrees + +Types to represent hours (used in celestial coordinate systems and as time zone) and degrees (used in coordinate systems). + +```haskell +import Data.Astro.Types + +-- 10h 15m 19.7s +dh :: DecimalHours +dh = fromHMS 10 15 19.7 +-- DH 10.255472222222222 + +(h, m, s) = toHMS dh +-- (10,15,19.699999999999562) + + +-- 51°28′40″ +dd :: DecimalDegrees +dd = fromDMS 51 28 40 +-- DD 51.477777777777774 + +(d, m, s) = toDMS dd +-- (51,28,39.999999999987494) +``` + +#### Geographic Coordinates + +```haskell +import Data.Astro.Types + +-- the Royal Observatory, Greenwich +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) +-- GeoC {geoLatitude = DD 51.4778, geoLongitude = DD (-0.0014)} +``` + +### Time + +The main time datetime type used in the library is `JulianDate` defined in `Data.Astro.Time.JulianDate`. JulianDate is just a number of days since noon of 1 January 4713 BC: + +```haskell +import Data.Astro.Time.JulianDate + +-- 2017-06-25 9:29:00 (GMT) +jd :: JulianDate +jd = fromYMDHMS 2017 6 25 9 29 0 +-- JD 2457929.895138889 +``` + +`LocalCiviTime` and `LocalCivilDate` are Julian dates with time zones: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Types + +-- 2017-06-25 10:29:00 +0100 (BST) +lct :: LocalCivilTime +lct = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 +-- 2017-06-25 10:29:00.0000 +1.0 + +lctJD :: JulianDate +lctJD = lctUniversalTime lct +-- JD 2457929.895138889 + +lctTZ :: DecimalHours +lctTZ = lctTimeZone lct +-- DH 1.0 + +lcd :: LocalCivilDate +lcd = lcdFromYMD (DH 1) 2017 6 25 + +lcdJD :: JulianDate +lcdJD = lcdDate lcd +-- JD 2457929.5 + +lcdTZ :: DecimalHours +lcdTZ = lcdTimeZone lcd +-- DH 1.0 +``` + +### Celestial coordinate systems + +The celestical coordinate systems are defined in `Data.Astro.Coordinate`. + +If you would like to locate Sirius in the sky you need to know the altitude or 'how far up' angle in the sky and azimuth - 'how far round' angle from the north direction to the east. this describes the __Horizontal coordinate system__: + + + + +```haskell +import Data.Astro.Coordinate +import Data.Astro.Types + +hc :: HorizonCoordinates +hc = HC (DD 30.5) (DD 180) +-- HC {hAltitude = DD 30.0, hAzimuth = DD 180.0} +``` + +Unfortunately the Horizontal coordinate system values depend on the position of the observer. And it's not handy when you need to share coordinates of some celestial object with your friend in Japan. + +The second coordinate system is the __Equatorial coordinate system__. This coordinate system uses the location of the centre of the Earth as the zero point so it does not depend on the observer's location. + +We have two flavours of equatorial coordinates: + +* the first one uses the _vernal equinox_ as a starting direction for the 'how far round' coordinate (__right ascension, α__), + +* the second one uses the _meridian_ instead of the vernal equinox (__hour angle__). + +We can consider the second one as a transition coordinate system between the horizontal one and the 'true' equatorial one. + + +```haskell +import Data.Astro.Coordinate +import Data.Astro.Types + +ec1 :: EquatorialCoordinates1 +ec1 = EC1 (DD 71.7) (DH 8) +-- EC1 {e1Declination = DD 71.7, e1RightAscension = DH 8.0} + +ec2 :: EquatorialCoordinates2 +ec2 = EC1 (DD 77.7) (DH 11) +-- EC2 {e2Declination = DD 77.7, e2HoursAngle = DH 11.0} +``` + +#### Transformations + +Say, now is 2017-06-25 10:29 BST and we are somewhere near the Royal Observatory, Greenwich. + +Let convert the current location of the Sun in horizon coordinates (altitude: 49°18′21.77″, azimuth: 118°55′19.53″) to equatorial coordinates and back to horizon ones: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +sunHC :: HorizonCoordinates +sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53) +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} + +sunEC2 :: EquatorialCoordinates2 +sunEC2 = horizonToEquatorial (geoLatitude ro) sunHC +-- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537} + +sunEC1 :: EquatorialCoordinates1 +sunEC1 = EC1 (e2Declination sunEC2) (haToRA (e2HoursAngle sunEC2) (geoLongitude ro) (lctUniversalTime dt)) +-- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224} + + +sunEC2' :: EquatorialCoordinates2 +sunEC2' = EC2 (e1Declination sunEC1) (raToHA (e1RightAscension sunEC1) (geoLongitude ro) (lctUniversalTime dt)) +-- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537} + +sunHC' :: HorizonCoordinates +sunHC' = equatorialToHorizon (geoLatitude ro) sunEC2' +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} +``` + +You can use function-shortcuts to simplify transformation EquatorialCoordinates1 <-> HorizonCoordinates: `ec1ToHC` and `hcToEC1`: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +sunHC :: HorizonCoordinates +sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53) +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} + +sunEC1 :: EquatorialCoordinates1 +sunEC1 = hcToEC1 ro (lctUniversalTime dt) sunHC +-- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224} + +sunHC' :: HorizonCoordinates +sunHC' = ec1ToHC ro (lctUniversalTime dt) sunEC1 +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} +``` + +### Stars + +The ancient astronomers noted that there were 2 types of stars: some of them were fixed, travelling the same way across the sky every sidereal day and another were wanderers (planetai in ancient Greek). + +Of course, stars are not fixed, they are travelling with high speeds but distances to them are so high that their movement is very difficult to note. So we can assume that they are fixed for our purposes. + +Given the "fixed" equatorial coordinates of the star we only need to transform them to the horizon coordinates to find out where the star in the sky. + +In the example below we will use `Data.Astro.Star` module which defines equatorial coordinates of some stars: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Star + + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +-- Calculate location of Betelgeuse + +betelgeuseEC1 :: EquatorialCoordinates1 +betelgeuseEC1 = starCoordinates Betelgeuse +-- EC1 {e1Declination = DD 7.407064, e1RightAscension = DH 5.919529} + +betelgeuseHC :: HorizonCoordinates +betelgeuseHC = ec1ToHC ro (lctUniversalTime dt) betelgeuseEC1 +-- HC {hAltitude = DD 38.30483892505852, hAzimuth = DD 136.75755644642248} +``` + +#### Rise and Set + +`Data.Astro.CelestialObject.RiseSet` module defines `RiseSet` type to represent time and azimuth of rise and set. + +Let calculate rise and set time of Rigel: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Effects +import Data.Astro.CelestialObject.RiseSet +import Data.Astro.Star + + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +-- Calculate location of Betelgeuse + +rigelEC1 :: EquatorialCoordinates1 +rigelEC1 = starCoordinates Rigel + +verticalShift :: DecimalDegrees +verticalShift = refract (DD 0) 12 1012 +-- DD 0.5660098245614035 + +rigelRiseSet :: RiseSetLCT +rigelRiseSet = riseAndSetLCT ro today verticalShift rigelEC1 +-- RiseSet (2017-06-25 06:38:18.4713 +1.0,DD 102.51249855335433) (2017-06-25 17:20:33.4902 +1.0,DD 257.48750144664564) +``` + +As we can see Rigel rose today at 06:38:18 and will set at 17:20:33, azimuths of rise and set 102.51° and 257.49° correspondingly. + +We used `refract` function of `Data.Astro.Effects` module with reasonable default parameters to calculate vertical shift. + +### Planets + +The planets is completely different story. We cannot assume that the planets have "fixed" location in equatorial coordinates like stars. + +What we can do is to describe details of the planets' orbit and calculate their positions at any given moment. + +Planets and planet details are defined in `Data.Astro.Planet` module. `j2010PlanetDetails` returns details for the given planet. +This module also defines `planetPosition`, `planetDistance1` and `planetAngularDiameter` to calculate position of the given planet, distance to the planet and angular size of the planet correspondingly. + +`1` at the end of the `planetDistance1` means that this function uses not very precise method to do calculations. Sometimes there are `2`-methods available in the library, but not always. + +Let us do some planets-related calculations. + +Do some initialisation: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Effects +import Data.Astro.CelestialObject.RiseSet +import Data.Astro.Planet + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +jupiterDetails :: PlanetDetails +jupiterDetails = j2010PlanetDetails Jupiter + +earthDetails :: PlanetDetails +earthDetails = j2010PlanetDetails Earth + +jupiterPosition :: JulianDate -> EquatorialCoordinates1 +jupiterPosition = planetPosition planetTrueAnomaly1 jupiterDetails earthDetails + +``` + +Calculate Jupiter's coordinates: + +```haskell +jupiterEC1 :: EquatorialCoordinates1 +jupiterEC1 = jupiterPosition (lctUniversalTime dt) +-- EC1 {e1Declination = DD (-4.104626810672402), e1RightAscension = DH 12.863365504382228} + +jupiterHC :: HorizonCoordinates +jupiterHC = ec1ToHC ro (lctUniversalTime dt) jupiterEC1 +-- HC {hAltitude = DD (-30.67914598469227), hAzimuth = DD 52.29376845044007} +``` + +As be can see Jupiter is below the horizon now (the altitude is negative), that's unfortunate. + +Now let us calculate distance to Jupiter: + +```haskell +jupiterDistance :: AstronomicalUnits +jupiterDistance = planetDistance1 jupiterDetails earthDetails (lctUniversalTime dt) +-- AU 5.193435872521039 +``` + +1 Astronomical Unit is an average distance from the Earth to the Sun. + +and calculate an angular size now: + +```haskell +jupiterAngularSize :: DecimalDegrees +jupiterAngularSize = planetAngularDiameter jupiterDetails jupiterDistance +-- DD 1.052289877865987e-2 + +toDMS jupiterAngularSize +-- (0,0,37.88243560317554) +``` + +#### Rise and Set + +Calculate rise and set times of planets are not easy task, because planets change their equatorial coordinates during the day. + +`riseAndSet2` function of `Data.Astro.CelestialObject.RiseSet` module applies iterative approach: calculates rise and set date for midday coordinates and then recalculates rise time for rise coordinates and set for set coordinates obtained from the previous step: + +```haskell +verticalShift :: DecimalDegrees +verticalShift = refract (DD 0) 12 1012 +-- DD 0.5660098245614035 + +jupiterRiseSet :: RiseSetMB +jupiterRiseSet = riseAndSet2 0.000001 jupiterPosition ro verticalShift today +-- RiseSet +-- (Just (2017-06-25 13:53:27.3109 +1.0,DD 95.88943953535569)) +-- (Just (2017-06-25 01:21:23.5835 +1.0,DD 264.1289033612776)) +``` + +We can see now why at 10 am Jupiter is below horizon because it will rise only at 1:53 pm. + + +### Sun + +Some examples of doing the Sun's related calculations: + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Sun + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +jd :: JulianDate +jd = lctUniversalTime dt + +verticalShift :: DecimalDegrees +verticalShift = refract (DD 0) 12 1012 + +-- distance from the Earth to the Sun in kilometres +distance :: Double +distance = sunDistance jd +-- 1.5206375976421073e8 + +-- Angular Size +angularSize :: DecimalDegrees +angularSize = sunAngularSize jd +-- DD 0.5244849215333616 + +-- The Sun's coordinates +ec1 :: EquatorialCoordinates1 +ec1 = sunPosition2 jd +-- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748} + +hc :: HorizonCoordinates +hc = ec1ToHC ro jd ec1 +-- HC {hAltitude = DD 49.312050979507404, hAzimuth = DD 118.94723825710143} + + +-- Rise and Set +riseSet :: RiseSetMB +riseSet = sunRiseAndSet ro 0.833333 today +-- RiseSet +-- (Just (2017-06-25 04:44:04.3304 +1.0,DD 49.043237261724215)) +-- (Just (2017-06-25 21:21:14.4565 +1.0,DD 310.91655607595595)) +``` + + +### Moon + +The Moon's related calculations. `Data.Astro.Moon` module defines 2 new types of functions we haven't seen before: `moonPhase` and `moonBrightLimbPositionAngle` which calculate the phase (the area of the visible segment expressed as a fraction of the whole disk) and the position-angle which is the angle of the midpoint of the illuminated limb measured eastwards from the north point of the disk. + + +```haskell +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Effects +import Data.Astro.CelestialObject.RiseSet +import Data.Astro.Moon + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +jd :: JulianDate +jd = lctUniversalTime dt + +-- distance from the Earth to the Moon in kilometres +mdu :: MoonDistanceUnits +mdu = moonDistance1 j2010MoonDetails jd +-- MDU 0.9550170577020396 + +distance :: Double +distance = mduToKm mdu +-- 367109.51199772174 + +-- Angular Size +angularSize :: DecimalDegrees +angularSize = moonAngularSize mdu +-- DD 0.5425033990980761 + +-- The Moon's coordinates +position :: JulianDate -> EquatorialCoordinates1 +position = moonPosition1 j2010MoonDetails + +ec1 :: EquatorialCoordinates1 +ec1 = position jd +-- EC1 {e1Declination = DD 18.706180658927323, e1RightAscension = DH 7.56710547682055} + +hc :: HorizonCoordinates +hc = ec1ToHC ro jd ec1 +-- HC {hAltitude = DD 34.57694951316064, hAzimuth = DD 103.91119101451832} + +-- Rise and Set +riseSet :: RiseSetMB +riseSet = riseAndSet2 0.000001 position ro verticalShift today +-- RiseSet +-- (Just (2017-06-25 06:22:51.4858 +1.0,DD 57.81458864497365)) +-- (Just (2017-06-25 22:28:20.3023 +1.0,DD 300.4168238905249)) + +-- Phase +phase :: Double +phase = moonPhase j2010MoonDetails jd +-- 2.4716141948212922e-2 + + +sunEC1 :: EquatorialCoordinates1 +sunEC1 = sunPosition2 jd +-- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748} + +limbAngle :: DecimalDegrees +limbAngle = moonBrightLimbPositionAngle ec1 sunEC1 +-- DD 287.9869373767473 +```
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
astro.cabal view
@@ -1,88 +1,89 @@-name: astro-version: 0.4.2.1-synopsis: Amateur astronomical computations-description:- Amateur astronomical computations: rise and set times and azimuths,- coordinates, distances, angular sizes and other parameters- of the Sun, the Moon, planets and stars.--homepage: https://github.com/aligusnet/astro-license: BSD3-license-file: LICENSE-author: Alexander Ignatyev-maintainer: Alexander Ignatyev-copyright: 2016-2017 Alexander Ignatyev-category: Science-build-type: Simple--- extra-source-files:-cabal-version: >=1.10-extra-source-files: README.md--library- hs-source-dirs: src- exposed-modules: Data.Astro.Time- , Data.Astro.Time.GregorianCalendar- , Data.Astro.Time.JulianDate- , Data.Astro.Time.Sidereal- , Data.Astro.Time.Epoch- , Data.Astro.Time.Conv- , Data.Astro.Coordinate- , Data.Astro.Types- , Data.Astro.Utils- , Data.Astro.CelestialObject- , Data.Astro.CelestialObject.RiseSet- , Data.Astro.Effects- , Data.Astro.Effects.Parallax- , Data.Astro.Star- , Data.Astro.Sun- , Data.Astro.Sun.SunInternals- , Data.Astro.Planet- , Data.Astro.Planet.PlanetDetails- , Data.Astro.Planet.PlanetMechanics- , Data.Astro.Moon- , Data.Astro.Moon.MoonDetails- other-modules: Data.Astro.Effects.Precession- , Data.Astro.Effects.Nutation- , Data.Astro.Effects.Aberration- build-depends: base >= 4.7 && < 5- , time- , matrix >= 0.3.4.4- 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-framework >= 0.8.1.1- , test-framework-hunit >= 0.3.0.2- , test-framework-quickcheck2 >= 0.3.0.3- , HUnit >= 1.3.1.1- , QuickCheck >= 2.8.2- ghc-options: -threaded -rtsopts -with-rtsopts=-N- default-language: Haskell2010--source-repository head- type: git- location: https://github.com/aligusnet/astro.git+name: astro +version: 0.4.3.0 +synopsis: Amateur astronomical computations +description: + Amateur astronomical computations: rise and set times and azimuths, + coordinates, distances, angular sizes and other parameters + of the Sun, the Moon, planets and stars. + +homepage: https://github.com/aligusnet/astro +license: BSD3 +license-file: LICENSE +author: Alexander Ignatyev +maintainer: Alexander Ignatyev +copyright: 2016-2021 Alexander Ignatyev +category: Science +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 +extra-source-files: README.md + +library + hs-source-dirs: src + exposed-modules: Data.Astro.Time + , Data.Astro.Time.GregorianCalendar + , Data.Astro.Time.JulianDate + , Data.Astro.Time.Sidereal + , Data.Astro.Time.Epoch + , Data.Astro.Time.Conv + , Data.Astro.Coordinate + , Data.Astro.Types + , Data.Astro.Utils + , Data.Astro.CelestialObject + , Data.Astro.CelestialObject.RiseSet + , Data.Astro.Effects + , Data.Astro.Effects.Parallax + , Data.Astro.Star + , Data.Astro.Sun + , Data.Astro.Sun.SunInternals + , Data.Astro.Planet + , Data.Astro.Planet.PlanetDetails + , Data.Astro.Planet.PlanetMechanics + , Data.Astro.Moon + , Data.Astro.Moon.MoonDetails + other-modules: Data.Astro.Effects.Precession + , Data.Astro.Effects.Nutation + , Data.Astro.Effects.Aberration + build-depends: base >= 4.7 && < 5 + , time + , matrix >= 0.3.4.4 + 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.EpochTest + , 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-framework >= 0.8.1.1 + , test-framework-hunit >= 0.3.0.2 + , test-framework-quickcheck2 >= 0.3.0.3 + , HUnit >= 1.3.1.1 + , QuickCheck >= 2.8.2 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/aligusnet/astro.git
src/Data/Astro/CelestialObject.hs view
@@ -1,42 +1,42 @@-{-|-Module: Data.Astro.CelestialObject-Description: Computations characteristics of selestial objects-Copyright: Alexander Ignatyev, 2016--Computations characteristics of selestial objects.--}--module Data.Astro.CelestialObject-(- angleEquatorial- , angleEcliptic-)--where--import Data.Astro.Types (DecimalDegrees, toRadians, fromRadians, fromDecimalHours)-import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..))----- | Calculate angle between two celestial objects--- whose coordinates specified in Equatorial Coordinate System.-angleEquatorial :: EquatorialCoordinates1 -> EquatorialCoordinates1 -> DecimalDegrees-angleEquatorial (EC1 delta1 alpha1) (EC1 delta2 alpha2) =- calcAngle (delta1, fromDecimalHours alpha1) (delta2, fromDecimalHours alpha2)----- | Calculate angle between two celestial objects--- whose coordinates specified in Ecliptic Coordinate System.-angleEcliptic :: EclipticCoordinates -> EclipticCoordinates -> DecimalDegrees-angleEcliptic (EcC beta1 lambda1) (EcC beta2 lambda2) =- calcAngle (beta1, lambda1) (beta2, lambda2)---calcAngle :: (DecimalDegrees, DecimalDegrees) -> (DecimalDegrees, DecimalDegrees) -> DecimalDegrees-calcAngle (up1, round1) (up2, round2) =- let up1' = toRadians up1- round1' = toRadians round1- up2' = toRadians up2- round2' = toRadians round2- d = acos $ (sin up1')*(sin up2') + (cos up1')*(cos up2')*cos(round1'-round2')- in fromRadians d+{-| +Module: Data.Astro.CelestialObject +Description: Computations characteristics of selestial objects +Copyright: Alexander Ignatyev, 2016 + +Computations characteristics of selestial objects. +-} + +module Data.Astro.CelestialObject +( + angleEquatorial + , angleEcliptic +) + +where + +import Data.Astro.Types (DecimalDegrees, toRadians, fromRadians, fromDecimalHours) +import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..)) + + +-- | Calculate angle between two celestial objects +-- whose coordinates specified in Equatorial Coordinate System. +angleEquatorial :: EquatorialCoordinates1 -> EquatorialCoordinates1 -> DecimalDegrees +angleEquatorial (EC1 delta1 alpha1) (EC1 delta2 alpha2) = + calcAngle (delta1, fromDecimalHours alpha1) (delta2, fromDecimalHours alpha2) + + +-- | Calculate angle between two celestial objects +-- whose coordinates specified in Ecliptic Coordinate System. +angleEcliptic :: EclipticCoordinates -> EclipticCoordinates -> DecimalDegrees +angleEcliptic (EcC beta1 lambda1) (EcC beta2 lambda2) = + calcAngle (beta1, lambda1) (beta2, lambda2) + + +calcAngle :: (DecimalDegrees, DecimalDegrees) -> (DecimalDegrees, DecimalDegrees) -> DecimalDegrees +calcAngle (up1, round1) (up2, round2) = + let up1' = toRadians up1 + round1' = toRadians round1 + up2' = toRadians up2 + round2' = toRadians round2 + d = acos $ (sin up1')*(sin up2') + (cos up1')*(cos up2')*cos(round1'-round2') + in fromRadians d
src/Data/Astro/CelestialObject/RiseSet.hs view
@@ -1,191 +1,191 @@-{-|-Module: Data.Astro.CelestialObject.RiseSet-Description: Computations rise and set of selestial objects-Copyright: Alexander Ignatyev, 2016--Computations rise and set of selestial objects.--= Examples--== /Stars/--See "Data.Astro.Star" module for example.--== /Planets/--See "Data.Astro.Planet" module for example.--}--module Data.Astro.CelestialObject.RiseSet-(- RiseSet(..)- , RSInfo(..)- , RiseSetLST(..)- , RiseSetLCT(..)- , RiseSetMB(..)- , riseAndSet- , riseAndSet2- , riseAndSetLCT- , toRiseSetLCT-)--where--import Data.Astro.Types (DecimalDegrees, DecimalHours(..)- , GeographicCoordinates(..)- , toRadians, fromRadians- , toDecimalHours)-import Data.Astro.Utils (reduceToZeroRange)-import Data.Astro.Time (lstToLCT)-import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), LocalCivilDate(..), addHours)-import Data.Astro.Time.Sidereal (LocalSiderealTime, dhToLST)-import Data.Astro.Coordinate (EquatorialCoordinates1(..))---- | Some Info of Rise and Set of a celestial object-data RiseSet a- -- | Some Info of Rise and Set of the celestial object- = RiseSet a a- -- | The celestial object is always above the horizon- | Circumpolar- -- | The celestial object is always below the horizon- | NeverRises- deriving (Show, Eq)----- | Rise or Set time and azimuth-type RSInfo a = (a, DecimalDegrees)----- | LST (Local Sidereal Time) and Azimuth of Rise and Set-type RiseSetLST = RiseSet (RSInfo LocalSiderealTime)----- | Local Civil Time and Azimuth of Rise and Set-type RiseSetLCT = RiseSet (RSInfo LocalCivilTime)----- | The optional Rise And optinal Set Information (LocalCivilTime and Azimuth)-type RiseSetMB = RiseSet (Maybe (RSInfo LocalCivilTime))----- | Calculate rise and set local sidereal time of a celestial object.--- It takes the equatorial coordinates of the celestial object,--- vertical shift and the latitude of the observation.--- To calculate /vertical shift/ for stars use function 'refract' from "Data.Astro.Effects".--- In most cases you can assume that /vertical shift/ equals 0.566569 (34 arcmins ~ 'refract (DD 0) 12 1012').-riseAndSet :: EquatorialCoordinates1 -> DecimalDegrees -> DecimalDegrees -> RiseSetLST-riseAndSet (EC1 delta alpha) shift lat =- let delta' = toRadians delta- shift' = toRadians shift- lat' = toRadians lat- cosH = cosOfHourAngle delta' shift' lat'- in sortRiseSet cosH delta' shift' lat'-- where sortRiseSet :: Double -> Double -> Double -> Double -> RiseSetLST- sortRiseSet cosH delta shift latitude- | cosH < -1 = Circumpolar- | cosH > 1 = NeverRises- | otherwise = calcTimesAndAzimuths alpha (toHours $ acos cosH) delta shift latitude-- toHours :: Double -> DecimalHours- toHours = toDecimalHours . fromRadians-- cosOfHourAngle :: Double -> Double -> Double -> Double- cosOfHourAngle delta shift latitude = -((sin shift) + (sin latitude)*(sin delta)) / ((cos latitude)*(cos delta))-- calcTimesAndAzimuths :: DecimalHours -> DecimalHours -> Double -> Double -> Double -> RiseSetLST- calcTimesAndAzimuths alpha hourAngle delta shift latitude =- let lstRise = dhToLST $ reduceToZeroRange 24 $ alpha - hourAngle- lstSet = dhToLST $ reduceToZeroRange 24 $ alpha + hourAngle- azimuthRise = reduceToZeroRange (2*pi) $ acos $ ((sin delta) + (sin shift)*(sin latitude)) / ((cos shift)*(cos latitude))- azimuthSet = 2*pi - azimuthRise- in RiseSet (lstRise, fromRadians azimuthRise) (lstSet, fromRadians azimuthSet)----- | Calculate rise and set local sidereal time of a celestial object--- that changes its equatorial coordinates during the day (the Sun, the Moon, planets).--- It takes epsilon, the function that returns equatorial coordinates of the celestial object for a given julian date,--- vertical shift and the latitude of the observation.--- To calculate /vertical shift/ for stars use function 'refract' from "Data.Astro.Effects".--- In most cases you can assume that /vertical shift/ equals 0.566569 (34 arcmins ~ 'refract (DD 0) 12 1012').-riseAndSet2 :: DecimalHours- -> (JulianDate -> EquatorialCoordinates1)- -> GeographicCoordinates- -> DecimalDegrees- -> LocalCivilDate- -> RiseSetMB-riseAndSet2 eps getPosition geoc shift lcd =- let day = lcdDate lcd- pos = getPosition (addHours 12 day)- rs = riseAndSetLCT geoc lcd shift pos- rise = calc getRiseTime (getRiseTime rs) 0- set = calc getSetTime (getSetTime rs) 0- in case rs of- Circumpolar -> Circumpolar- NeverRises -> NeverRises- _ -> buildResult rise set-- where calc :: (RiseSetLCT -> RSInfo LocalCivilTime) -> RSInfo LocalCivilTime -> Int -> RiseSetLCT- calc getRSInfo rsi@(time, _) iterNo =- let pos = getPosition $ lctUniversalTime time- rs = riseAndSetLCT geoc lcd shift pos- rsi' = getRSInfo rs- in case rs of- Circumpolar -> Circumpolar- NeverRises -> NeverRises- _ -> if isOK rsi rsi' || iterNo >= maxIters- then rs- else calc getRSInfo rsi' (iterNo+1)-- isOK :: RSInfo LocalCivilTime -> RSInfo LocalCivilTime -> Bool- isOK (t1, _) (t2, _) = (abs d) < (h/24)- where JD d = (lctUniversalTime t1) - (lctUniversalTime t2)- DH h = eps-- maxIters = 3-- getRiseTime :: RiseSetLCT -> RSInfo LocalCivilTime- getRiseTime (RiseSet r _) = r-- getSetTime :: RiseSetLCT -> RSInfo LocalCivilTime- getSetTime (RiseSet _ s) = s-- buildResult (RiseSet r _) (RiseSet _ s) = RiseSet (Just r) (Just s)- buildResult (RiseSet r _) _ = RiseSet (Just r) Nothing- buildResult _ (RiseSet _ s) = RiseSet Nothing (Just s)------ | Calculates set and rise of the celestial object--- It takes geographic coordinates of the observer, local civil date, vertical shift--- and equatorial coordinates of the celestial object.-riseAndSetLCT :: GeographicCoordinates- -> LocalCivilDate- -> DecimalDegrees- -> EquatorialCoordinates1- -> RiseSetLCT-riseAndSetLCT (GeoC latitude longitude) lcd shift ec- = toRiseSetLCT longitude lcd $ riseAndSet ec shift latitude----- | Converts Rise and Set in Local Sidereal Time to Rise and Set in Local Civil Time.--- It takes longutude of the observer and local civil date.--- To calculate /vertical shift/ for stars use function 'refract' from "Data.Astro.Effects".--- In most cases you can assume that /vertical shift/ equals 0.566569 (34 arcmins ~ 'refract (DD 0) 12 1012').-toRiseSetLCT :: DecimalDegrees- -> LocalCivilDate- -> RiseSetLST- -> RiseSetLCT-toRiseSetLCT longitude lcd (RiseSet (rise, azRise) (set, azSet)) =- let toLCT lst = lstToLCT longitude lcd lst- rise' = toLCT rise- set' = toLCT set- in RiseSet (rise', azRise) (set', azSet)-toRiseSetLCT _ _ Circumpolar = Circumpolar-toRiseSetLCT _ _ NeverRises = NeverRises----- | Convert LST in decimal hours to the JuliadDate--- the second parameter must be desired day at midnignt.-dhToJD :: DecimalHours -> JulianDate -> JulianDate-dhToJD (DH hours) day = day + (JD $ hours/24)+{-| +Module: Data.Astro.CelestialObject.RiseSet +Description: Computations rise and set of selestial objects +Copyright: Alexander Ignatyev, 2016 + +Computations rise and set of selestial objects. + += Examples + +== /Stars/ + +See "Data.Astro.Star" module for example. + +== /Planets/ + +See "Data.Astro.Planet" module for example. +-} + +module Data.Astro.CelestialObject.RiseSet +( + RiseSet(..) + , RSInfo(..) + , RiseSetLST(..) + , RiseSetLCT(..) + , RiseSetMB(..) + , riseAndSet + , riseAndSet2 + , riseAndSetLCT + , toRiseSetLCT +) + +where + +import Data.Astro.Types (DecimalDegrees, DecimalHours(..) + , GeographicCoordinates(..) + , toRadians, fromRadians + , toDecimalHours) +import Data.Astro.Utils (reduceToZeroRange) +import Data.Astro.Time (lstToLCT) +import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), LocalCivilDate(..), addHours) +import Data.Astro.Time.Sidereal (LocalSiderealTime, dhToLST) +import Data.Astro.Coordinate (EquatorialCoordinates1(..)) + +-- | Some Info of Rise and Set of a celestial object +data RiseSet a + -- | Some Info of Rise and Set of the celestial object + = RiseSet a a + -- | The celestial object is always above the horizon + | Circumpolar + -- | The celestial object is always below the horizon + | NeverRises + deriving (Show, Eq) + + +-- | Rise or Set time and azimuth +type RSInfo a = (a, DecimalDegrees) + + +-- | LST (Local Sidereal Time) and Azimuth of Rise and Set +type RiseSetLST = RiseSet (RSInfo LocalSiderealTime) + + +-- | Local Civil Time and Azimuth of Rise and Set +type RiseSetLCT = RiseSet (RSInfo LocalCivilTime) + + +-- | The optional Rise And optinal Set Information (LocalCivilTime and Azimuth) +type RiseSetMB = RiseSet (Maybe (RSInfo LocalCivilTime)) + + +-- | Calculate rise and set local sidereal time of a celestial object. +-- It takes the equatorial coordinates of the celestial object, +-- vertical shift and the latitude of the observation. +-- To calculate /vertical shift/ for stars use function 'refract' from "Data.Astro.Effects". +-- In most cases you can assume that /vertical shift/ equals 0.566569 (34 arcmins ~ 'refract (DD 0) 12 1012'). +riseAndSet :: EquatorialCoordinates1 -> DecimalDegrees -> DecimalDegrees -> RiseSetLST +riseAndSet (EC1 delta alpha) shift lat = + let delta' = toRadians delta + shift' = toRadians shift + lat' = toRadians lat + cosH = cosOfHourAngle delta' shift' lat' + in sortRiseSet cosH delta' shift' lat' + + where sortRiseSet :: Double -> Double -> Double -> Double -> RiseSetLST + sortRiseSet cosH delta shift latitude + | cosH < -1 = Circumpolar + | cosH > 1 = NeverRises + | otherwise = calcTimesAndAzimuths alpha (toHours $ acos cosH) delta shift latitude + + toHours :: Double -> DecimalHours + toHours = toDecimalHours . fromRadians + + cosOfHourAngle :: Double -> Double -> Double -> Double + cosOfHourAngle delta shift latitude = -((sin shift) + (sin latitude)*(sin delta)) / ((cos latitude)*(cos delta)) + + calcTimesAndAzimuths :: DecimalHours -> DecimalHours -> Double -> Double -> Double -> RiseSetLST + calcTimesAndAzimuths alpha hourAngle delta shift latitude = + let lstRise = dhToLST $ reduceToZeroRange 24 $ alpha - hourAngle + lstSet = dhToLST $ reduceToZeroRange 24 $ alpha + hourAngle + azimuthRise = reduceToZeroRange (2*pi) $ acos $ ((sin delta) + (sin shift)*(sin latitude)) / ((cos shift)*(cos latitude)) + azimuthSet = 2*pi - azimuthRise + in RiseSet (lstRise, fromRadians azimuthRise) (lstSet, fromRadians azimuthSet) + + +-- | Calculate rise and set local sidereal time of a celestial object +-- that changes its equatorial coordinates during the day (the Sun, the Moon, planets). +-- It takes epsilon, the function that returns equatorial coordinates of the celestial object for a given julian date, +-- vertical shift and the latitude of the observation. +-- To calculate /vertical shift/ for stars use function 'refract' from "Data.Astro.Effects". +-- In most cases you can assume that /vertical shift/ equals 0.566569 (34 arcmins ~ 'refract (DD 0) 12 1012'). +riseAndSet2 :: DecimalHours + -> (JulianDate -> EquatorialCoordinates1) + -> GeographicCoordinates + -> DecimalDegrees + -> LocalCivilDate + -> RiseSetMB +riseAndSet2 eps getPosition geoc shift lcd = + let day = lcdDate lcd + pos = getPosition (addHours 12 day) + rs = riseAndSetLCT geoc lcd shift pos + rise = calc getRiseTime (getRiseTime rs) 0 + set = calc getSetTime (getSetTime rs) 0 + in case rs of + Circumpolar -> Circumpolar + NeverRises -> NeverRises + _ -> buildResult rise set + + where calc :: (RiseSetLCT -> RSInfo LocalCivilTime) -> RSInfo LocalCivilTime -> Int -> RiseSetLCT + calc getRSInfo rsi@(time, _) iterNo = + let pos = getPosition $ lctUniversalTime time + rs = riseAndSetLCT geoc lcd shift pos + rsi' = getRSInfo rs + in case rs of + Circumpolar -> Circumpolar + NeverRises -> NeverRises + _ -> if isOK rsi rsi' || iterNo >= maxIters + then rs + else calc getRSInfo rsi' (iterNo+1) + + isOK :: RSInfo LocalCivilTime -> RSInfo LocalCivilTime -> Bool + isOK (t1, _) (t2, _) = (abs d) < (h/24) + where JD d = (lctUniversalTime t1) - (lctUniversalTime t2) + DH h = eps + + maxIters = 3 + + getRiseTime :: RiseSetLCT -> RSInfo LocalCivilTime + getRiseTime (RiseSet r _) = r + + getSetTime :: RiseSetLCT -> RSInfo LocalCivilTime + getSetTime (RiseSet _ s) = s + + buildResult (RiseSet r _) (RiseSet _ s) = RiseSet (Just r) (Just s) + buildResult (RiseSet r _) _ = RiseSet (Just r) Nothing + buildResult _ (RiseSet _ s) = RiseSet Nothing (Just s) + + + +-- | Calculates set and rise of the celestial object +-- It takes geographic coordinates of the observer, local civil date, vertical shift +-- and equatorial coordinates of the celestial object. +riseAndSetLCT :: GeographicCoordinates + -> LocalCivilDate + -> DecimalDegrees + -> EquatorialCoordinates1 + -> RiseSetLCT +riseAndSetLCT (GeoC latitude longitude) lcd shift ec + = toRiseSetLCT longitude lcd $ riseAndSet ec shift latitude + + +-- | Converts Rise and Set in Local Sidereal Time to Rise and Set in Local Civil Time. +-- It takes longutude of the observer and local civil date. +-- To calculate /vertical shift/ for stars use function 'refract' from "Data.Astro.Effects". +-- In most cases you can assume that /vertical shift/ equals 0.566569 (34 arcmins ~ 'refract (DD 0) 12 1012'). +toRiseSetLCT :: DecimalDegrees + -> LocalCivilDate + -> RiseSetLST + -> RiseSetLCT +toRiseSetLCT longitude lcd (RiseSet (rise, azRise) (set, azSet)) = + let toLCT lst = lstToLCT longitude lcd lst + rise' = toLCT rise + set' = toLCT set + in RiseSet (rise', azRise) (set', azSet) +toRiseSetLCT _ _ Circumpolar = Circumpolar +toRiseSetLCT _ _ NeverRises = NeverRises + + +-- | Convert LST in decimal hours to the JuliadDate +-- the second parameter must be desired day at midnignt. +dhToJD :: DecimalHours -> JulianDate -> JulianDate +dhToJD (DH hours) day = day + (JD $ hours/24)
src/Data/Astro/Coordinate.hs view
@@ -1,362 +1,362 @@-{-|-Module: Data.Astro.Coordinate-Description: Celestial Coordinate Systems-Copyright: Alexander Ignatyev, 2016--See "Data.Astro.Types" module for Georgraphic Coordinates.--= Celestial Coordinate Systems--== /Horizon coordinates/--* __altitude, α__ - /'how far up'/ angle from the horizontal plane in degrees-* __azimuth, Α__ - /'how far round'/ agle from the north direction in degrees to the east---== /Equatorial coordinates/--Accoring to the equatorial coordinates system stars move westwards along the circles centered in the north selestial pole,-making the full cicrle in 24 hours of sidereal time (see "Data.Astro.Time.Sidereal").--* __declination, δ__ - /'how far up'/ angle from the quatorial plane;-* __right ascension, α__ - /'how far round'/ angle from the /vernal equinox/ to the east; __/or/__-* __hour angle__ - /'how far round'/ angle from the meridian to the west---== /Ecliptic Coordinate/--Accoring to the ecliptic coordinates system the Sun moves eastwards along the trace of th ecliptic. The Sun's ecplitic latitude is always 0.--* __ecliptic latitude, β__ - /'how far up'/ angle from the ecliptic-* __ecliptic longitude, λ__ - /'how far round'/ angle from the /vernal equinox/ to the east---== /Galactic Coordinates/--* __galactic latitute, b__ - /'how far up'/ angle from the plane of the Galaxy-* __galactiv longitude, l__ - - /'how far round'/ angle from the direction the Sun - the centre of the Galaxy---== /Terms/--* __ecliptic__ - the plane containing the Earth's orbit around the Sun-* __vernal equinox__, ♈ - fixed direction lies along the line of the intersection of the equatorial plane and the ecliptic-* __obliquity of the ecliptic, β__ - the angle between the plane of the Earth's equator and the ecliptic-* __north selestial pole, P__ - the point on the selestial sphere, right above the Earth's North Pole---= Examples--== /Horizontal Coordinate System/-@-import Data.Astro.Coordinate-import Data.Astro.Types--hc :: HorizonCoordinates-hc = HC (DD 30.5) (DD 180)--- HC {hAltitude = DD 30.0, hAzimuth = DD 180.0}-@--== /Equatorial Coordinate System/-@-import Data.Astro.Coordinate-import Data.Astro.Types--ec1 :: EquatorialCoordinates1-ec1 = EC1 (DD 71.7) (DH 8)--- EC1 {e1Declination = DD 71.7, e1RightAscension = DH 8.0}--ec2 :: EquatorialCoordinates2-ec2 = EC1 (DD 77.7) (DH 11)--- EC2 {e2Declination = DD 77.7, e2HoursAngle = DH 11.0}-@--== /Transformations/-@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--sunHC :: HorizonCoordinates-sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53)--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}--sunEC2 :: EquatorialCoordinates2-sunEC2 = horizonToEquatorial (geoLatitude ro) sunHC--- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537}--sunEC1 :: EquatorialCoordinates1-sunEC1 = EC1 (e2Declination sunEC2) (haToRA (e2HoursAngle sunEC2) (geoLongitude ro) (lctUniversalTime dt))--- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224}---sunEC2' :: EquatorialCoordinates2-sunEC2' = EC2 (e1Declination sunEC1) (raToHA (e1RightAscension sunEC1) (geoLongitude ro) (lctUniversalTime dt))--- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537}--sunHC' :: HorizonCoordinates-sunHC' = equatorialToHorizon (geoLatitude ro) sunEC2'--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}-@--=== /Function-shortcuts/--@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--sunHC :: HorizonCoordinates-sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53)--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}--sunEC1 :: EquatorialCoordinates1-sunEC1 = hcToEC1 ro (lctUniversalTime dt) sunHC--- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224}--sunHC' :: HorizonCoordinates-sunHC' = ec1ToHC ro (lctUniversalTime dt) sunEC1--- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666}-@--}--module Data.Astro.Coordinate-(- DecimalDegrees(..)- , DecimalHours(..)- , HorizonCoordinates(..)- , EquatorialCoordinates1(..)- , EquatorialCoordinates2(..)- , EclipticCoordinates(..)- , GalacticCoordinates(..)- , raToHA- , haToRA- , equatorialToHorizon- , horizonToEquatorial- , ec1ToHC- , hcToEC1- , ecHCConv- , obliquity- , eclipticToEquatorial- , equatorialToEcliptic- , galacticToEquatorial- , equatorialToGalactic-)--where--import Data.Astro.Time (utToLST)-import Data.Astro.Time.JulianDate (JulianDate(..), numberOfCenturies, splitToDayAndTime)-import Data.Astro.Time.Epoch (j2000)-import Data.Astro.Time.Sidereal (LocalSiderealTime(..), lstToDH)-import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..)- , fromDecimalHours, toDecimalHours- , toRadians, fromRadians, fromDMS- , GeographicCoordinates(..))-import Data.Astro.Utils (fromFixed)-import Data.Astro.Effects.Nutation (nutationObliquity)----- | Horizon Coordinates, for details see the module's description-data HorizonCoordinates = HC {- hAltitude :: DecimalDegrees -- ^ alpha- , hAzimuth :: DecimalDegrees -- ^ big alpha- } deriving (Show, Eq)----- | Equatorial Coordinates, defines fixed position in the sky-data EquatorialCoordinates1 = EC1 {- e1Declination :: DecimalDegrees -- ^ delta- , e1RightAscension :: DecimalHours -- ^ alpha- } deriving (Show, Eq)----- | Equatorial Coordinates-data EquatorialCoordinates2 = EC2 {- e2Declination :: DecimalDegrees -- ^ delta- , e2HoursAngle :: DecimalHours -- ^ H- } deriving (Show, Eq)----- | Ecliptic Coordinates-data EclipticCoordinates = EcC {- ecLatitude :: DecimalDegrees -- ^ beta- , ecLongitude :: DecimalDegrees -- ^ lambda- } deriving (Show, Eq)----- | Galactic Coordinates-data GalacticCoordinates = GC {- gLatitude :: DecimalDegrees -- ^ b- , gLongitude :: DecimalDegrees -- ^ l- } deriving (Show, Eq)----- | Convert Right Ascension to Hour Angle for specified longitude and Universal Time-raToHA :: DecimalHours -> DecimalDegrees -> JulianDate -> DecimalHours-raToHA = haRAConv----- | Convert Hour Angle to Right Ascension for specified longitude and Universal Time-haToRA :: DecimalHours -> DecimalDegrees -> JulianDate -> DecimalHours-haToRA = haRAConv----- | HA <-> RA Conversions-haRAConv :: DecimalHours -> DecimalDegrees -> JulianDate -> DecimalHours-haRAConv dh longitude ut =- let lst = utToLST longitude ut -- Local Sidereal Time- DH hourAngle = (lstToDH lst) - dh- in if hourAngle < 0 then (DH $ hourAngle+24) else (DH hourAngle)----- | Convert Equatorial Coordinates to Horizon Coordinates.--- It takes a latitude of the observer and 'EquatorialCoordinates2'.--- If you need to convert 'EquatorialCoordinates1'--- you may use 'raToHa' function to obtain 'EquatorialCoordinates2'--- or just use function-shortcut 'ec1ToHC' straightaway.--- The functions returns 'HorizonCoordinates'.-equatorialToHorizon :: DecimalDegrees -> EquatorialCoordinates2 -> HorizonCoordinates-equatorialToHorizon latitude (EC2 dec hourAngle) =- let hourAngle' = fromDecimalHours hourAngle- (altitude, azimuth) = ecHCConv latitude (dec, hourAngle')- in HC altitude azimuth----- | Convert Horizon Coordinates to Equatorial Coordinates.--- It takes a latitude of the observer and 'HorizonCoordinates'.--- The functions returns 'EquatorialCoordinates2'.--- If you need to obtain 'EquatorialCoordinates1' you may use 'haToRa' function,--- or function-shortcut `hcToEC1`.-horizonToEquatorial :: DecimalDegrees -> HorizonCoordinates -> EquatorialCoordinates2-horizonToEquatorial latitude (HC altitude azimuth) =- let (dec, hourAngle) = ecHCConv latitude (altitude, azimuth)- in EC2 dec $ toDecimalHours hourAngle----- | Convert Equatorial Coordinates (Type 1) to Horizon Coordinates.--- This is function shortcut - tt combines `equatorialToHorizon` and `raToHA`.--- It takes geographic coordinates of the observer, universal time and equatorial coordinates.-ec1ToHC :: GeographicCoordinates -> JulianDate -> EquatorialCoordinates1 -> HorizonCoordinates-ec1ToHC (GeoC latitude longitude) jd (EC1 delta alpha) =- let ec2 = EC2 delta (raToHA alpha longitude jd)- in equatorialToHorizon latitude ec2----- | Convert Horizon Coordinates to Equatorial Coordinates (Type 1).--- This is function shortcut - tt combines `horizonToEquatorial` and `haToRA`.--- It takes geographic coordinates of the observer, universal time and horizon coordinates.-hcToEC1 :: GeographicCoordinates -> JulianDate -> HorizonCoordinates -> EquatorialCoordinates1-hcToEC1 (GeoC latitude longitude) jd hc =- let (EC2 dec hourAngle) = horizonToEquatorial latitude hc- in EC1 dec (haToRA hourAngle longitude jd)----- | Function converts Equatorial Coordinates To Horizon Coordinates and vice versa--- It takes a latitide of the observer as a first parameter and a pair of 'how far up' and 'how far round' coordinates--- as a second parameter. It returns a pair of 'how far up' and 'how far round' coordinates.-ecHCConv :: DecimalDegrees -> (DecimalDegrees, DecimalDegrees) -> (DecimalDegrees, DecimalDegrees)-ecHCConv latitude (up, round) =- let latitude' = toRadians latitude- up' = toRadians up- round' = toRadians round- sinUpResult = (sin up')*(sin latitude') + (cos up')*(cos latitude')*(cos round')- upResult = asin sinUpResult- roundResult = acos $ ((sin up') - (sin latitude')*sinUpResult) / ((cos latitude') * (cos upResult))- roundResult' = if (sin round') < 0 then roundResult else (2*pi - roundResult)- in ((fromRadians upResult), (fromRadians roundResult'))----- | Calculate the obliquity of the ecpliptic on JulianDate-obliquity :: JulianDate -> DecimalDegrees-obliquity jd =- let DD baseObliquity = fromDMS 23 26 21.45- t = numberOfCenturies j2000 jd- de = (46.815*t + 0.0006*t*t - 0.00181*t*t*t) / 3600 -- 3600 number of seconds in 1 degree- in (DD $ baseObliquity - de) + (nutationObliquity jd)----- | Converts Ecliptic Coordinates on specified Julian Date to Equatorial Coordinates-eclipticToEquatorial :: EclipticCoordinates -> JulianDate -> EquatorialCoordinates1-eclipticToEquatorial (EcC beta gamma) jd =- let epsilon' = toRadians $ obliquity jd- beta' = toRadians beta- gamma' = toRadians gamma- delta = asin $ (sin beta')*(cos epsilon') + (cos beta')*(sin epsilon')*(sin gamma')- y = (sin gamma')*(cos epsilon') - (tan beta')*(sin epsilon')- x = cos gamma'- alpha = reduceToZero2PI $ atan2 y x- in EC1 (fromRadians delta) (toDecimalHours $ fromRadians alpha)----- | Converts Equatorial Coordinates to Ecliptic Coordinates on specified Julian Date-equatorialToEcliptic :: EquatorialCoordinates1 -> JulianDate -> EclipticCoordinates-equatorialToEcliptic (EC1 delta alpha) jd =- let epsilon' = toRadians $ obliquity jd- delta' = toRadians delta- alpha' = toRadians $ fromDecimalHours alpha- beta = asin $ (sin delta')*(cos epsilon') - (cos delta')*(sin epsilon')*(sin alpha')- y = (sin alpha')*(cos epsilon') + (tan delta')*(sin epsilon')- x = cos alpha'- gamma = reduceToZero2PI $ atan2 y x- in EcC (fromRadians beta) (fromRadians gamma)----- | Galactic Pole Coordinates-galacticPole :: EquatorialCoordinates1-galacticPole = EC1 (DD 27.4) (toDecimalHours $ DD 192.25)--galacticPoleInRadians = (delta, alpha)- where delta = toRadians $ e1Declination galacticPole- alpha = toRadians $ fromDecimalHours $ e1RightAscension galacticPole----- | Ascending node of the galactic place on equator-ascendingNode :: DecimalDegrees-ascendingNode = DD 33----- | Convert Galactic Coordinates Equatorial Coordinates-galacticToEquatorial :: GalacticCoordinates -> EquatorialCoordinates1-galacticToEquatorial (GC b l) =- let b' = toRadians b- l' = toRadians l- (poleDelta, poleAlpha) = galacticPoleInRadians- an = toRadians ascendingNode- delta = asin $ (cos b')*(cos poleDelta)*(sin (l'-an)) + (sin b')*(sin poleDelta)- y = (cos b')*(cos (l'-an))- x = (sin b')*(cos poleDelta) - (cos b')*(sin poleDelta)*(sin (l'-an))- alpha = reduceToZero2PI $ (atan2 y x) + poleAlpha- in EC1 (fromRadians delta) (toDecimalHours $ fromRadians alpha)----- | Convert Equatorial Coordinates to Galactic Coordinates-equatorialToGalactic :: EquatorialCoordinates1 -> GalacticCoordinates-equatorialToGalactic (EC1 delta alpha) =- let delta' = toRadians delta- alpha' = toRadians $ fromDecimalHours alpha- (poleDelta, poleAlpha) = galacticPoleInRadians- sinb = (cos delta')*(cos poleDelta)*(cos (alpha'-poleAlpha)) + (sin delta') * (sin poleDelta)- y = (sin delta') - sinb*(sin poleDelta)- x = (cos delta')*(sin (alpha'-poleAlpha))*(cos poleDelta)- b = asin sinb- l = reduceToZero2PI $ (atan2 y x) + (toRadians ascendingNode)- in GC (fromRadians b) (fromRadians l)----- | Reduce angle from [-pi, pi] to [0, 2*pi]--- Usefull to correct results of atan2 for 'how far round' coordinates-reduceToZero2PI :: (Floating a, Ord a) => a -> a-reduceToZero2PI rad = if rad < 0 then rad + 2*pi else rad+{-| +Module: Data.Astro.Coordinate +Description: Celestial Coordinate Systems +Copyright: Alexander Ignatyev, 2016 + +See "Data.Astro.Types" module for Georgraphic Coordinates. + += Celestial Coordinate Systems + +== /Horizon coordinates/ + +* __altitude, α__ - /'how far up'/ angle from the horizontal plane in degrees +* __azimuth, Α__ - /'how far round'/ agle from the north direction in degrees to the east + + +== /Equatorial coordinates/ + +Accoring to the equatorial coordinates system stars move westwards along the circles centered in the north selestial pole, +making the full cicrle in 24 hours of sidereal time (see "Data.Astro.Time.Sidereal"). + +* __declination, δ__ - /'how far up'/ angle from the quatorial plane; +* __right ascension, α__ - /'how far round'/ angle from the /vernal equinox/ to the east; __/or/__ +* __hour angle__ - /'how far round'/ angle from the meridian to the west + + +== /Ecliptic Coordinate/ + +Accoring to the ecliptic coordinates system the Sun moves eastwards along the trace of th ecliptic. The Sun's ecplitic latitude is always 0. + +* __ecliptic latitude, β__ - /'how far up'/ angle from the ecliptic +* __ecliptic longitude, λ__ - /'how far round'/ angle from the /vernal equinox/ to the east + + +== /Galactic Coordinates/ + +* __galactic latitute, b__ - /'how far up'/ angle from the plane of the Galaxy +* __galactiv longitude, l__ - - /'how far round'/ angle from the direction the Sun - the centre of the Galaxy + + +== /Terms/ + +* __ecliptic__ - the plane containing the Earth's orbit around the Sun +* __vernal equinox__, ♈ - fixed direction lies along the line of the intersection of the equatorial plane and the ecliptic +* __obliquity of the ecliptic, β__ - the angle between the plane of the Earth's equator and the ecliptic +* __north selestial pole, P__ - the point on the selestial sphere, right above the Earth's North Pole + + += Examples + +== /Horizontal Coordinate System/ +@ +import Data.Astro.Coordinate +import Data.Astro.Types + +hc :: HorizonCoordinates +hc = HC (DD 30.5) (DD 180) +-- HC {hAltitude = DD 30.0, hAzimuth = DD 180.0} +@ + +== /Equatorial Coordinate System/ +@ +import Data.Astro.Coordinate +import Data.Astro.Types + +ec1 :: EquatorialCoordinates1 +ec1 = EC1 (DD 71.7) (DH 8) +-- EC1 {e1Declination = DD 71.7, e1RightAscension = DH 8.0} + +ec2 :: EquatorialCoordinates2 +ec2 = EC1 (DD 77.7) (DH 11) +-- EC2 {e2Declination = DD 77.7, e2HoursAngle = DH 11.0} +@ + +== /Transformations/ +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +sunHC :: HorizonCoordinates +sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53) +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} + +sunEC2 :: EquatorialCoordinates2 +sunEC2 = horizonToEquatorial (geoLatitude ro) sunHC +-- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537} + +sunEC1 :: EquatorialCoordinates1 +sunEC1 = EC1 (e2Declination sunEC2) (haToRA (e2HoursAngle sunEC2) (geoLongitude ro) (lctUniversalTime dt)) +-- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224} + + +sunEC2' :: EquatorialCoordinates2 +sunEC2' = EC2 (e1Declination sunEC1) (raToHA (e1RightAscension sunEC1) (geoLongitude ro) (lctUniversalTime dt)) +-- EC2 {e2Declination = DD 23.378295912623855, e2HoursAngle = DH 21.437117068873537} + +sunHC' :: HorizonCoordinates +sunHC' = equatorialToHorizon (geoLatitude ro) sunEC2' +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} +@ + +=== /Function-shortcuts/ + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +sunHC :: HorizonCoordinates +sunHC = HC (fromDMS 49 18 21.77) (fromDMS 118 55 19.53) +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} + +sunEC1 :: EquatorialCoordinates1 +sunEC1 = hcToEC1 ro (lctUniversalTime dt) sunHC +-- EC1 {e1Declination = DD 23.378295912623855, e1RightAscension = DH 6.29383725890224} + +sunHC' :: HorizonCoordinates +sunHC' = ec1ToHC ro (lctUniversalTime dt) sunEC1 +-- HC {hAltitude = DD 49.30604722222222, hAzimuth = DD 118.92209166666666} +@ +-} + +module Data.Astro.Coordinate +( + DecimalDegrees(..) + , DecimalHours(..) + , HorizonCoordinates(..) + , EquatorialCoordinates1(..) + , EquatorialCoordinates2(..) + , EclipticCoordinates(..) + , GalacticCoordinates(..) + , raToHA + , haToRA + , equatorialToHorizon + , horizonToEquatorial + , ec1ToHC + , hcToEC1 + , ecHCConv + , obliquity + , eclipticToEquatorial + , equatorialToEcliptic + , galacticToEquatorial + , equatorialToGalactic +) + +where + +import Data.Astro.Time (utToLST) +import Data.Astro.Time.JulianDate (JulianDate(..), numberOfCenturies, splitToDayAndTime) +import Data.Astro.Time.Epoch (j2000) +import Data.Astro.Time.Sidereal (LocalSiderealTime(..), lstToDH) +import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..) + , fromDecimalHours, toDecimalHours + , toRadians, fromRadians, fromDMS + , GeographicCoordinates(..)) +import Data.Astro.Utils (fromFixed) +import Data.Astro.Effects.Nutation (nutationObliquity) + + +-- | Horizon Coordinates, for details see the module's description +data HorizonCoordinates = HC { + hAltitude :: DecimalDegrees -- ^ alpha + , hAzimuth :: DecimalDegrees -- ^ big alpha + } deriving (Show, Eq) + + +-- | Equatorial Coordinates, defines fixed position in the sky +data EquatorialCoordinates1 = EC1 { + e1Declination :: DecimalDegrees -- ^ delta + , e1RightAscension :: DecimalHours -- ^ alpha + } deriving (Show, Eq) + + +-- | Equatorial Coordinates +data EquatorialCoordinates2 = EC2 { + e2Declination :: DecimalDegrees -- ^ delta + , e2HoursAngle :: DecimalHours -- ^ H + } deriving (Show, Eq) + + +-- | Ecliptic Coordinates +data EclipticCoordinates = EcC { + ecLatitude :: DecimalDegrees -- ^ beta + , ecLongitude :: DecimalDegrees -- ^ lambda + } deriving (Show, Eq) + + +-- | Galactic Coordinates +data GalacticCoordinates = GC { + gLatitude :: DecimalDegrees -- ^ b + , gLongitude :: DecimalDegrees -- ^ l + } deriving (Show, Eq) + + +-- | Convert Right Ascension to Hour Angle for specified longitude and Universal Time +raToHA :: DecimalHours -> DecimalDegrees -> JulianDate -> DecimalHours +raToHA = haRAConv + + +-- | Convert Hour Angle to Right Ascension for specified longitude and Universal Time +haToRA :: DecimalHours -> DecimalDegrees -> JulianDate -> DecimalHours +haToRA = haRAConv + + +-- | HA <-> RA Conversions +haRAConv :: DecimalHours -> DecimalDegrees -> JulianDate -> DecimalHours +haRAConv dh longitude ut = + let lst = utToLST longitude ut -- Local Sidereal Time + DH hourAngle = (lstToDH lst) - dh + in if hourAngle < 0 then (DH $ hourAngle+24) else (DH hourAngle) + + +-- | Convert Equatorial Coordinates to Horizon Coordinates. +-- It takes a latitude of the observer and 'EquatorialCoordinates2'. +-- If you need to convert 'EquatorialCoordinates1' +-- you may use 'raToHa' function to obtain 'EquatorialCoordinates2' +-- or just use function-shortcut 'ec1ToHC' straightaway. +-- The functions returns 'HorizonCoordinates'. +equatorialToHorizon :: DecimalDegrees -> EquatorialCoordinates2 -> HorizonCoordinates +equatorialToHorizon latitude (EC2 dec hourAngle) = + let hourAngle' = fromDecimalHours hourAngle + (altitude, azimuth) = ecHCConv latitude (dec, hourAngle') + in HC altitude azimuth + + +-- | Convert Horizon Coordinates to Equatorial Coordinates. +-- It takes a latitude of the observer and 'HorizonCoordinates'. +-- The functions returns 'EquatorialCoordinates2'. +-- If you need to obtain 'EquatorialCoordinates1' you may use 'haToRa' function, +-- or function-shortcut `hcToEC1`. +horizonToEquatorial :: DecimalDegrees -> HorizonCoordinates -> EquatorialCoordinates2 +horizonToEquatorial latitude (HC altitude azimuth) = + let (dec, hourAngle) = ecHCConv latitude (altitude, azimuth) + in EC2 dec $ toDecimalHours hourAngle + + +-- | Convert Equatorial Coordinates (Type 1) to Horizon Coordinates. +-- This is function shortcut - tt combines `equatorialToHorizon` and `raToHA`. +-- It takes geographic coordinates of the observer, universal time and equatorial coordinates. +ec1ToHC :: GeographicCoordinates -> JulianDate -> EquatorialCoordinates1 -> HorizonCoordinates +ec1ToHC (GeoC latitude longitude) jd (EC1 delta alpha) = + let ec2 = EC2 delta (raToHA alpha longitude jd) + in equatorialToHorizon latitude ec2 + + +-- | Convert Horizon Coordinates to Equatorial Coordinates (Type 1). +-- This is function shortcut - tt combines `horizonToEquatorial` and `haToRA`. +-- It takes geographic coordinates of the observer, universal time and horizon coordinates. +hcToEC1 :: GeographicCoordinates -> JulianDate -> HorizonCoordinates -> EquatorialCoordinates1 +hcToEC1 (GeoC latitude longitude) jd hc = + let (EC2 dec hourAngle) = horizonToEquatorial latitude hc + in EC1 dec (haToRA hourAngle longitude jd) + + +-- | Function converts Equatorial Coordinates To Horizon Coordinates and vice versa +-- It takes a latitide of the observer as a first parameter and a pair of 'how far up' and 'how far round' coordinates +-- as a second parameter. It returns a pair of 'how far up' and 'how far round' coordinates. +ecHCConv :: DecimalDegrees -> (DecimalDegrees, DecimalDegrees) -> (DecimalDegrees, DecimalDegrees) +ecHCConv latitude (up, round) = + let latitude' = toRadians latitude + up' = toRadians up + round' = toRadians round + sinUpResult = (sin up')*(sin latitude') + (cos up')*(cos latitude')*(cos round') + upResult = asin sinUpResult + roundResult = acos $ ((sin up') - (sin latitude')*sinUpResult) / ((cos latitude') * (cos upResult)) + roundResult' = if (sin round') < 0 then roundResult else (2*pi - roundResult) + in ((fromRadians upResult), (fromRadians roundResult')) + + +-- | Calculate the obliquity of the ecpliptic on JulianDate +obliquity :: JulianDate -> DecimalDegrees +obliquity jd = + let DD baseObliquity = fromDMS 23 26 21.45 + t = numberOfCenturies j2000 jd + de = (46.815*t + 0.0006*t*t - 0.00181*t*t*t) / 3600 -- 3600 number of seconds in 1 degree + in (DD $ baseObliquity - de) + (nutationObliquity jd) + + +-- | Converts Ecliptic Coordinates on specified Julian Date to Equatorial Coordinates +eclipticToEquatorial :: EclipticCoordinates -> JulianDate -> EquatorialCoordinates1 +eclipticToEquatorial (EcC beta gamma) jd = + let epsilon' = toRadians $ obliquity jd + beta' = toRadians beta + gamma' = toRadians gamma + delta = asin $ (sin beta')*(cos epsilon') + (cos beta')*(sin epsilon')*(sin gamma') + y = (sin gamma')*(cos epsilon') - (tan beta')*(sin epsilon') + x = cos gamma' + alpha = reduceToZero2PI $ atan2 y x + in EC1 (fromRadians delta) (toDecimalHours $ fromRadians alpha) + + +-- | Converts Equatorial Coordinates to Ecliptic Coordinates on specified Julian Date +equatorialToEcliptic :: EquatorialCoordinates1 -> JulianDate -> EclipticCoordinates +equatorialToEcliptic (EC1 delta alpha) jd = + let epsilon' = toRadians $ obliquity jd + delta' = toRadians delta + alpha' = toRadians $ fromDecimalHours alpha + beta = asin $ (sin delta')*(cos epsilon') - (cos delta')*(sin epsilon')*(sin alpha') + y = (sin alpha')*(cos epsilon') + (tan delta')*(sin epsilon') + x = cos alpha' + gamma = reduceToZero2PI $ atan2 y x + in EcC (fromRadians beta) (fromRadians gamma) + + +-- | Galactic Pole Coordinates +galacticPole :: EquatorialCoordinates1 +galacticPole = EC1 (DD 27.4) (toDecimalHours $ DD 192.25) + +galacticPoleInRadians = (delta, alpha) + where delta = toRadians $ e1Declination galacticPole + alpha = toRadians $ fromDecimalHours $ e1RightAscension galacticPole + + +-- | Ascending node of the galactic place on equator +ascendingNode :: DecimalDegrees +ascendingNode = DD 33 + + +-- | Convert Galactic Coordinates Equatorial Coordinates +galacticToEquatorial :: GalacticCoordinates -> EquatorialCoordinates1 +galacticToEquatorial (GC b l) = + let b' = toRadians b + l' = toRadians l + (poleDelta, poleAlpha) = galacticPoleInRadians + an = toRadians ascendingNode + delta = asin $ (cos b')*(cos poleDelta)*(sin (l'-an)) + (sin b')*(sin poleDelta) + y = (cos b')*(cos (l'-an)) + x = (sin b')*(cos poleDelta) - (cos b')*(sin poleDelta)*(sin (l'-an)) + alpha = reduceToZero2PI $ (atan2 y x) + poleAlpha + in EC1 (fromRadians delta) (toDecimalHours $ fromRadians alpha) + + +-- | Convert Equatorial Coordinates to Galactic Coordinates +equatorialToGalactic :: EquatorialCoordinates1 -> GalacticCoordinates +equatorialToGalactic (EC1 delta alpha) = + let delta' = toRadians delta + alpha' = toRadians $ fromDecimalHours alpha + (poleDelta, poleAlpha) = galacticPoleInRadians + sinb = (cos delta')*(cos poleDelta)*(cos (alpha'-poleAlpha)) + (sin delta') * (sin poleDelta) + y = (sin delta') - sinb*(sin poleDelta) + x = (cos delta')*(sin (alpha'-poleAlpha))*(cos poleDelta) + b = asin sinb + l = reduceToZero2PI $ (atan2 y x) + (toRadians ascendingNode) + in GC (fromRadians b) (fromRadians l) + + +-- | Reduce angle from [-pi, pi] to [0, 2*pi] +-- Usefull to correct results of atan2 for 'how far round' coordinates +reduceToZero2PI :: (Floating a, Ord a) => a -> a +reduceToZero2PI rad = if rad < 0 then rad + 2*pi else rad
src/Data/Astro/Effects.hs view
@@ -1,50 +1,50 @@-{-|-Module: Data.Astro.Effects-Description: Physical effects-Copyright: Alexander Ignatyev, 2016--Physical effects which influence on accuracy of astronomical calculations.--}--module Data.Astro.Effects-(- refract- , Precession.AstronomyEpoch(..)- , Precession.precession1- , Precession.precession2- , Nutation.nutationLongitude- , Nutation.nutationObliquity- , Aberration.includeAberration- , Parallax.parallax-)--where--import Data.Astro.Types (DecimalDegrees(..), toRadians)--import qualified Data.Astro.Effects.Precession as Precession-import qualified Data.Astro.Effects.Nutation as Nutation-import qualified Data.Astro.Effects.Aberration as Aberration-import qualified Data.Astro.Effects.Parallax as Parallax---- | Calculate the atmospheric refraction angle.--- It takes the observed altitude (of Horizon Coordinates), temperature in degrees centigrade and barometric pressure in millibars.--- The average sea level atmospheric pressure is 1013 millibars.-refract :: DecimalDegrees -> Double -> Double -> DecimalDegrees-refract altitude temperature pressure =- let f = if altitude > (DD 15) then refractBigAlpha else refractSmallAlpha- in f altitude temperature pressure----- | Calculate the atmospheric refraction angle for big values of alpha (altitude) (> 15 decimal degrees)-refractBigAlpha :: DecimalDegrees -> Double -> Double -> DecimalDegrees-refractBigAlpha altitude temperature pressure =- let z = toRadians $ 90 - altitude -- zenith angle- in DD $ 0.00452*pressure*(tan z) /(273+temperature) ----- | Calculate the atmospheric refraction angle for small values of alpha (altitude)-refractSmallAlpha :: DecimalDegrees -> Double -> Double -> DecimalDegrees-refractSmallAlpha altitude temperature pressure =- let a = toRadians altitude- in DD $ pressure*(0.1594+0.0196*a+0.00002*a*a)/((273+temperature)*(1+0.505*a+0.0845*a*a))+{-| +Module: Data.Astro.Effects +Description: Physical effects +Copyright: Alexander Ignatyev, 2016 + +Physical effects which influence on accuracy of astronomical calculations. +-} + +module Data.Astro.Effects +( + refract + , Precession.AstronomyEpoch(..) + , Precession.precession1 + , Precession.precession2 + , Nutation.nutationLongitude + , Nutation.nutationObliquity + , Aberration.includeAberration + , Parallax.parallax +) + +where + +import Data.Astro.Types (DecimalDegrees(..), toRadians) + +import qualified Data.Astro.Effects.Precession as Precession +import qualified Data.Astro.Effects.Nutation as Nutation +import qualified Data.Astro.Effects.Aberration as Aberration +import qualified Data.Astro.Effects.Parallax as Parallax + +-- | Calculate the atmospheric refraction angle. +-- It takes the observed altitude (of Horizon Coordinates), temperature in degrees centigrade and barometric pressure in millibars. +-- The average sea level atmospheric pressure is 1013 millibars. +refract :: DecimalDegrees -> Double -> Double -> DecimalDegrees +refract altitude temperature pressure = + let f = if altitude > (DD 15) then refractBigAlpha else refractSmallAlpha + in f altitude temperature pressure + + +-- | Calculate the atmospheric refraction angle for big values of alpha (altitude) (> 15 decimal degrees) +refractBigAlpha :: DecimalDegrees -> Double -> Double -> DecimalDegrees +refractBigAlpha altitude temperature pressure = + let z = toRadians $ 90 - altitude -- zenith angle + in DD $ 0.00452*pressure*(tan z) /(273+temperature) + + +-- | Calculate the atmospheric refraction angle for small values of alpha (altitude) +refractSmallAlpha :: DecimalDegrees -> Double -> Double -> DecimalDegrees +refractSmallAlpha altitude temperature pressure = + let a = toRadians altitude + in DD $ pressure*(0.1594+0.0196*a+0.00002*a*a)/((273+temperature)*(1+0.505*a+0.0845*a*a))
src/Data/Astro/Effects/Aberration.hs view
@@ -1,32 +1,32 @@-{-|-Module: Data.Astro.Effects.Aberration-Description: Calculation effects of aberration.-Copyright: Alexander Ignatyev, 2016--Calculation effects of aberration.--}--module Data.Astro.Effects.Aberration-(- includeAberration-)--where--import Data.Astro.Types (DecimalDegrees, toRadians, fromDMS)-import Data.Astro.Time.JulianDate (JulianDate)-import Data.Astro.Coordinate (EclipticCoordinates(..))----- | Includes aberration effect.--- It takes true Ecliptic Coordinates,--- the Sun's longitude at the given Julian Day (the third parameter).--- Returns apparent ecliptic coordinates.--- The Sun's longitude can be calculated using 'sunEclipticLongitude1' or 'sunEclipticLongitude2' of "Data.Astro.Sun" module.-includeAberration :: EclipticCoordinates -> JulianDate -> DecimalDegrees -> EclipticCoordinates-includeAberration (EcC beta lambda) jd sunLambda =- let lambdaDiff = toRadians $ sunLambda - lambda- beta' = toRadians beta- dLambda = -20.5 * (cos lambdaDiff) / (cos beta')- dBeta = -20.5 * (sin lambdaDiff) * (sin beta')- in EcC (beta + fromDMS 0 0 dBeta) (lambda + fromDMS 0 0 dLambda)+{-| +Module: Data.Astro.Effects.Aberration +Description: Calculation effects of aberration. +Copyright: Alexander Ignatyev, 2016 + +Calculation effects of aberration. +-} + +module Data.Astro.Effects.Aberration +( + includeAberration +) + +where + +import Data.Astro.Types (DecimalDegrees, toRadians, fromDMS) +import Data.Astro.Time.JulianDate (JulianDate) +import Data.Astro.Coordinate (EclipticCoordinates(..)) + + +-- | Includes aberration effect. +-- It takes true Ecliptic Coordinates, +-- the Sun's longitude at the given Julian Day (the third parameter). +-- Returns apparent ecliptic coordinates. +-- The Sun's longitude can be calculated using 'sunEclipticLongitude1' or 'sunEclipticLongitude2' of "Data.Astro.Sun" module. +includeAberration :: EclipticCoordinates -> JulianDate -> DecimalDegrees -> EclipticCoordinates +includeAberration (EcC beta lambda) jd sunLambda = + let lambdaDiff = toRadians $ sunLambda - lambda + beta' = toRadians beta + dLambda = -20.5 * (cos lambdaDiff) / (cos beta') + dBeta = -20.5 * (sin lambdaDiff) * (sin beta') + in EcC (beta + fromDMS 0 0 dBeta) (lambda + fromDMS 0 0 dLambda)
src/Data/Astro/Effects/Nutation.hs view
@@ -1,59 +1,59 @@-{-|-Module: Data.Astro.Effects.Nutation-Description: Calculation effects of nutation-Copyright: Alexander Ignatyev, 2016--Calculation effects of nutation.--}--module Data.Astro.Effects.Nutation-(- nutationLongitude- , nutationObliquity-)--where--import qualified Data.Astro.Utils as U-import Data.Astro.Types (DecimalDegrees(..), toRadians, fromDMS)-import Data.Astro.Time.JulianDate (JulianDate, numberOfCenturies)-import Data.Astro.Time.Epoch (j1900)----- | Calculates the nutation on the ecliptic longitude at the given JulianDate-nutationLongitude :: JulianDate -> DecimalDegrees-nutationLongitude jd =- let t = numberOfCenturies j1900 jd- l = sunMeanLongutude t- omega = moonNode t- dPsi = -17.2*(sin omega) - 1.3*(sin $ 2*l)- in fromDMS 0 0 dPsi----- | Calculates the nutation on the obliquity of the ecliptic at the given JulianDate-nutationObliquity :: JulianDate -> DecimalDegrees-nutationObliquity jd =- let t = numberOfCenturies j1900 jd- l = sunMeanLongutude t- omega = moonNode t- dEps = 9.2*(cos omega) + 0.5*(cos $ 2*l)- in fromDMS 0 0 dEps----- | It takes a number of centuries and returns the Sun's mean longitude in radians-sunMeanLongutude :: Double -> Double-sunMeanLongutude t =- let a = 100.002136 * t- in U.toRadians $ U.reduceToZeroRange 360 $ 279.6967 + 360 * (a - int a)----- | It takes a number of centuries and returns the Moon's node in radians-moonNode :: Double -> Double-moonNode t =- let b = 5.372617 * t- in U.toRadians $ U.reduceToZeroRange 360 $ 259.1833 - 360*(b - int b)----- | 'round' function that returns Double-int :: Double -> Double-int = fromIntegral . round+{-| +Module: Data.Astro.Effects.Nutation +Description: Calculation effects of nutation +Copyright: Alexander Ignatyev, 2016 + +Calculation effects of nutation. +-} + +module Data.Astro.Effects.Nutation +( + nutationLongitude + , nutationObliquity +) + +where + +import qualified Data.Astro.Utils as U +import Data.Astro.Types (DecimalDegrees(..), toRadians, fromDMS) +import Data.Astro.Time.JulianDate (JulianDate, numberOfCenturies) +import Data.Astro.Time.Epoch (j1900) + + +-- | Calculates the nutation on the ecliptic longitude at the given JulianDate +nutationLongitude :: JulianDate -> DecimalDegrees +nutationLongitude jd = + let t = numberOfCenturies j1900 jd + l = sunMeanLongutude t + omega = moonNode t + dPsi = -17.2*(sin omega) - 1.3*(sin $ 2*l) + in fromDMS 0 0 dPsi + + +-- | Calculates the nutation on the obliquity of the ecliptic at the given JulianDate +nutationObliquity :: JulianDate -> DecimalDegrees +nutationObliquity jd = + let t = numberOfCenturies j1900 jd + l = sunMeanLongutude t + omega = moonNode t + dEps = 9.2*(cos omega) + 0.5*(cos $ 2*l) + in fromDMS 0 0 dEps + + +-- | It takes a number of centuries and returns the Sun's mean longitude in radians +sunMeanLongutude :: Double -> Double +sunMeanLongutude t = + let a = 100.002136 * t + in U.toRadians $ U.reduceToZeroRange 360 $ 279.6967 + 360 * (a - int a) + + +-- | It takes a number of centuries and returns the Moon's node in radians +moonNode :: Double -> Double +moonNode t = + let b = 5.372617 * t + in U.toRadians $ U.reduceToZeroRange 360 $ 259.1833 - 360*(b - int b) + + +-- | 'round' function that returns Double +int :: Double -> Double +int = fromIntegral . round
src/Data/Astro/Effects/Parallax.hs view
@@ -1,70 +1,70 @@-{-|-Module: Data.Astro.Effects.Parallax-Description: Calculation effects of geocentric parallax-Copyright: Alexander Ignatyev, 2016---Calculation effects of geocentric parallax.--}--module Data.Astro.Effects.Parallax-(- parallaxQuantities- , parallax-)--where--import Data.Astro.Types (DecimalDegrees(..)- , DecimalHours(..)- , AstronomicalUnits(..)- , GeographicCoordinates(..)- , toRadians, fromRadians- , fromDMS- , toDecimalHours, fromDecimalHours)-import Data.Astro.Time (utToLST)-import Data.Astro.Time.JulianDate (JulianDate(..))-import Data.Astro.Time.Sidereal (LocalSiderealTime(..), utToGST, gstToLST)-import Data.Astro.Coordinate (EquatorialCoordinates1(..), raToHA)----- | It takes latitude of the observer--- and height above sea-level of the observer measured in metres--- Returns palallax quantities (p*(sin phi'), p*(cos phi')),--- where phi' is the geocentric latitude--- and p is the distance of the obserbve from the centre of the Earth.-parallaxQuantities :: DecimalDegrees -> Double -> (Double, Double)-parallaxQuantities latitude height =- let c = 0.996647- phi = toRadians latitude- h = earthRadiusUnits height- u = atan (c*(tan phi))- pSin = c * (sin u) + h*(sin phi)- pCos = (cos u) + h*(cos phi)- in (pSin, pCos)----- | Calculate the apparent position of the celestial object (the Sun or a planet).--- It takes geocraphic coordinates of the observer and height above sea-level of the observer measured in metres,--- distance from the celestial object to the Earth measured in AU, the Universal Time and geocentric equatorial coordinates.--- It returns adjusted equatorial coordinates.-parallax :: GeographicCoordinates -> Double -> AstronomicalUnits -> JulianDate -> EquatorialCoordinates1 -> EquatorialCoordinates1-parallax (GeoC latitude longitude) height distance ut (EC1 delta alpha) =- let piD = earthRadiusUnitsAU distance- lst = utToLST longitude ut- (pSin, pCos) = parallaxQuantities latitude height- ha = toRadians $ fromDecimalHours $ raToHA alpha longitude ut- delta' = toRadians delta- dAlpha = (toDecimalHours piD) * (DH $ (sin ha)*pCos/(cos delta'))- dDelta = piD * (DD $ pSin*(cos delta') - pCos*(cos ha)*(sin delta'))- in EC1 (delta-dDelta) (alpha-dAlpha)----- | It takes the distance in metres and--- returns the distance measured in units of qquatorial Earth radius-earthRadiusUnits :: Double -> Double-earthRadiusUnits d = d / 6378140-----earthRadiusUnitsAU :: AstronomicalUnits -> DecimalDegrees-earthRadiusUnitsAU (AU d) = fromDMS 0 0 (8.794/d)+{-| +Module: Data.Astro.Effects.Parallax +Description: Calculation effects of geocentric parallax +Copyright: Alexander Ignatyev, 2016 + + +Calculation effects of geocentric parallax. +-} + +module Data.Astro.Effects.Parallax +( + parallaxQuantities + , parallax +) + +where + +import Data.Astro.Types (DecimalDegrees(..) + , DecimalHours(..) + , AstronomicalUnits(..) + , GeographicCoordinates(..) + , toRadians, fromRadians + , fromDMS + , toDecimalHours, fromDecimalHours) +import Data.Astro.Time (utToLST) +import Data.Astro.Time.JulianDate (JulianDate(..)) +import Data.Astro.Time.Sidereal (LocalSiderealTime(..), utToGST, gstToLST) +import Data.Astro.Coordinate (EquatorialCoordinates1(..), raToHA) + + +-- | It takes latitude of the observer +-- and height above sea-level of the observer measured in metres +-- Returns palallax quantities (p*(sin phi'), p*(cos phi')), +-- where phi' is the geocentric latitude +-- and p is the distance of the obserbve from the centre of the Earth. +parallaxQuantities :: DecimalDegrees -> Double -> (Double, Double) +parallaxQuantities latitude height = + let c = 0.996647 + phi = toRadians latitude + h = earthRadiusUnits height + u = atan (c*(tan phi)) + pSin = c * (sin u) + h*(sin phi) + pCos = (cos u) + h*(cos phi) + in (pSin, pCos) + + +-- | Calculate the apparent position of the celestial object (the Sun or a planet). +-- It takes geocraphic coordinates of the observer and height above sea-level of the observer measured in metres, +-- distance from the celestial object to the Earth measured in AU, the Universal Time and geocentric equatorial coordinates. +-- It returns adjusted equatorial coordinates. +parallax :: GeographicCoordinates -> Double -> AstronomicalUnits -> JulianDate -> EquatorialCoordinates1 -> EquatorialCoordinates1 +parallax (GeoC latitude longitude) height distance ut (EC1 delta alpha) = + let piD = earthRadiusUnitsAU distance + lst = utToLST longitude ut + (pSin, pCos) = parallaxQuantities latitude height + ha = toRadians $ fromDecimalHours $ raToHA alpha longitude ut + delta' = toRadians delta + dAlpha = (toDecimalHours piD) * (DH $ (sin ha)*pCos/(cos delta')) + dDelta = piD * (DD $ pSin*(cos delta') - pCos*(cos ha)*(sin delta')) + in EC1 (delta-dDelta) (alpha-dAlpha) + + +-- | It takes the distance in metres and +-- returns the distance measured in units of qquatorial Earth radius +earthRadiusUnits :: Double -> Double +earthRadiusUnits d = d / 6378140 + + +--earthRadiusUnitsAU :: AstronomicalUnits -> DecimalDegrees +earthRadiusUnitsAU (AU d) = fromDMS 0 0 (8.794/d)
src/Data/Astro/Effects/Precession.hs view
@@ -1,117 +1,117 @@-{-|-Module: Data.Astro.Effects.Precession-Description: Luni-solar precession-Copyright: Alexander Ignatyev, 2016--Luni-solar precession.--}--module Data.Astro.Effects.Precession-(- AstronomyEpoch(..)- , precession1- , precession2-)--where--import Data.Matrix--import qualified Data.Astro.Utils as U-import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..), toDecimalHours, fromDecimalHours, toRadians, fromRadians)-import Data.Astro.Time.JulianDate (JulianDate(..), numberOfYears, numberOfCenturies)-import Data.Astro.Time.Epoch (b1900, b1950, j2000, j2050)-import Data.Astro.Coordinate (EquatorialCoordinates1(..))------------------------------------------------------------------------------------- Low-precision Precession---- | Epoch Enumeration. See also "Data.Astro.Time.JulianDate" module.-data AstronomyEpoch = B1900 -- ^ Epoch B1900.0- | B1950 -- ^ Epoch B1950.0- | J2000 -- ^ Epoch J2000.0- | J2050 -- ^ Epoch J2050.0- deriving (Show, Eq)----- | Get the start date of the specified Epoch.-epochToJD :: AstronomyEpoch -> JulianDate-epochToJD B1900 = b1900-epochToJD B1950 = b1950-epochToJD J2000 = j2000-epochToJD J2050 = j2050----- | Precisional Constants-data PrecessionalConstants = PrecessionalConstants {- pcM :: Double -- ^ seconds- , pcN :: Double -- ^ seconds- , pcN' :: Double -- ^ arcsec- }----- | Get Precision Constants of the Epoch-precessionalConstants :: AstronomyEpoch -> PrecessionalConstants-precessionalConstants B1900 = PrecessionalConstants 3.07234 1.33645 20.0468-precessionalConstants B1950 = PrecessionalConstants 3.07327 1.33617 20.0426-precessionalConstants J2000 = PrecessionalConstants 3.07420 1.33589 20.0383-precessionalConstants J2050 = PrecessionalConstants 3.07513 1.33560 20.0340----- | Low-precision method to calculate luni-solar precession.--- It takes Epoch, Equatorial Coordinates those correct at the given epoch, Julian Date of the observation.--- It returns corrected Equatorial Coordinates.-precession1 :: AstronomyEpoch -> EquatorialCoordinates1 -> JulianDate -> EquatorialCoordinates1-precession1 epoch (EC1 delta alpha) jd =- let delta' = toRadians delta- alpha' = toRadians $ fromDecimalHours alpha- years = numberOfYears (epochToJD epoch) jd- PrecessionalConstants m n n' = precessionalConstants epoch- s1 = DH $ (m + n*(sin alpha')*(tan delta'))*years / 3600- s2 = DD $ (n'*(cos alpha')) * years / 3600- in (EC1 (delta + s2) (alpha + s1))------------------------------------------------------------------------------------- Rigorous Method----- | Rigorous method to calculate luni-solar precession.--- It takes julian date at whose the coordinates are correct, Equatorial Coordinates, Julian Date of the observation.--- It returns corrected Equatorial Coordinates.-precession2 :: JulianDate -> EquatorialCoordinates1 -> JulianDate -> EquatorialCoordinates1-precession2 epoch ec jd =- let p' = prepareMatrixP' $ numberOfCenturies j2000 epoch- v = prepareColumnVectorV ec- p = transpose $ prepareMatrixP' $ numberOfCenturies j2000 jd- [m, n, k] = toList $ p*(p'*v)- alpha = atan2 n m- delta = asin k- in EC1 (fromRadians delta) (toDecimalHours $ fromRadians alpha)---prepareMatrixP' n =- let x = U.toRadians $ 0.6406161*n + 0.0000839*n*n + 0.0000050*n*n*n- z = U.toRadians $ 0.6406161*n + 0.0003041*n*n + 0.0000051*n*n*n- t = U.toRadians $ 0.5567530*n - 0.0001185*n*n - 0.0000116*n*n*n- cx = cos x- sx = sin x- cz = cos z- sz = sin z- ct = cos t- st = sin t- matrix = [ [cx*ct*cz-sx*sz, cx*ct*sz+sx*cz, cx*st]- , [(-sx)*ct*cz-cx*sz, (-sx)*ct*sz+cx*cz, (-sx)*st]- , [(-st)*cz, (-st)*sz, ct] ]- in fromLists matrix--prepareColumnVectorV (EC1 delta alpha) =- let d = toRadians delta- a = toRadians $ fromDecimalHours alpha- cd = cos d- sd = sin d- ca = cos a- sa = sin a- v = [ca*cd, sa*cd, sd]- in fromList 3 1 v+{-| +Module: Data.Astro.Effects.Precession +Description: Luni-solar precession +Copyright: Alexander Ignatyev, 2016 + +Luni-solar precession. +-} + +module Data.Astro.Effects.Precession +( + AstronomyEpoch(..) + , precession1 + , precession2 +) + +where + +import Data.Matrix + +import qualified Data.Astro.Utils as U +import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..), toDecimalHours, fromDecimalHours, toRadians, fromRadians) +import Data.Astro.Time.JulianDate (JulianDate(..), numberOfYears, numberOfCenturies) +import Data.Astro.Time.Epoch (b1900, b1950, j2000, j2050) +import Data.Astro.Coordinate (EquatorialCoordinates1(..)) + + +------------------------------------------------------------------------------- +-- Low-precision Precession + +-- | Epoch Enumeration. See also "Data.Astro.Time.JulianDate" module. +data AstronomyEpoch = B1900 -- ^ Epoch B1900.0 + | B1950 -- ^ Epoch B1950.0 + | J2000 -- ^ Epoch J2000.0 + | J2050 -- ^ Epoch J2050.0 + deriving (Show, Eq) + + +-- | Get the start date of the specified Epoch. +epochToJD :: AstronomyEpoch -> JulianDate +epochToJD B1900 = b1900 +epochToJD B1950 = b1950 +epochToJD J2000 = j2000 +epochToJD J2050 = j2050 + + +-- | Precisional Constants +data PrecessionalConstants = PrecessionalConstants { + pcM :: Double -- ^ seconds + , pcN :: Double -- ^ seconds + , pcN' :: Double -- ^ arcsec + } + + +-- | Get Precision Constants of the Epoch +precessionalConstants :: AstronomyEpoch -> PrecessionalConstants +precessionalConstants B1900 = PrecessionalConstants 3.07234 1.33645 20.0468 +precessionalConstants B1950 = PrecessionalConstants 3.07327 1.33617 20.0426 +precessionalConstants J2000 = PrecessionalConstants 3.07420 1.33589 20.0383 +precessionalConstants J2050 = PrecessionalConstants 3.07513 1.33560 20.0340 + + +-- | Low-precision method to calculate luni-solar precession. +-- It takes Epoch, Equatorial Coordinates those correct at the given epoch, Julian Date of the observation. +-- It returns corrected Equatorial Coordinates. +precession1 :: AstronomyEpoch -> EquatorialCoordinates1 -> JulianDate -> EquatorialCoordinates1 +precession1 epoch (EC1 delta alpha) jd = + let delta' = toRadians delta + alpha' = toRadians $ fromDecimalHours alpha + years = numberOfYears (epochToJD epoch) jd + PrecessionalConstants m n n' = precessionalConstants epoch + s1 = DH $ (m + n*(sin alpha')*(tan delta'))*years / 3600 + s2 = DD $ (n'*(cos alpha')) * years / 3600 + in (EC1 (delta + s2) (alpha + s1)) + + +------------------------------------------------------------------------------- +-- Rigorous Method + + +-- | Rigorous method to calculate luni-solar precession. +-- It takes julian date at whose the coordinates are correct, Equatorial Coordinates, Julian Date of the observation. +-- It returns corrected Equatorial Coordinates. +precession2 :: JulianDate -> EquatorialCoordinates1 -> JulianDate -> EquatorialCoordinates1 +precession2 epoch ec jd = + let p' = prepareMatrixP' $ numberOfCenturies j2000 epoch + v = prepareColumnVectorV ec + p = transpose $ prepareMatrixP' $ numberOfCenturies j2000 jd + [m, n, k] = toList $ p*(p'*v) + alpha = atan2 n m + delta = asin k + in EC1 (fromRadians delta) (toDecimalHours $ fromRadians alpha) + + +prepareMatrixP' n = + let x = U.toRadians $ 0.6406161*n + 0.0000839*n*n + 0.0000050*n*n*n + z = U.toRadians $ 0.6406161*n + 0.0003041*n*n + 0.0000051*n*n*n + t = U.toRadians $ 0.5567530*n - 0.0001185*n*n - 0.0000116*n*n*n + cx = cos x + sx = sin x + cz = cos z + sz = sin z + ct = cos t + st = sin t + matrix = [ [cx*ct*cz-sx*sz, cx*ct*sz+sx*cz, cx*st] + , [(-sx)*ct*cz-cx*sz, (-sx)*ct*sz+cx*cz, (-sx)*st] + , [(-st)*cz, (-st)*sz, ct] ] + in fromLists matrix + +prepareColumnVectorV (EC1 delta alpha) = + let d = toRadians delta + a = toRadians $ fromDecimalHours alpha + cd = cos d + sd = sin d + ca = cos a + sa = sin a + v = [ca*cd, sa*cd, sd] + in fromList 3 1 v
src/Data/Astro/Moon.hs view
@@ -1,234 +1,234 @@-{-|-Module: Data.Astro.Moon-Description: Calculation characteristics of the Moon-Copyright: Alexander Ignatyev, 2016--Calculation characteristics of the Moon.--= Example--@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Effects-import Data.Astro.CelestialObject.RiseSet-import Data.Astro.Moon--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25--jd :: JulianDate-jd = lctUniversalTime dt---- distance from the Earth to the Moon in kilometres-mdu :: MoonDistanceUnits-mdu = moonDistance1 j2010MoonDetails jd--- MDU 0.9550170577020396--distance :: Double-distance = mduToKm mdu--- 367109.51199772174---- Angular Size-angularSize :: DecimalDegrees-angularSize = moonAngularSize mdu--- DD 0.5425033990980761---- The Moon's coordinates-position :: JulianDate -> EquatorialCoordinates1-position = moonPosition1 j2010MoonDetails--ec1 :: EquatorialCoordinates1-ec1 = position jd--- EC1 {e1Declination = DD 18.706180658927323, e1RightAscension = DH 7.56710547682055}--hc :: HorizonCoordinates-hc = ec1ToHC ro jd ec1--- HC {hAltitude = DD 34.57694951316064, hAzimuth = DD 103.91119101451832}---- Rise and Set-riseSet :: RiseSetMB-riseSet = riseAndSet2 0.000001 position ro verticalShift today--- RiseSet--- (Just (2017-06-25 06:22:51.4858 +1.0,DD 57.81458864497365))--- (Just (2017-06-25 22:28:20.3023 +1.0,DD 300.4168238905249))---- Phase-phase :: Double-phase = moonPhase j2010MoonDetails jd--- 2.4716141948212922e-2---sunEC1 :: EquatorialCoordinates1-sunEC1 = sunPosition2 jd--- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748}--limbAngle :: DecimalDegrees-limbAngle = moonBrightLimbPositionAngle ec1 sunEC1--- DD 287.9869373767473-@--}--module Data.Astro.Moon-(- moonPosition1- , moonPosition2- , moonDistance1- , moonAngularSize- , moonHorizontalParallax- , moonPhase- , moonBrightLimbPositionAngle-)--where--import qualified Data.Astro.Utils as U-import Data.Astro.Types (DecimalDegrees(..), GeographicCoordinates, toRadians, fromRadians, kmToAU)-import Data.Astro.Time.JulianDate (JulianDate(..), numberOfDays)-import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..), eclipticToEquatorial)-import Data.Astro.Planet (planetBrightLimbPositionAngle)-import Data.Astro.Sun (sunDetails, sunMeanAnomaly2, sunEclipticLongitude2)-import Data.Astro.Moon.MoonDetails (MoonDetails(..), MoonDistanceUnits(..), j2010MoonDetails, mduToKm)-import Data.Astro.Effects (parallax)----- | Reduce the value to the range [0, 360)-reduceDegrees :: DecimalDegrees -> DecimalDegrees-reduceDegrees = U.reduceToZeroRange 360----- | Calculate Equatorial Coordinates of the Moon with the given MoonDetails and at the given JulianDate.--- --- It is recommended to use 'j2010MoonDetails' as a first parameter.-moonPosition1 :: MoonDetails -> JulianDate -> EquatorialCoordinates1-moonPosition1 md ut =- let sd = sunDetails ut- lambdaS = sunEclipticLongitude2 sd- ms = sunMeanAnomaly2 sd- mmq = meanMoonQuantities md ut- MQ lm'' _ nm' = correctedMoonQuantities lambdaS ms mmq- a = toRadians $ lm''-nm'- i = toRadians $ mdI md- y = (sin a) * (cos i)- x = cos a- at = reduceDegrees $ fromRadians $ atan2 y x- lambdaM = at + nm'- betaM = fromRadians $ asin $ (sin a) * (sin i)- in eclipticToEquatorial (EcC betaM lambdaM) ut----- | Calculate Equatorial Coordinates of the Moon with the given MoonDetails,--- distance to the Moon, geographic coordinates of the onserver,--- height above sea-level of the observer measured in metres (20 is a good reasonable value for the height)--- and at the given JulianDate.--- --- It is recommended to use 'j2010MoonDetails' as a first parameter,--- to obtain the distance to the Moon you can use `moonDistance1` function.--- `moonPosition2` takes into account parallax effect.-moonPosition2 :: MoonDetails -> MoonDistanceUnits -> GeographicCoordinates -> Double -> JulianDate -> EquatorialCoordinates1-moonPosition2 md distance coords height jd =- let p = moonPosition1 md jd- in parallax coords height (kmToAU $ mduToKm distance) jd p----- | Calculates the Moon's Distance at the given julian date.--- Returns distance to the Moon--- moonDistance1 :: JulianDate -> MoonDistanceUnits--- you can use 'mduToKm' (defined in "Data.Astro.Moon.MoonDetails") to convert result to kilometers-moonDistance1 :: MoonDetails -> JulianDate -> MoonDistanceUnits-moonDistance1 md ut =- let sd = sunDetails ut- lambdaS = sunEclipticLongitude2 sd- ms = sunMeanAnomaly2 sd- mmq = meanMoonQuantities md ut- cmq = correctedMoonQuantities lambdaS ms mmq- mm' = toRadians $ mqAnomaly cmq- ec = toRadians $ centreEquation mm'- e = mdE md- in MDU $ (1 - e*e)/(1+e*(cos(mm'+ec)))----- | Calculate the Moon's angular size at the given distance.-moonAngularSize :: MoonDistanceUnits -> DecimalDegrees-moonAngularSize (MDU p) = (mdBigTheta j2010MoonDetails) / (DD p)----- | Calculates the Moon's horizontal parallax at the given distance.-moonHorizontalParallax :: MoonDistanceUnits -> DecimalDegrees-moonHorizontalParallax (MDU p) = (mdPi j2010MoonDetails) / (DD p)----- | Calculates the Moon's phase (the area of the visible segment expressed as a fraction of the whole disk)--- at the given universal time.-moonPhase :: MoonDetails -> JulianDate -> Double-moonPhase md ut =- let sd = sunDetails ut- lambdaS = sunEclipticLongitude2 sd- ms = sunMeanAnomaly2 sd- mmq = meanMoonQuantities md ut- MQ ml _ _ = correctedMoonQuantities lambdaS ms mmq- d = toRadians $ ml - lambdaS- f = 0.5 * (1 - cos d)- in f------ | Calculate the Moon's position-angle of the bright limb.--- It takes the Moon's coordinates and the Sun's coordinates.--- Position-angle is the angle of the midpoint of the illuminated limb--- measured eastwards from the north point of the disk.-moonBrightLimbPositionAngle :: EquatorialCoordinates1 -> EquatorialCoordinates1 -> DecimalDegrees-moonBrightLimbPositionAngle = planetBrightLimbPositionAngle----- | The Moon's quantities--- Used to store intermidiate results-data MoonQuantities = MQ {- mqLongitude :: DecimalDegrees -- ^ the Moon's longitude- , mqAnomaly :: DecimalDegrees -- ^ the Moon's anomaly- , mqAscendingNode :: DecimalDegrees -- ^ the Moon's ascending node's longitude- }----- | Calculates the Moon's mean quantities on the given date.--- It takes the Moon's orbita details and julian date-meanMoonQuantities :: MoonDetails -> JulianDate -> MoonQuantities-meanMoonQuantities md ut =- let d = DD $ numberOfDays (mdEpoch md) ut- lm = reduceDegrees $ (mdL md) + 13.1763966*d -- Moon's mean longitude- mm = reduceDegrees $ lm - 0.1114041*d - (mdP md) -- Moon's mean anomaly- nm = reduceDegrees $ (mdN md) - 0.0529539*d -- ascending node's mean longitude- in MQ lm mm nm----- | Calculates correction for the equation of the centre--- It takes the Moon's corrected anomaly in radians-centreEquation :: Double -> DecimalDegrees-centreEquation mm = DD $ 6.2886 * (sin mm)----- | Calculates the Moon's corrected longitude, anomaly and asceding node's longitude--- It takes the Sun's longitude, the Sun's mean anomaly and the Moon's mean quantities-correctedMoonQuantities :: DecimalDegrees -> DecimalDegrees -> MoonQuantities -> MoonQuantities-correctedMoonQuantities lambdaS ms (MQ lm mm nm) =- let ms' = toRadians ms- c = lm - lambdaS- ev = DD $ 1.2739 * (sin $ toRadians $ 2*c - mm) -- correction for evection- ae = DD $ 0.1858 * (sin ms') -- correction for annual equation- a3 = DD $ 0.37 * (sin ms') -- third correction- mm' = mm + (ev - ae - a3) -- Moon's corrected anomaly- mm'' = toRadians mm'- ec = centreEquation mm'' -- correction for the equation of the centre- a4 = DD $ 0.214 * (sin $ 2*mm'') -- fourth correction term- lm' = lm + (ev + ec -ae + a4) -- Moon's corrected longitude- v = DD $ 0.6583 * (sin $ toRadians $ 2*(lm' - lambdaS))-- correction for variation- lm'' = lm' + v -- Moon's true orbital longitude- nm' = nm - (DD $ 0.16 * (sin ms')) -- ascending node's corrected longitude- in MQ lm'' mm' nm'+{-| +Module: Data.Astro.Moon +Description: Calculation characteristics of the Moon +Copyright: Alexander Ignatyev, 2016 + +Calculation characteristics of the Moon. + += Example + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Effects +import Data.Astro.CelestialObject.RiseSet +import Data.Astro.Moon + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +jd :: JulianDate +jd = lctUniversalTime dt + +-- distance from the Earth to the Moon in kilometres +mdu :: MoonDistanceUnits +mdu = moonDistance1 j2010MoonDetails jd +-- MDU 0.9550170577020396 + +distance :: Double +distance = mduToKm mdu +-- 367109.51199772174 + +-- Angular Size +angularSize :: DecimalDegrees +angularSize = moonAngularSize mdu +-- DD 0.5425033990980761 + +-- The Moon's coordinates +position :: JulianDate -> EquatorialCoordinates1 +position = moonPosition1 j2010MoonDetails + +ec1 :: EquatorialCoordinates1 +ec1 = position jd +-- EC1 {e1Declination = DD 18.706180658927323, e1RightAscension = DH 7.56710547682055} + +hc :: HorizonCoordinates +hc = ec1ToHC ro jd ec1 +-- HC {hAltitude = DD 34.57694951316064, hAzimuth = DD 103.91119101451832} + +-- Rise and Set +riseSet :: RiseSetMB +riseSet = riseAndSet2 0.000001 position ro verticalShift today +-- RiseSet +-- (Just (2017-06-25 06:22:51.4858 +1.0,DD 57.81458864497365)) +-- (Just (2017-06-25 22:28:20.3023 +1.0,DD 300.4168238905249)) + +-- Phase +phase :: Double +phase = moonPhase j2010MoonDetails jd +-- 2.4716141948212922e-2 + + +sunEC1 :: EquatorialCoordinates1 +sunEC1 = sunPosition2 jd +-- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748} + +limbAngle :: DecimalDegrees +limbAngle = moonBrightLimbPositionAngle ec1 sunEC1 +-- DD 287.9869373767473 +@ +-} + +module Data.Astro.Moon +( + moonPosition1 + , moonPosition2 + , moonDistance1 + , moonAngularSize + , moonHorizontalParallax + , moonPhase + , moonBrightLimbPositionAngle +) + +where + +import qualified Data.Astro.Utils as U +import Data.Astro.Types (DecimalDegrees(..), GeographicCoordinates, toRadians, fromRadians, kmToAU) +import Data.Astro.Time.JulianDate (JulianDate(..), numberOfDays) +import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..), eclipticToEquatorial) +import Data.Astro.Planet (planetBrightLimbPositionAngle) +import Data.Astro.Sun (sunDetails, sunMeanAnomaly2, sunEclipticLongitude2) +import Data.Astro.Moon.MoonDetails (MoonDetails(..), MoonDistanceUnits(..), j2010MoonDetails, mduToKm) +import Data.Astro.Effects (parallax) + + +-- | Reduce the value to the range [0, 360) +reduceDegrees :: DecimalDegrees -> DecimalDegrees +reduceDegrees = U.reduceToZeroRange 360 + + +-- | Calculate Equatorial Coordinates of the Moon with the given MoonDetails and at the given JulianDate. +-- +-- It is recommended to use 'j2010MoonDetails' as a first parameter. +moonPosition1 :: MoonDetails -> JulianDate -> EquatorialCoordinates1 +moonPosition1 md ut = + let sd = sunDetails ut + lambdaS = sunEclipticLongitude2 sd + ms = sunMeanAnomaly2 sd + mmq = meanMoonQuantities md ut + MQ lm'' _ nm' = correctedMoonQuantities lambdaS ms mmq + a = toRadians $ lm''-nm' + i = toRadians $ mdI md + y = (sin a) * (cos i) + x = cos a + at = reduceDegrees $ fromRadians $ atan2 y x + lambdaM = at + nm' + betaM = fromRadians $ asin $ (sin a) * (sin i) + in eclipticToEquatorial (EcC betaM lambdaM) ut + + +-- | Calculate Equatorial Coordinates of the Moon with the given MoonDetails, +-- distance to the Moon, geographic coordinates of the onserver, +-- height above sea-level of the observer measured in metres (20 is a good reasonable value for the height) +-- and at the given JulianDate. +-- +-- It is recommended to use 'j2010MoonDetails' as a first parameter, +-- to obtain the distance to the Moon you can use `moonDistance1` function. +-- `moonPosition2` takes into account parallax effect. +moonPosition2 :: MoonDetails -> MoonDistanceUnits -> GeographicCoordinates -> Double -> JulianDate -> EquatorialCoordinates1 +moonPosition2 md distance coords height jd = + let p = moonPosition1 md jd + in parallax coords height (kmToAU $ mduToKm distance) jd p + + +-- | Calculates the Moon's Distance at the given julian date. +-- Returns distance to the Moon +-- moonDistance1 :: JulianDate -> MoonDistanceUnits +-- you can use 'mduToKm' (defined in "Data.Astro.Moon.MoonDetails") to convert result to kilometers +moonDistance1 :: MoonDetails -> JulianDate -> MoonDistanceUnits +moonDistance1 md ut = + let sd = sunDetails ut + lambdaS = sunEclipticLongitude2 sd + ms = sunMeanAnomaly2 sd + mmq = meanMoonQuantities md ut + cmq = correctedMoonQuantities lambdaS ms mmq + mm' = toRadians $ mqAnomaly cmq + ec = toRadians $ centreEquation mm' + e = mdE md + in MDU $ (1 - e*e)/(1+e*(cos(mm'+ec))) + + +-- | Calculate the Moon's angular size at the given distance. +moonAngularSize :: MoonDistanceUnits -> DecimalDegrees +moonAngularSize (MDU p) = (mdBigTheta j2010MoonDetails) / (DD p) + + +-- | Calculates the Moon's horizontal parallax at the given distance. +moonHorizontalParallax :: MoonDistanceUnits -> DecimalDegrees +moonHorizontalParallax (MDU p) = (mdPi j2010MoonDetails) / (DD p) + + +-- | Calculates the Moon's phase (the area of the visible segment expressed as a fraction of the whole disk) +-- at the given universal time. +moonPhase :: MoonDetails -> JulianDate -> Double +moonPhase md ut = + let sd = sunDetails ut + lambdaS = sunEclipticLongitude2 sd + ms = sunMeanAnomaly2 sd + mmq = meanMoonQuantities md ut + MQ ml _ _ = correctedMoonQuantities lambdaS ms mmq + d = toRadians $ ml - lambdaS + f = 0.5 * (1 - cos d) + in f + + + +-- | Calculate the Moon's position-angle of the bright limb. +-- It takes the Moon's coordinates and the Sun's coordinates. +-- Position-angle is the angle of the midpoint of the illuminated limb +-- measured eastwards from the north point of the disk. +moonBrightLimbPositionAngle :: EquatorialCoordinates1 -> EquatorialCoordinates1 -> DecimalDegrees +moonBrightLimbPositionAngle = planetBrightLimbPositionAngle + + +-- | The Moon's quantities +-- Used to store intermidiate results +data MoonQuantities = MQ { + mqLongitude :: DecimalDegrees -- ^ the Moon's longitude + , mqAnomaly :: DecimalDegrees -- ^ the Moon's anomaly + , mqAscendingNode :: DecimalDegrees -- ^ the Moon's ascending node's longitude + } + + +-- | Calculates the Moon's mean quantities on the given date. +-- It takes the Moon's orbita details and julian date +meanMoonQuantities :: MoonDetails -> JulianDate -> MoonQuantities +meanMoonQuantities md ut = + let d = DD $ numberOfDays (mdEpoch md) ut + lm = reduceDegrees $ (mdL md) + 13.1763966*d -- Moon's mean longitude + mm = reduceDegrees $ lm - 0.1114041*d - (mdP md) -- Moon's mean anomaly + nm = reduceDegrees $ (mdN md) - 0.0529539*d -- ascending node's mean longitude + in MQ lm mm nm + + +-- | Calculates correction for the equation of the centre +-- It takes the Moon's corrected anomaly in radians +centreEquation :: Double -> DecimalDegrees +centreEquation mm = DD $ 6.2886 * (sin mm) + + +-- | Calculates the Moon's corrected longitude, anomaly and asceding node's longitude +-- It takes the Sun's longitude, the Sun's mean anomaly and the Moon's mean quantities +correctedMoonQuantities :: DecimalDegrees -> DecimalDegrees -> MoonQuantities -> MoonQuantities +correctedMoonQuantities lambdaS ms (MQ lm mm nm) = + let ms' = toRadians ms + c = lm - lambdaS + ev = DD $ 1.2739 * (sin $ toRadians $ 2*c - mm) -- correction for evection + ae = DD $ 0.1858 * (sin ms') -- correction for annual equation + a3 = DD $ 0.37 * (sin ms') -- third correction + mm' = mm + (ev - ae - a3) -- Moon's corrected anomaly + mm'' = toRadians mm' + ec = centreEquation mm'' -- correction for the equation of the centre + a4 = DD $ 0.214 * (sin $ 2*mm'') -- fourth correction term + lm' = lm + (ev + ec -ae + a4) -- Moon's corrected longitude + v = DD $ 0.6583 * (sin $ toRadians $ 2*(lm' - lambdaS))-- correction for variation + lm'' = lm' + v -- Moon's true orbital longitude + nm' = nm - (DD $ 0.16 * (sin ms')) -- ascending node's corrected longitude + in MQ lm'' mm' nm'
src/Data/Astro/Moon/MoonDetails.hs view
@@ -1,47 +1,47 @@-{-|-Module: Data.Astro.Moon.MoonDetails-Description: Planet Details-Copyright: Alexander Ignatyev, 2016--Moon Details.--}--module Data.Astro.Moon.MoonDetails-(- MoonDetails(..)- , MoonDistanceUnits(..)- , j2010MoonDetails- , mduToKm-)--where--import Data.Astro.Types (DecimalDegrees)-import Data.Astro.Time.Epoch (j2010)-import Data.Astro.Time.JulianDate (JulianDate(..))----- | Details of the Moon's orbit at the epoch-data MoonDetails = MoonDetails {- mdEpoch :: JulianDate -- ^ the epoch- , mdL :: DecimalDegrees -- ^ mean longitude at the epoch- , mdP :: DecimalDegrees -- ^ mean longitude of the perigee at the epoch- , mdN :: DecimalDegrees -- ^ mean longitude of the node at the epoch- , mdI :: DecimalDegrees -- ^ inclination of the orbit- , mdE :: Double -- ^ eccentricity of the orbit- , mdA :: Double -- ^ semi-major axis of the orbit- , mdBigTheta :: DecimalDegrees -- ^ angular diameter at the distance `mdA` from the Earth- , mdPi :: DecimalDegrees -- ^ parallax at distance `mdA` from the Earth- } deriving (Show)----- | Moon distance units, 1 MDU = semi-major axis of the Moon's orbit-newtype MoonDistanceUnits = MDU Double deriving (Show)---j2010MoonDetails = MoonDetails j2010 91.929336 130.143076 291.682547 5.145396 0.0549 384401 0.5181 0.9507----- | Convert MoonDistanceUnits to km-mduToKm :: MoonDistanceUnits -> Double-mduToKm (MDU p) = p * (mdA j2010MoonDetails)+{-| +Module: Data.Astro.Moon.MoonDetails +Description: Planet Details +Copyright: Alexander Ignatyev, 2016 + +Moon Details. +-} + +module Data.Astro.Moon.MoonDetails +( + MoonDetails(..) + , MoonDistanceUnits(..) + , j2010MoonDetails + , mduToKm +) + +where + +import Data.Astro.Types (DecimalDegrees) +import Data.Astro.Time.Epoch (j2010) +import Data.Astro.Time.JulianDate (JulianDate(..)) + + +-- | Details of the Moon's orbit at the epoch +data MoonDetails = MoonDetails { + mdEpoch :: JulianDate -- ^ the epoch + , mdL :: DecimalDegrees -- ^ mean longitude at the epoch + , mdP :: DecimalDegrees -- ^ mean longitude of the perigee at the epoch + , mdN :: DecimalDegrees -- ^ mean longitude of the node at the epoch + , mdI :: DecimalDegrees -- ^ inclination of the orbit + , mdE :: Double -- ^ eccentricity of the orbit + , mdA :: Double -- ^ semi-major axis of the orbit + , mdBigTheta :: DecimalDegrees -- ^ angular diameter at the distance `mdA` from the Earth + , mdPi :: DecimalDegrees -- ^ parallax at distance `mdA` from the Earth + } deriving (Show) + + +-- | Moon distance units, 1 MDU = semi-major axis of the Moon's orbit +newtype MoonDistanceUnits = MDU Double deriving (Show) + + +j2010MoonDetails = MoonDetails j2010 91.929336 130.143076 291.682547 5.145396 0.0549 384401 0.5181 0.9507 + + +-- | Convert MoonDistanceUnits to km +mduToKm :: MoonDistanceUnits -> Double +mduToKm (MDU p) = p * (mdA j2010MoonDetails)
src/Data/Astro/Planet.hs view
@@ -1,100 +1,102 @@-{-|-Module: Data.Astro.Planet-Description: Planet calculations-Copyright: Alexander Ignatyev, 2016--Planet calculations.--= Example--=== /Initialisation/--@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Effects-import Data.Astro.CelestialObject.RiseSet-import Data.Astro.Planet--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25--jupiterDetails :: PlanetDetails-jupiterDetails = j2010PlanetDetails Jupiter--earthDetails :: PlanetDetails-earthDetails = j2010PlanetDetails Earth--jupiterPosition :: JulianDate -> EquatorialCoordinates1-jupiterPosition = planetPosition planetTrueAnomaly1 jupiterDetails earthDetails-@--=== /Calcaulate Coordinates/-@-jupiterEC1 :: EquatorialCoordinates1-jupiterEC1 = jupiterPosition (lctUniversalTime dt)--- EC1 {e1Declination = DD (-4.104626810672402), e1RightAscension = DH 12.863365504382228}--jupiterHC :: HorizonCoordinates-jupiterHC = ec1ToHC ro (lctUniversalTime dt) jupiterEC1--- HC {hAltitude = DD (-30.67914598469227), hAzimuth = DD 52.29376845044007}-@--=== /Calculate Distance/-@-jupiterDistance :: AstronomicalUnits-jupiterDistance = planetDistance1 jupiterDetails earthDetails (lctUniversalTime dt)--- AU 5.193435872521039-@--=== /Calculate Angular Size/-@-jupiterAngularSize :: DecimalDegrees-jupiterAngularSize = planetAngularDiameter jupiterDetails jupiterDistance--- DD 1.052289877865987e-2--toDMS jupiterAngularSize--- (0,0,37.88243560317554)-@--=== /Calculate Rise and Set/--@-verticalShift :: DecimalDegrees-verticalShift = refract (DD 0) 12 1012--- DD 0.5660098245614035--jupiterRiseSet :: RiseSetMB-jupiterRiseSet = riseAndSet2 0.000001 jupiterPosition ro verticalShift today--- RiseSet--- (Just (2017-06-25 13:53:27.3109 +1.0,DD 95.88943953535569))--- (Just (2017-06-25 01:21:23.5835 +1.0,DD 264.1289033612776))-@--}--module Data.Astro.Planet-(- Details.Planet(..)- , Details.PlanetDetails(..)- , Details.j2010PlanetDetails- , Mechanics.planetTrueAnomaly1- , Mechanics.planetPosition- , Mechanics.planetPosition1- , Mechanics.planetDistance1- , Mechanics.planetAngularDiameter- , Mechanics.planetPhase1- , Mechanics.planetBrightLimbPositionAngle-)--where---import qualified Data.Astro.Planet.PlanetDetails as Details-import qualified Data.Astro.Planet.PlanetMechanics as Mechanics+{-| +Module: Data.Astro.Planet +Description: Planet calculations +Copyright: Alexander Ignatyev, 2016 + +Planet calculations. + += Example + +=== /Initialisation/ + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Effects +import Data.Astro.CelestialObject.RiseSet +import Data.Astro.Planet + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +jupiterDetails :: PlanetDetails +jupiterDetails = j2010PlanetDetails Jupiter + +earthDetails :: PlanetDetails +earthDetails = j2010PlanetDetails Earth + +jupiterPosition :: JulianDate -> EquatorialCoordinates1 +jupiterPosition = planetPosition planetTrueAnomaly1 jupiterDetails earthDetails +@ + +=== /Calcaulate Coordinates/ +@ +jupiterEC1 :: EquatorialCoordinates1 +jupiterEC1 = jupiterPosition (lctUniversalTime dt) +-- EC1 {e1Declination = DD (-4.104626810672402), e1RightAscension = DH 12.863365504382228} + +jupiterHC :: HorizonCoordinates +jupiterHC = ec1ToHC ro (lctUniversalTime dt) jupiterEC1 +-- HC {hAltitude = DD (-30.67914598469227), hAzimuth = DD 52.29376845044007} +@ + +=== /Calculate Distance/ +@ +jupiterDistance :: AstronomicalUnits +jupiterDistance = planetDistance1 jupiterDetails earthDetails (lctUniversalTime dt) +-- AU 5.193435872521039 +@ + +=== /Calculate Angular Size/ +@ +jupiterAngularSize :: DecimalDegrees +jupiterAngularSize = planetAngularDiameter jupiterDetails jupiterDistance +-- DD 1.052289877865987e-2 + +toDMS jupiterAngularSize +-- (0,0,37.88243560317554) +@ + +=== /Calculate Rise and Set/ + +@ +verticalShift :: DecimalDegrees +verticalShift = refract (DD 0) 12 1012 +-- DD 0.5660098245614035 + +jupiterRiseSet :: RiseSetMB +jupiterRiseSet = riseAndSet2 0.000001 jupiterPosition ro verticalShift today +-- RiseSet +-- (Just (2017-06-25 13:53:27.3109 +1.0,DD 95.88943953535569)) +-- (Just (2017-06-25 01:21:23.5835 +1.0,DD 264.1289033612776)) +@ +-} + +module Data.Astro.Planet +( + Details.Planet(..) + , Details.PlanetDetails(..) + , Details.j2010PlanetDetails + , Mechanics.planetTrueAnomaly1 + , Mechanics.planetTrueAnomaly2 + , Mechanics.planetPosition + , Mechanics.planetPosition1 + , Mechanics.planetDistance + , Mechanics.planetDistance1 + , Mechanics.planetAngularDiameter + , Mechanics.planetPhase1 + , Mechanics.planetBrightLimbPositionAngle +) + +where + + +import qualified Data.Astro.Planet.PlanetDetails as Details +import qualified Data.Astro.Planet.PlanetMechanics as Mechanics
src/Data/Astro/Planet/PlanetDetails.hs view
@@ -1,72 +1,72 @@-{-|-Module: Data.Astro.Planet.PlanetDetails-Description: Planet Details-Copyright: Alexander Ignatyev, 2016-2017--Planet Details.--}--module Data.Astro.Planet.PlanetDetails-(- Planet(..)- , PlanetDetails(..)- , j2010PlanetDetails- , isInnerPlanet-)--where--import Data.Astro.Types (DecimalDegrees(..), AstronomicalUnits, fromDMS)-import Data.Astro.Time.JulianDate (JulianDate)-import Data.Astro.Time.Epoch (j2010)----- | Planets of the Solar System-data Planet = Mercury- | Venus- | Earth - | Mars- | Jupiter- | Saturn- | Uranus- | Neptune- deriving (Show, Eq)----- | Details of the planetary orbit at the epoch-data PlanetDetails = PlanetDetails {- pdPlanet :: Planet- , pdEpoch :: JulianDate- , pdTp :: Double -- ^ Orbital period in tropical years- , pdEpsilon :: DecimalDegrees -- ^ Longitude at the Epoch- , pdOmegaBar :: DecimalDegrees -- ^ Longitude of the perihelion- , pdE :: Double -- ^ Eccentricity of the orbit- , pdAlpha :: AstronomicalUnits -- ^ Semi-major axis of the orbit in AU- , pdI :: DecimalDegrees -- ^ Orbital inclination- , pdBigOmega :: DecimalDegrees -- ^ Longitude of the ascending node- , pdBigTheta :: DecimalDegrees -- ^ Angular diameter at 1 AU- } deriving (Show, Eq)----- | Return True if the planet is inner (its orbit lies inside the Earth's orbit)-isInnerPlanet :: PlanetDetails -> Bool-isInnerPlanet pd- | pdPlanet pd == Mercury = True- | pdPlanet pd == Venus = True- | otherwise = False----- | PlanetDetails at the reference Epoch J2010.0-j2010PlanetDetails :: Planet -> PlanetDetails--- Epoch Tp Epsilon Omega Bar e alpha i Big Omega Big Theta-j2010PlanetDetails Mercury = PlanetDetails Mercury j2010 0.24085 75.5671 77.612 0.205627 0.387098 7.0051 48.449 (arcsecs 6.74)-j2010PlanetDetails Venus = PlanetDetails Venus j2010 0.615207 272.30044 131.54 0.006812 0.723329 3.3947 76.769 (arcsecs 16.92)-j2010PlanetDetails Earth = PlanetDetails Earth j2010 0.999996 99.556772 103.2055 0.016671 0.999985 0 0 (arcsecs 0)-j2010PlanetDetails Mars = PlanetDetails Mars j2010 1.880765 109.09646 336.217 0.093348 1.523689 1.8497 49.632 (arcsecs 9.36)-j2010PlanetDetails Jupiter = PlanetDetails Jupiter j2010 11.857911 337.917132 14.6633 0.048907 5.20278 1.3035 100.595 (arcsecs 196.74)-j2010PlanetDetails Saturn = PlanetDetails Saturn j2010 29.310579 172.398316 89.567 0.053853 9.51134 2.4873 113.752 (arcsecs 165.6)-j2010PlanetDetails Uranus = PlanetDetails Uranus j2010 84.039492 356.135400 172.884833 0.046321 19.21814 0.773059 73.926961 (arcsecs 65.8)-j2010PlanetDetails Neptune = PlanetDetails Neptune j2010 165.845392 326.895127 23.07 0.010483 30.1985 1.7673 131.879 (arcsecs 62.2)---- | arcseconds to DecimalHours-arcsecs = fromDMS 0 0+{-| +Module: Data.Astro.Planet.PlanetDetails +Description: Planet Details +Copyright: Alexander Ignatyev, 2016-2017 + +Planet Details. +-} + +module Data.Astro.Planet.PlanetDetails +( + Planet(..) + , PlanetDetails(..) + , j2010PlanetDetails + , isInnerPlanet +) + +where + +import Data.Astro.Types (DecimalDegrees(..), AstronomicalUnits, fromDMS) +import Data.Astro.Time.JulianDate (JulianDate) +import Data.Astro.Time.Epoch (j2010) + + +-- | Planets of the Solar System +data Planet = Mercury + | Venus + | Earth + | Mars + | Jupiter + | Saturn + | Uranus + | Neptune + deriving (Show, Eq) + + +-- | Details of the planetary orbit at the epoch +data PlanetDetails = PlanetDetails { + pdPlanet :: Planet + , pdEpoch :: JulianDate + , pdTp :: Double -- ^ Orbital period in tropical years + , pdEpsilon :: DecimalDegrees -- ^ Longitude at the Epoch + , pdOmegaBar :: DecimalDegrees -- ^ Longitude of the perihelion + , pdE :: Double -- ^ Eccentricity of the orbit + , pdAlpha :: AstronomicalUnits -- ^ Semi-major axis of the orbit in AU + , pdI :: DecimalDegrees -- ^ Orbital inclination + , pdBigOmega :: DecimalDegrees -- ^ Longitude of the ascending node + , pdBigTheta :: DecimalDegrees -- ^ Angular diameter at 1 AU + } deriving (Show, Eq) + + +-- | Return True if the planet is inner (its orbit lies inside the Earth's orbit) +isInnerPlanet :: PlanetDetails -> Bool +isInnerPlanet pd + | pdPlanet pd == Mercury = True + | pdPlanet pd == Venus = True + | otherwise = False + + +-- | PlanetDetails at the reference Epoch J2010.0 +j2010PlanetDetails :: Planet -> PlanetDetails +-- Epoch Tp Epsilon Omega Bar e alpha i Big Omega Big Theta +j2010PlanetDetails Mercury = PlanetDetails Mercury j2010 0.24085 75.5671 77.612 0.205627 0.387098 7.0051 48.449 (arcsecs 6.74) +j2010PlanetDetails Venus = PlanetDetails Venus j2010 0.615207 272.30044 131.54 0.006812 0.723329 3.3947 76.769 (arcsecs 16.92) +j2010PlanetDetails Earth = PlanetDetails Earth j2010 0.999996 99.556772 103.2055 0.016671 0.999985 0 0 (arcsecs 0) +j2010PlanetDetails Mars = PlanetDetails Mars j2010 1.880765 109.09646 336.217 0.093348 1.523689 1.8497 49.632 (arcsecs 9.36) +j2010PlanetDetails Jupiter = PlanetDetails Jupiter j2010 11.857911 337.917132 14.6633 0.048907 5.20278 1.3035 100.595 (arcsecs 196.74) +j2010PlanetDetails Saturn = PlanetDetails Saturn j2010 29.310579 172.398316 89.567 0.053853 9.51134 2.4873 113.752 (arcsecs 165.6) +j2010PlanetDetails Uranus = PlanetDetails Uranus j2010 84.039492 356.135400 172.884833 0.046321 19.21814 0.773059 73.926961 (arcsecs 65.8) +j2010PlanetDetails Neptune = PlanetDetails Neptune j2010 165.845392 326.895127 23.07 0.010483 30.1985 1.7673 131.879 (arcsecs 62.2) + +-- | arcseconds to DecimalHours +arcsecs = fromDMS 0 0
src/Data/Astro/Planet/PlanetMechanics.hs view
@@ -1,286 +1,308 @@-{-|-Module: Data.Astro.Planet.PlanetMechanics-Description: Planet mechanics-Copyright: Alexander Ignatyev, 2016--Planet mechanics.--}--module Data.Astro.Planet.PlanetMechanics-(- planetMeanAnomaly- , planetTrueAnomaly1- , planetHeliocentricRadiusVector- , planetHeliocentricLongitude- , planetHeliocentricLatitude- , planetProjectedRadiusVector- , planetProjectedLongitude- , planetEclipticLongitude- , planetEclipticLatitude- , planetPosition- , planetPosition1- , planetDistance1- , planetAngularDiameter- , planetPhase1- , planetPertubations- , planetBrightLimbPositionAngle-)--where--import qualified Data.Astro.Utils as U-import Data.Astro.Types (DecimalDegrees(..), AstronomicalUnits(..), toRadians, fromRadians, fromDecimalHours)-import Data.Astro.Time.Epoch (j1900)-import Data.Astro.Time.JulianDate (JulianDate, numberOfDays, numberOfCenturies)-import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..), eclipticToEquatorial)-import Data.Astro.Planet.PlanetDetails (Planet(..), PlanetDetails(..), isInnerPlanet)-import Data.Astro.Sun.SunInternals (solveKeplerEquation)--{--1. Calculate the planet position on its own orbital plane-2. Convert the planet's position to planetHeliocentric coordinates.-3. Convert from planetHeliocentric coordinates to ecliptic coordinates.--}----- | reduce DecimalDegrees to the range [0, 360)-reduceDegrees :: DecimalDegrees -> DecimalDegrees-reduceDegrees = U.reduceToZeroRange 360----- | Calculate the planet mean anomaly.-planetMeanAnomaly pd jd =- let d = numberOfDays (pdEpoch pd) jd- n = reduceDegrees $ DD $ (360/U.tropicalYearLen) * (d/(pdTp pd))- in reduceDegrees $ n + (pdEpsilon pd) - (pdOmegaBar pd)----- | Calculate the planet true anomaly using approximate method-planetTrueAnomaly1 pd jd =- let meanAnomaly = toRadians $ planetMeanAnomaly pd jd- e = pdE pd- in reduceDegrees $ fromRadians $ meanAnomaly + 2*e*(sin meanAnomaly)----- | Calculate Heliocentric Longitude.--- It takes Planet Details and true anomaly.-planetHeliocentricLongitude :: PlanetDetails -> DecimalDegrees -> DecimalDegrees-planetHeliocentricLongitude pd trueAnomaly = reduceDegrees $ (pdOmegaBar pd) + trueAnomaly----- | Calculate Heliocentric Latitude.--- It takes Planet Details and heliocentric longitude.-planetHeliocentricLatitude :: PlanetDetails -> DecimalDegrees -> DecimalDegrees-planetHeliocentricLatitude pd hcl =- let l' = toRadians hcl- i' = toRadians $ pdI pd- bigOmega' = toRadians $ pdBigOmega pd- in fromRadians $ asin $ (sin $ l' - bigOmega')*(sin i')----- | Calculate Heliocentric Radius Vector.--- It takes Planet Details and true anomaly.-planetHeliocentricRadiusVector :: PlanetDetails -> DecimalDegrees -> AstronomicalUnits-planetHeliocentricRadiusVector pd trueAnomaly =- let nu = toRadians trueAnomaly- AU alpha = pdAlpha pd- e = pdE pd- in AU $ alpha*(1 - e*e)/(1+e*(cos nu))----- | Calculate Heliocentric Longitude projected to the ecliptic.--- It takes Planet Details and Heliocentric Longitude-planetProjectedLongitude :: PlanetDetails -> DecimalDegrees -> DecimalDegrees-planetProjectedLongitude pd hcl =- let hcl' = toRadians hcl- bigOmega = pdBigOmega pd- bigOmega' = toRadians $ bigOmega- i' = toRadians $ pdI pd- y = (sin $ hcl'-bigOmega')*(cos i')- x = (cos $ hcl'-bigOmega')- n = fromRadians $ atan2 y x- in n + bigOmega----- | Calculate Heliocentric Radius Vector projected to the ecliptic.--- It takes Planet Details, planetHeliocentric latitude and Radius Vector-planetProjectedRadiusVector :: PlanetDetails -> DecimalDegrees -> AstronomicalUnits -> AstronomicalUnits-planetProjectedRadiusVector pd psi (AU hcr) = AU $ hcr*cos(toRadians psi)----- | Calculate ecliptic longitude for outer planets.--- It takes planet projected longitude, planet projected radius vector--- the Earth's longitude and radius vector.-outerPlanetEclipticLongitude :: DecimalDegrees -> AstronomicalUnits -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees-outerPlanetEclipticLongitude lp (AU rp) le (AU re) =- let lp' = toRadians lp- le' = toRadians le- x = atan $ re * (sin $ lp'-le')/(rp - re*(cos $ lp'-le'))- in reduceDegrees $ (fromRadians x) + lp----- | Calculate ecliptic longitude for inner planets.--- It takes planet projected longitude, planet projected radius vector--- the Earth's longitude and radius vector.-innerPlanetEclipticLongitude :: DecimalDegrees -> AstronomicalUnits -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees-innerPlanetEclipticLongitude lp (AU rp) le (AU re) =- let lp' = toRadians lp- le' = toRadians le- x = atan $ rp * (sin $ le'-lp')/(re - rp*(cos $ le'-lp'))- in reduceDegrees $ (fromRadians x) + le + 180----- | Calculate Ecliptic Longitude.--- It takes planet projected longitude, planet projected radius vector--- the Earth's longitude and radius vector.-planetEclipticLongitude :: PlanetDetails -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees-planetEclipticLongitude pd- | isInnerPlanet pd = innerPlanetEclipticLongitude- | otherwise = outerPlanetEclipticLongitude----- | Calculate ecliptic Latitude.--- It takes the planet's: heliocentric latitude, projected heliocentric longutide,--- projected heliocentric longitude;--- the Earth's: heliocentric longitede and heliocentric radius vector.--- Also it takes the planet's ecliptic longitude.-planetEclipticLatitude :: DecimalDegrees- -> DecimalDegrees- -> AstronomicalUnits- -> DecimalDegrees- -> AstronomicalUnits- -> DecimalDegrees- -> DecimalDegrees-planetEclipticLatitude psi lp (AU rp) le (AU re) lambda =- let psi' = toRadians psi- lp' = toRadians lp- le' = toRadians le- lambda' = toRadians lambda- y = rp*(tan psi')*(sin $ lambda' - lp')- x = re * (sin $ lp' -le')- in fromRadians $ atan (y/x)----- | Calculate the planet's postion at the given date.--- It takes a function to calculate true anomaly,--- planet details of the planet, planet details of the Earth--- and JulianDate.-planetPosition :: (PlanetDetails -> JulianDate -> DecimalDegrees)- -> PlanetDetails -> PlanetDetails -> JulianDate- -> EquatorialCoordinates1-planetPosition trueAnomaly pd ed jd =- -- planet- let nup = trueAnomaly pd jd- lp = planetHeliocentricLongitude pd nup- rp = planetHeliocentricRadiusVector pd nup- psi = planetHeliocentricLatitude pd lp- lp' = planetProjectedLongitude pd lp- rp' = planetProjectedRadiusVector pd psi rp- -- earth- nue = trueAnomaly ed jd- le = planetHeliocentricLongitude ed nue- re = planetHeliocentricRadiusVector ed nue- -- position- lambda = planetEclipticLongitude pd lp' rp' le re- beta = planetEclipticLatitude psi lp' rp' le re lambda- ec = eclipticToEquatorial (EcC beta lambda) jd- in ec----- | Calculates the distance betweeth the planet and the Earth at the given date.--- It takes the planet's detail, the Earth's details and the julian date.-planetDistance1 :: PlanetDetails -> PlanetDetails -> JulianDate -> AstronomicalUnits-planetDistance1 pd ed jd =- let nup = planetTrueAnomaly1 pd jd- lp = planetHeliocentricLongitude pd nup- AU rp = planetHeliocentricRadiusVector pd nup- psi = planetHeliocentricLatitude pd lp- -- earth- nue = planetTrueAnomaly1 ed jd- le = planetHeliocentricLongitude ed nue- AU re = planetHeliocentricRadiusVector ed nue- -- distance- ro = sqrt $ re*re + rp*rp - 2*re*rp*(cos . toRadians $ lp - le)*(cos $ toRadians psi)- in AU ro----- | Calculates the planet's angular diameter for the given distance.-planetAngularDiameter :: PlanetDetails -> AstronomicalUnits -> DecimalDegrees-planetAngularDiameter pd (AU ro) = (pdBigTheta pd)/(DD ro)----- | Calculate the planet's phase at the given phase.--- Phase is a fraction of the visible disc that is illuminated.--- It takes the planet's details, the Earth's details and the julian date.--- Returns fraction values from 0 to 1.-planetPhase1 :: PlanetDetails -> PlanetDetails -> JulianDate -> Double-planetPhase1 pd ed jd =- -- planet- let nup = planetTrueAnomaly1 pd jd- lp = planetHeliocentricLongitude pd nup- rp = planetHeliocentricRadiusVector pd nup- psi = planetHeliocentricLatitude pd lp- lp' = planetProjectedLongitude pd lp- rp' = planetProjectedRadiusVector pd psi rp- -- earth- nue = planetTrueAnomaly1 ed jd- le = planetHeliocentricLongitude ed nue- re = planetHeliocentricRadiusVector ed nue-- lambda = planetEclipticLongitude pd lp' rp' le re- d = toRadians $ lambda - lp- in (1+ (cos d)) * 0.5----- | Calculate the planet's postion at the given date using the approximate algoruthm.--- It takes a function to calculate true anomaly,--- planet details of the planet, planet details of the Earth--- and JulianDate.-planetPosition1 :: PlanetDetails -> PlanetDetails -> JulianDate- -> EquatorialCoordinates1-planetPosition1 = planetPosition planetTrueAnomaly1----- | Calculates pertubations for the planet at the given julian date.--- Returns a value that should be added to the mean longitude (planet heliocentric longitude).-planetPertubations :: Planet -> JulianDate -> DecimalDegrees-planetPertubations Jupiter jd =- let (a, _, v, _) = pertubationsQuantities jd- v' = toRadians v- dl = (0.3314-0.0103*a)*(sin v') - 0.0644*a*(cos v')- in DD dl-planetPertubations Saturn jd =- let (a, q, v, b) = pertubationsQuantities jd- q' = toRadians q- v' = toRadians v- b' = toRadians b- dl = (0.1609*a-0.0105)*(cos v') + (0.0182*a-0.8142)*(sin v') - 0.1488*(sin b')- - 0.0408*(sin $ 2*b') + 0.0856*(sin b')*(cos q') + 0.0813*(cos b')*(sin q')- in DD dl-planetPertubations _ _ = 0----- pertrubationsQuantities :: JulianDate-pertubationsQuantities jd =- let t = numberOfCenturies j1900 jd- a = t*0.2 + 0.1- p = DD $ 237.47555 + 3034.9061*t- q = DD $ 265.91650 + 1222.1139*t- v = 5*q - 2*p- b = q - p- in (a, q, v, b)----- | Calculate the planet's position-angle of the bright limb.--- It takes the planet's coordinates and the Sun's coordinates.--- Position-angle is the angle of the midpoint of the illuminated limb--- measured eastwards from the north point of the disk.-planetBrightLimbPositionAngle :: EquatorialCoordinates1 -> EquatorialCoordinates1 -> DecimalDegrees-planetBrightLimbPositionAngle (EC1 deltaP alphaP) (EC1 deltaS alphaS) =- let dAlpha = toRadians $ fromDecimalHours $ alphaS - alphaP- deltaP' = toRadians deltaP- deltaS' = toRadians deltaS- y = (cos deltaS')*(sin dAlpha)- x = (cos deltaP')*(sin deltaS') - (sin deltaP')*(cos deltaS')*(cos dAlpha)- chi = reduceDegrees $ fromRadians $ atan2 y x- in chi+{-| +Module: Data.Astro.Planet.PlanetMechanics +Description: Planet mechanics +Copyright: Alexander Ignatyev, 2016 + +Planet mechanics. +-} + +module Data.Astro.Planet.PlanetMechanics +( + planetMeanAnomaly + , planetTrueAnomaly1 + , planetTrueAnomaly2 + , planetHeliocentricRadiusVector + , planetHeliocentricLongitude + , planetHeliocentricLatitude + , planetProjectedRadiusVector + , planetProjectedLongitude + , planetEclipticLongitude + , planetEclipticLatitude + , planetPosition + , planetPosition1 + , planetDistance + , planetDistance1 + , planetAngularDiameter + , planetPhase1 + , planetPertubations + , planetBrightLimbPositionAngle +) + +where + +import qualified Data.Astro.Utils as U +import Data.Astro.Types (DecimalDegrees(..), AstronomicalUnits(..), toRadians, fromRadians, fromDecimalHours) +import Data.Astro.Time.Epoch (j1900) +import Data.Astro.Time.JulianDate (JulianDate, numberOfDays, numberOfCenturies) +import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..), eclipticToEquatorial) +import Data.Astro.Planet.PlanetDetails (Planet(..), PlanetDetails(..), isInnerPlanet) +import Data.Astro.Sun.SunInternals (solveKeplerEquation) + +{- +1. Calculate the planet position on its own orbital plane +2. Convert the planet's position to planetHeliocentric coordinates. +3. Convert from planetHeliocentric coordinates to ecliptic coordinates. +-} + + +-- | reduce DecimalDegrees to the range [0, 360) +reduceDegrees :: DecimalDegrees -> DecimalDegrees +reduceDegrees = U.reduceToZeroRange 360 + + +-- | Calculate the planet mean anomaly. +planetMeanAnomaly pd jd = + let d = numberOfDays (pdEpoch pd) jd + n = reduceDegrees $ DD $ (360/U.tropicalYearLen) * (d/(pdTp pd)) + in reduceDegrees $ n + (pdEpsilon pd) - (pdOmegaBar pd) + + +-- | Calculate the planet true anomaly using approximate method +planetTrueAnomaly1 pd jd = + let meanAnomaly = toRadians $ planetMeanAnomaly pd jd + e = pdE pd + in reduceDegrees $ fromRadians $ meanAnomaly + 2*e*(sin meanAnomaly) + + +-- | Calculate the planet true anomaly using the second 'more accurate' method +planetTrueAnomaly2 pd jd = + let meanAnomaly = toRadians $ planetMeanAnomaly pd jd + e = pdE pd + eccentricAnomaly = solveKeplerEquation e meanAnomaly 0.000000001 + trueAnomaly = 2 * atan (sqrt((1 + e) / (1 - e)) * tan (eccentricAnomaly / 2)) + in reduceDegrees $ fromRadians trueAnomaly + +-- | Calculate Heliocentric Longitude. +-- It takes Planet Details and true anomaly. +planetHeliocentricLongitude :: PlanetDetails -> DecimalDegrees -> DecimalDegrees +planetHeliocentricLongitude pd trueAnomaly = reduceDegrees $ (pdOmegaBar pd) + trueAnomaly + + +-- | Calculate Heliocentric Latitude. +-- It takes Planet Details and heliocentric longitude. +planetHeliocentricLatitude :: PlanetDetails -> DecimalDegrees -> DecimalDegrees +planetHeliocentricLatitude pd hcl = + let l' = toRadians hcl + i' = toRadians $ pdI pd + bigOmega' = toRadians $ pdBigOmega pd + in fromRadians $ asin $ (sin $ l' - bigOmega')*(sin i') + + +-- | Calculate Heliocentric Radius Vector. +-- It takes Planet Details and true anomaly. +planetHeliocentricRadiusVector :: PlanetDetails -> DecimalDegrees -> AstronomicalUnits +planetHeliocentricRadiusVector pd trueAnomaly = + let nu = toRadians trueAnomaly + AU alpha = pdAlpha pd + e = pdE pd + in AU $ alpha*(1 - e*e)/(1+e*(cos nu)) + + +-- | Calculate Heliocentric Longitude projected to the ecliptic. +-- It takes Planet Details and Heliocentric Longitude +planetProjectedLongitude :: PlanetDetails -> DecimalDegrees -> DecimalDegrees +planetProjectedLongitude pd hcl = + let hcl' = toRadians hcl + bigOmega = pdBigOmega pd + bigOmega' = toRadians $ bigOmega + i' = toRadians $ pdI pd + y = (sin $ hcl'-bigOmega')*(cos i') + x = (cos $ hcl'-bigOmega') + n = fromRadians $ atan2 y x + in n + bigOmega + + +-- | Calculate Heliocentric Radius Vector projected to the ecliptic. +-- It takes Planet Details, planetHeliocentric latitude and Radius Vector +planetProjectedRadiusVector :: PlanetDetails -> DecimalDegrees -> AstronomicalUnits -> AstronomicalUnits +planetProjectedRadiusVector pd psi (AU hcr) = AU $ hcr*cos(toRadians psi) + + +-- | Calculate ecliptic longitude for outer planets. +-- It takes planet projected longitude, planet projected radius vector +-- the Earth's longitude and radius vector. +outerPlanetEclipticLongitude :: DecimalDegrees -> AstronomicalUnits -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees +outerPlanetEclipticLongitude lp (AU rp) le (AU re) = + let lp' = toRadians lp + le' = toRadians le + x = atan $ re * (sin $ lp'-le')/(rp - re*(cos $ lp'-le')) + in reduceDegrees $ (fromRadians x) + lp + + +-- | Calculate ecliptic longitude for inner planets. +-- It takes planet projected longitude, planet projected radius vector +-- the Earth's longitude and radius vector. +innerPlanetEclipticLongitude :: DecimalDegrees -> AstronomicalUnits -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees +innerPlanetEclipticLongitude lp (AU rp) le (AU re) = + let lp' = toRadians lp + le' = toRadians le + x = atan $ rp * (sin $ le'-lp')/(re - rp*(cos $ le'-lp')) + in reduceDegrees $ (fromRadians x) + le + 180 + + +-- | Calculate Ecliptic Longitude. +-- It takes planet projected longitude, planet projected radius vector +-- the Earth's longitude and radius vector. +planetEclipticLongitude :: PlanetDetails -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees -> AstronomicalUnits -> DecimalDegrees +planetEclipticLongitude pd + | isInnerPlanet pd = innerPlanetEclipticLongitude + | otherwise = outerPlanetEclipticLongitude + + +-- | Calculate ecliptic Latitude. +-- It takes the planet's: heliocentric latitude, projected heliocentric longutide, +-- projected heliocentric longitude; +-- the Earth's: heliocentric longitede and heliocentric radius vector. +-- Also it takes the planet's ecliptic longitude. +planetEclipticLatitude :: DecimalDegrees + -> DecimalDegrees + -> AstronomicalUnits + -> DecimalDegrees + -> AstronomicalUnits + -> DecimalDegrees + -> DecimalDegrees +planetEclipticLatitude psi lp (AU rp) le (AU re) lambda = + let psi' = toRadians psi + lp' = toRadians lp + le' = toRadians le + lambda' = toRadians lambda + y = rp*(tan psi')*(sin $ lambda' - lp') + x = re * (sin $ lp' -le') + in fromRadians $ atan (y/x) + + +-- | Calculate the planet's postion at the given date. +-- It takes a function to calculate true anomaly, +-- planet details of the planet, planet details of the Earth +-- and JulianDate. +planetPosition :: (PlanetDetails -> JulianDate -> DecimalDegrees) + -> PlanetDetails -> PlanetDetails -> JulianDate + -> EquatorialCoordinates1 +planetPosition trueAnomaly pd ed jd = + -- planet + let nup = trueAnomaly pd jd + lp = planetHeliocentricLongitude pd nup + rp = planetHeliocentricRadiusVector pd nup + psi = planetHeliocentricLatitude pd lp + lp' = planetProjectedLongitude pd lp + rp' = planetProjectedRadiusVector pd psi rp + -- earth + nue = trueAnomaly ed jd + le = planetHeliocentricLongitude ed nue + re = planetHeliocentricRadiusVector ed nue + -- position + lambda = planetEclipticLongitude pd lp' rp' le re + beta = planetEclipticLatitude psi lp' rp' le re lambda + ec = eclipticToEquatorial (EcC beta lambda) jd + in ec + + +-- | Calculates the distance betweeth the planet and the Earth at the given date. +-- It takes a function to calculate true anomaly, +-- planet details of the planet, planet details of the Earth +-- and JulianDate. +planetDistance :: (PlanetDetails -> JulianDate -> DecimalDegrees) + -> PlanetDetails -> PlanetDetails -> JulianDate + -> AstronomicalUnits +planetDistance trueAnomaly pd ed jd = + let nup = trueAnomaly pd jd + lp = planetHeliocentricLongitude pd nup + AU rp = planetHeliocentricRadiusVector pd nup + psi = planetHeliocentricLatitude pd lp + -- earth + nue = trueAnomaly ed jd + le = planetHeliocentricLongitude ed nue + AU re = planetHeliocentricRadiusVector ed nue + -- distance + ro = sqrt $ re*re + rp*rp - 2*re*rp*(cos . toRadians $ lp - le)*(cos $ toRadians psi) + in AU ro + + +-- | Calculates the planet's angular diameter for the given distance. +planetAngularDiameter :: PlanetDetails -> AstronomicalUnits -> DecimalDegrees +planetAngularDiameter pd (AU ro) = (pdBigTheta pd)/(DD ro) + + +-- | Calculate the planet's phase at the given phase. +-- Phase is a fraction of the visible disc that is illuminated. +-- It takes the planet's details, the Earth's details and the julian date. +-- Returns fraction values from 0 to 1. +planetPhase1 :: PlanetDetails -> PlanetDetails -> JulianDate -> Double +planetPhase1 pd ed jd = + -- planet + let nup = planetTrueAnomaly1 pd jd + lp = planetHeliocentricLongitude pd nup + rp = planetHeliocentricRadiusVector pd nup + psi = planetHeliocentricLatitude pd lp + lp' = planetProjectedLongitude pd lp + rp' = planetProjectedRadiusVector pd psi rp + -- earth + nue = planetTrueAnomaly1 ed jd + le = planetHeliocentricLongitude ed nue + re = planetHeliocentricRadiusVector ed nue + + lambda = planetEclipticLongitude pd lp' rp' le re + d = toRadians $ lambda - lp + in (1+ (cos d)) * 0.5 + + +-- | Calculate the planet's postion at the given date using the approximate algoruthm. +-- It takes planet details of the planet, planet details of the Earth +-- and JulianDate. +planetPosition1 :: PlanetDetails -> PlanetDetails -> JulianDate + -> EquatorialCoordinates1 +planetPosition1 = planetPosition planetTrueAnomaly1 + + +-- | Calculates the distance betweeth the planet and the Earth at the given date +-- using the approximate algoruthm. +-- It takes planet details of the planet, planet details of the Earth +-- and JulianDate. +planetDistance1 :: PlanetDetails -> PlanetDetails -> JulianDate + -> AstronomicalUnits +planetDistance1 = planetDistance planetTrueAnomaly1 + + +-- | Calculates pertubations for the planet at the given julian date. +-- Returns a value that should be added to the mean longitude (planet heliocentric longitude). +planetPertubations :: Planet -> JulianDate -> DecimalDegrees +planetPertubations Jupiter jd = + let (a, _, v, _) = pertubationsQuantities jd + v' = toRadians v + dl = (0.3314-0.0103*a)*(sin v') - 0.0644*a*(cos v') + in DD dl +planetPertubations Saturn jd = + let (a, q, v, b) = pertubationsQuantities jd + q' = toRadians q + v' = toRadians v + b' = toRadians b + dl = (0.1609*a-0.0105)*(cos v') + (0.0182*a-0.8142)*(sin v') - 0.1488*(sin b') + - 0.0408*(sin $ 2*b') + 0.0856*(sin b')*(cos q') + 0.0813*(cos b')*(sin q') + in DD dl +planetPertubations _ _ = 0 + + +-- pertrubationsQuantities :: JulianDate +pertubationsQuantities jd = + let t = numberOfCenturies j1900 jd + a = t*0.2 + 0.1 + p = DD $ 237.47555 + 3034.9061*t + q = DD $ 265.91650 + 1222.1139*t + v = 5*q - 2*p + b = q - p + in (a, q, v, b) + + +-- | Calculate the planet's position-angle of the bright limb. +-- It takes the planet's coordinates and the Sun's coordinates. +-- Position-angle is the angle of the midpoint of the illuminated limb +-- measured eastwards from the north point of the disk. +planetBrightLimbPositionAngle :: EquatorialCoordinates1 -> EquatorialCoordinates1 -> DecimalDegrees +planetBrightLimbPositionAngle (EC1 deltaP alphaP) (EC1 deltaS alphaS) = + let dAlpha = toRadians $ fromDecimalHours $ alphaS - alphaP + deltaP' = toRadians deltaP + deltaS' = toRadians deltaS + y = (cos deltaS')*(sin dAlpha) + x = (cos deltaP')*(sin deltaS') - (sin deltaP')*(cos deltaS')*(cos dAlpha) + chi = reduceDegrees $ fromRadians $ atan2 y x + in chi
src/Data/Astro/Star.hs view
@@ -1,104 +1,104 @@-{-|-Module: Data.Astro.Star-Description: Stars-Copyright: Alexander Ignatyev, 2017--Stars.--= Examples--== /Location/--@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Star---ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0---- Calculate location of Betelgeuse--betelgeuseEC1 :: EquatorialCoordinates1-betelgeuseEC1 = starCoordinates Betelgeuse--- EC1 {e1Declination = DD 7.407064, e1RightAscension = DH 5.919529}--betelgeuseHC :: HorizonCoordinates-betelgeuseHC = ec1ToHC ro (lctUniversalTime dt) betelgeuseEC1--- HC {hAltitude = DD 38.30483892505852, hAzimuth = DD 136.75755644642248}-@--== /Rise and Set/--@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Effects-import Data.Astro.CelestialObject.RiseSet-import Data.Astro.Star---ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25---- Calculate location of Betelgeuse--rigelEC1 :: EquatorialCoordinates1-rigelEC1 = starCoordinates Rigel--verticalShift :: DecimalDegrees-verticalShift = refract (DD 0) 12 1012--- DD 0.5660098245614035--rigelRiseSet :: RiseSetLCT-rigelRiseSet = riseAndSetLCT ro today verticalShift rigelEC1--- RiseSet (2017-06-25 06:38:18.4713 +1.0,DD 102.51249855335433) (2017-06-25 17:20:33.4902 +1.0,DD 257.48750144664564)-@--}---module Data.Astro.Star-(- Star(..)- , starCoordinates-)--where--import Data.Astro.Coordinate (EquatorialCoordinates1(..))-import Data.Astro.Types (fromDMS, fromHMS)----- | Some of the stars-data Star = Polaris- | AlphaCrucis- | Sirius- | Betelgeuse- | Rigel- | Vega- | Antares- | Canopus- | Pleiades- deriving (Show, Eq)----- | Returns Equatorial Coordinates for the given star-starCoordinates :: Star -> EquatorialCoordinates1-starCoordinates Polaris = EC1 (fromDMS 89 15 51) (fromHMS 2 31 48.7)-starCoordinates AlphaCrucis = EC1 (-(fromDMS 63 5 56.73)) (fromHMS 12 26 35.9)-starCoordinates Sirius = EC1 (-(fromDMS 16 42 58.02)) (fromHMS 6 45 8.92)-starCoordinates Betelgeuse = EC1 (fromDMS 07 24 25.4304) (fromHMS 5 55 10.30536)-starCoordinates Rigel = EC1 (-(fromDMS 8 12 05.8981)) (fromHMS 5 14 32.27210)-starCoordinates Vega = EC1 (fromDMS 38 47 01.2802) (fromHMS 18 36 56.33635)-starCoordinates Antares = EC1 (-(fromDMS 26 25 55.2094)) (fromHMS 16 29 24.45970)-starCoordinates Canopus = EC1 (-(fromDMS 52 41 44.3810)) (fromHMS 6 23 57.10988)-starCoordinates Pleiades = EC1 (fromDMS 24 7 00) (fromHMS 3 47 24)+{-| +Module: Data.Astro.Star +Description: Stars +Copyright: Alexander Ignatyev, 2017 + +Stars. + += Examples + +== /Location/ + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Star + + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +-- Calculate location of Betelgeuse + +betelgeuseEC1 :: EquatorialCoordinates1 +betelgeuseEC1 = starCoordinates Betelgeuse +-- EC1 {e1Declination = DD 7.407064, e1RightAscension = DH 5.919529} + +betelgeuseHC :: HorizonCoordinates +betelgeuseHC = ec1ToHC ro (lctUniversalTime dt) betelgeuseEC1 +-- HC {hAltitude = DD 38.30483892505852, hAzimuth = DD 136.75755644642248} +@ + +== /Rise and Set/ + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Effects +import Data.Astro.CelestialObject.RiseSet +import Data.Astro.Star + + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +-- Calculate location of Betelgeuse + +rigelEC1 :: EquatorialCoordinates1 +rigelEC1 = starCoordinates Rigel + +verticalShift :: DecimalDegrees +verticalShift = refract (DD 0) 12 1012 +-- DD 0.5660098245614035 + +rigelRiseSet :: RiseSetLCT +rigelRiseSet = riseAndSetLCT ro today verticalShift rigelEC1 +-- RiseSet (2017-06-25 06:38:18.4713 +1.0,DD 102.51249855335433) (2017-06-25 17:20:33.4902 +1.0,DD 257.48750144664564) +@ +-} + + +module Data.Astro.Star +( + Star(..) + , starCoordinates +) + +where + +import Data.Astro.Coordinate (EquatorialCoordinates1(..)) +import Data.Astro.Types (fromDMS, fromHMS) + + +-- | Some of the stars +data Star = Polaris + | AlphaCrucis + | Sirius + | Betelgeuse + | Rigel + | Vega + | Antares + | Canopus + | Pleiades + deriving (Show, Eq) + + +-- | Returns Equatorial Coordinates for the given star +starCoordinates :: Star -> EquatorialCoordinates1 +starCoordinates Polaris = EC1 (fromDMS 89 15 51) (fromHMS 2 31 48.7) +starCoordinates AlphaCrucis = EC1 (-(fromDMS 63 5 56.73)) (fromHMS 12 26 35.9) +starCoordinates Sirius = EC1 (-(fromDMS 16 42 58.02)) (fromHMS 6 45 8.92) +starCoordinates Betelgeuse = EC1 (fromDMS 07 24 25.4304) (fromHMS 5 55 10.30536) +starCoordinates Rigel = EC1 (-(fromDMS 8 12 05.8981)) (fromHMS 5 14 32.27210) +starCoordinates Vega = EC1 (fromDMS 38 47 01.2802) (fromHMS 18 36 56.33635) +starCoordinates Antares = EC1 (-(fromDMS 26 25 55.2094)) (fromHMS 16 29 24.45970) +starCoordinates Canopus = EC1 (-(fromDMS 52 41 44.3810)) (fromHMS 6 23 57.10988) +starCoordinates Pleiades = EC1 (fromDMS 24 7 00) (fromHMS 3 47 24)
src/Data/Astro/Sun.hs view
@@ -1,252 +1,252 @@-{-|-Module: Data.Astro.Sun-Description: Calculation characteristics of the Sun-Copyright: Alexander Ignatyev, 2016--= Calculation characteristics of the Sun.--== /Terms/--* __perihelion__ - minimal distance from the Sun to the planet-* __aphelion__ - maximal distance from the Sun to the planet--* __perigee__ - minimal distance from the Sun to the Earth-* __apogee__ - maximal distance from the Sun to the Earth---= Example--@-import Data.Astro.Time.JulianDate-import Data.Astro.Coordinate-import Data.Astro.Types-import Data.Astro.Sun--ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--dt :: LocalCivilTime-dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--today :: LocalCivilDate-today = lcdFromYMD (DH 1) 2017 6 25--jd :: JulianDate-jd = lctUniversalTime dt--verticalShift :: DecimalDegrees-verticalShift = refract (DD 0) 12 1012---- distance from the Earth to the Sun in kilometres-distance :: Double-distance = sunDistance jd--- 1.5206375976421073e8---- Angular Size-angularSize :: DecimalDegrees-angularSize = sunAngularSize jd--- DD 0.5244849215333616---- The Sun's coordinates-ec1 :: EquatorialCoordinates1-ec1 = sunPosition2 jd--- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748}--hc :: HorizonCoordinates-hc = ec1ToHC ro jd ec1--- HC {hAltitude = DD 49.312050979507404, hAzimuth = DD 118.94723825710143}----- Rise and Set-riseSet :: RiseSetMB-riseSet = sunRiseAndSet ro 0.833333 today--- RiseSet--- (Just (2017-06-25 04:44:04.3304 +1.0,DD 49.043237261724215))--- (Just (2017-06-25 21:21:14.4565 +1.0,DD 310.91655607595595))-@--}--module Data.Astro.Sun-(- SunDetails(..)- , RiseSet(..)- , sunDetails- , j2010SunDetails- , sunMeanAnomaly2- , sunEclipticLongitude1- , sunEclipticLongitude2- , sunPosition1- , sunPosition2- , sunDistance- , sunAngularSize- , sunRiseAndSet- , equationOfTime- , solarElongation-)--where--import qualified Data.Astro.Utils as U-import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..)- , toDecimalHours, fromDecimalHours- , toRadians, fromRadians- , GeographicCoordinates(..) )-import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), LocalCivilDate(..), numberOfDays, numberOfCenturies, splitToDayAndTime, addHours)-import Data.Astro.Time.Sidereal (gstToUT, dhToGST)-import Data.Astro.Time.Epoch (j1900, j2010)-import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..), eclipticToEquatorial)-import Data.Astro.Effects.Nutation (nutationLongitude)-import Data.Astro.CelestialObject.RiseSet (RiseSet(..), RiseSetMB, RSInfo(..), riseAndSet2)-import Data.Astro.Sun.SunInternals (solveKeplerEquation)----- | Details of the Sun's apparent orbit at the given epoch-data SunDetails = SunDetails {- sdEpoch :: JulianDate -- ^ Epoch- , sdEpsilon :: DecimalDegrees -- ^ Ecliptic longitude at the Epoch- , sdOmega :: DecimalDegrees -- ^ Ecliptic longitude of perigee at the Epoch- , sdE :: Double -- ^ Eccentricity of the orbit at the Epoch- } deriving (Show)---- | SunDetails at the Sun's reference Epoch J2010.0-j2010SunDetails :: SunDetails-j2010SunDetails = SunDetails j2010 (DD 279.557208) (DD 283.112438) 0.016705----- | Semi-major axis-r0 :: Double-r0 = 1.495985e8----- | Angular diameter at r = r0-theta0 :: DecimalDegrees-theta0 = DD 0.533128----- | Reduce the value to the range [0, 360)-reduceTo360 :: Double -> Double-reduceTo360 = U.reduceToZeroRange 360----- | Reduce the value to the range [0, 360)-reduceDegrees :: DecimalDegrees -> DecimalDegrees-reduceDegrees = U.reduceToZeroRange 360----- | Calculate SunDetails for the given JulianDate.-sunDetails :: JulianDate -> SunDetails-sunDetails jd =- let t = numberOfCenturies j1900 jd- epsilon = reduceTo360 $ 279.6966778 + 36000.76892*t + 0.0003025*t*t- omega = reduceTo360 $ 281.2208444 + 1.719175*t + 0.000452778*t*t- e = 0.01675104 - 0.0000418*t - 0.000000126*t*t- in SunDetails jd (DD epsilon) (DD omega) e----- | Calculate the ecliptic longitude of the Sun with the given SunDetails at the given JulianDate-sunEclipticLongitude1 :: SunDetails -> JulianDate -> DecimalDegrees-sunEclipticLongitude1 sd@(SunDetails epoch (DD eps) (DD omega) e) jd =- let d = numberOfDays epoch jd- n = reduceTo360 $ (360/U.tropicalYearLen) * d- meanAnomaly = reduceTo360 $ n + eps - omega- ec = (360/pi)*e*(sin $ U.toRadians meanAnomaly)- DD nutation = nutationLongitude jd- in DD $ reduceTo360 $ n + ec + eps + nutation----- | Calculate Equatorial Coordinates of the Sun with the given SunDetails at the given JulianDate.--- It is recommended to use 'j2010SunDetails' as a first parameter.-sunPosition1 :: SunDetails -> JulianDate -> EquatorialCoordinates1-sunPosition1 sd jd =- let lambda = sunEclipticLongitude1 sd jd- beta = DD 0- in eclipticToEquatorial (EcC beta lambda) jd----- | Calculate mean anomaly using the second 'more accurate' method-sunMeanAnomaly2 :: SunDetails -> DecimalDegrees-sunMeanAnomaly2 sd = reduceDegrees $ (sdEpsilon sd) - (sdOmega sd)----- | Calculate true anomaly using the second 'more accurate' method-trueAnomaly2 :: SunDetails -> DecimalDegrees-trueAnomaly2 sd =- let m = toRadians $ sunMeanAnomaly2 sd- e = sdE sd- bigE = solveKeplerEquation e m 0.000000001- tanHalfNu = sqrt((1+e)/(1-e)) * tan (0.5 * bigE)- nu = reduceTo360 $ U.fromRadians $ 2 * (atan tanHalfNu)- in DD nu----- | Calculate the ecliptic longitude of the Sun-sunEclipticLongitude2 :: SunDetails -> DecimalDegrees-sunEclipticLongitude2 sd =- let DD omega = sdOmega sd- DD nu = trueAnomaly2 sd- DD nutation = nutationLongitude $ sdEpoch sd- in DD $ reduceTo360 $ nu + omega + nutation----- | More accurate method to calculate position of the Sun-sunPosition2 :: JulianDate -> EquatorialCoordinates1-sunPosition2 jd =- let sd = sunDetails jd- lambda = sunEclipticLongitude2 sd- beta = DD 0- in eclipticToEquatorial (EcC beta lambda) jd----- Distance and Angular Size helper function-dasf sd =- let e = sdE sd- nu = toRadians $ trueAnomaly2 sd- in (1 + e*(cos nu)) / (1 - e*e)----- | Calculate Sun-Earth distance.-sunDistance :: JulianDate -> Double-sunDistance jd = r0 / (dasf $ sunDetails jd)----- | Calculate the Sun's angular size (i.e. its angular diameter).-sunAngularSize :: JulianDate -> DecimalDegrees-sunAngularSize jd = theta0 * (DD $ dasf $ sunDetails jd)----- | Calculatesthe Sun's rise and set--- It takes coordinates of the observer,--- local civil date,--- vertical shift (good value is 0.833333).--- It returns Nothing if fails to calculate rise and/or set.--- It should be accurate to within a minute of time.-sunRiseAndSet :: GeographicCoordinates- -> DecimalDegrees- -> LocalCivilDate- -> RiseSetMB-sunRiseAndSet = riseAndSet2 0.000001 (sunPosition1 j2010SunDetails)----- | Calculates discrepancy between the mean solar time and real solar time--- at the given date.-equationOfTime :: JulianDate -> DecimalHours-equationOfTime jd =- let (day, _) = splitToDayAndTime jd- midday = addHours (DH 12) day -- mean solar time- EC1 _ ra = sunPosition1 j2010SunDetails midday- ut = gstToUT day $ dhToGST ra- JD time = midday - ut- in DH $ time*24----- | Calculates the angle between the lines of sight to the Sun and to a celestial object--- specified by the given coordinates at the given Universal Time.-solarElongation :: EquatorialCoordinates1 -> JulianDate -> DecimalDegrees-solarElongation (EC1 deltaP alphaP) jd =- let (EC1 deltaS alphaS) = sunPosition1 j2010SunDetails jd- deltaP' = toRadians deltaP- alphaP' = toRadians $ fromDecimalHours alphaP- deltaS' = toRadians deltaS- alphaS' = toRadians $ fromDecimalHours alphaS- eps = acos $ (sin deltaP')*(sin deltaS') + (cos $ alphaP' - alphaS')*(cos deltaP')*(cos deltaS')- in fromRadians eps+{-| +Module: Data.Astro.Sun +Description: Calculation characteristics of the Sun +Copyright: Alexander Ignatyev, 2016 + += Calculation characteristics of the Sun. + +== /Terms/ + +* __perihelion__ - minimal distance from the Sun to the planet +* __aphelion__ - maximal distance from the Sun to the planet + +* __perigee__ - minimal distance from the Sun to the Earth +* __apogee__ - maximal distance from the Sun to the Earth + + += Example + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Coordinate +import Data.Astro.Types +import Data.Astro.Sun + +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) + +dt :: LocalCivilTime +dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 + +today :: LocalCivilDate +today = lcdFromYMD (DH 1) 2017 6 25 + +jd :: JulianDate +jd = lctUniversalTime dt + +verticalShift :: DecimalDegrees +verticalShift = refract (DD 0) 12 1012 + +-- distance from the Earth to the Sun in kilometres +distance :: Double +distance = sunDistance jd +-- 1.5206375976421073e8 + +-- Angular Size +angularSize :: DecimalDegrees +angularSize = sunAngularSize jd +-- DD 0.5244849215333616 + +-- The Sun's coordinates +ec1 :: EquatorialCoordinates1 +ec1 = sunPosition2 jd +-- EC1 {e1Declination = DD 23.37339098989099, e1RightAscension = DH 6.29262026252748} + +hc :: HorizonCoordinates +hc = ec1ToHC ro jd ec1 +-- HC {hAltitude = DD 49.312050979507404, hAzimuth = DD 118.94723825710143} + + +-- Rise and Set +riseSet :: RiseSetMB +riseSet = sunRiseAndSet ro 0.833333 today +-- RiseSet +-- (Just (2017-06-25 04:44:04.3304 +1.0,DD 49.043237261724215)) +-- (Just (2017-06-25 21:21:14.4565 +1.0,DD 310.91655607595595)) +@ +-} + +module Data.Astro.Sun +( + SunDetails(..) + , RiseSet(..) + , sunDetails + , j2010SunDetails + , sunMeanAnomaly2 + , sunEclipticLongitude1 + , sunEclipticLongitude2 + , sunPosition1 + , sunPosition2 + , sunDistance + , sunAngularSize + , sunRiseAndSet + , equationOfTime + , solarElongation +) + +where + +import qualified Data.Astro.Utils as U +import Data.Astro.Types (DecimalDegrees(..), DecimalHours(..) + , toDecimalHours, fromDecimalHours + , toRadians, fromRadians + , GeographicCoordinates(..) ) +import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), LocalCivilDate(..), numberOfDays, numberOfCenturies, splitToDayAndTime, addHours) +import Data.Astro.Time.Sidereal (gstToUT, dhToGST) +import Data.Astro.Time.Epoch (j1900, j2010) +import Data.Astro.Coordinate (EquatorialCoordinates1(..), EclipticCoordinates(..), eclipticToEquatorial) +import Data.Astro.Effects.Nutation (nutationLongitude) +import Data.Astro.CelestialObject.RiseSet (RiseSet(..), RiseSetMB, RSInfo(..), riseAndSet2) +import Data.Astro.Sun.SunInternals (solveKeplerEquation) + + +-- | Details of the Sun's apparent orbit at the given epoch +data SunDetails = SunDetails { + sdEpoch :: JulianDate -- ^ Epoch + , sdEpsilon :: DecimalDegrees -- ^ Ecliptic longitude at the Epoch + , sdOmega :: DecimalDegrees -- ^ Ecliptic longitude of perigee at the Epoch + , sdE :: Double -- ^ Eccentricity of the orbit at the Epoch + } deriving (Show) + +-- | SunDetails at the Sun's reference Epoch J2010.0 +j2010SunDetails :: SunDetails +j2010SunDetails = SunDetails j2010 (DD 279.557208) (DD 283.112438) 0.016705 + + +-- | Semi-major axis +r0 :: Double +r0 = 1.495985e8 + + +-- | Angular diameter at r = r0 +theta0 :: DecimalDegrees +theta0 = DD 0.533128 + + +-- | Reduce the value to the range [0, 360) +reduceTo360 :: Double -> Double +reduceTo360 = U.reduceToZeroRange 360 + + +-- | Reduce the value to the range [0, 360) +reduceDegrees :: DecimalDegrees -> DecimalDegrees +reduceDegrees = U.reduceToZeroRange 360 + + +-- | Calculate SunDetails for the given JulianDate. +sunDetails :: JulianDate -> SunDetails +sunDetails jd = + let t = numberOfCenturies j1900 jd + epsilon = reduceTo360 $ 279.6966778 + 36000.76892*t + 0.0003025*t*t + omega = reduceTo360 $ 281.2208444 + 1.719175*t + 0.000452778*t*t + e = 0.01675104 - 0.0000418*t - 0.000000126*t*t + in SunDetails jd (DD epsilon) (DD omega) e + + +-- | Calculate the ecliptic longitude of the Sun with the given SunDetails at the given JulianDate +sunEclipticLongitude1 :: SunDetails -> JulianDate -> DecimalDegrees +sunEclipticLongitude1 sd@(SunDetails epoch (DD eps) (DD omega) e) jd = + let d = numberOfDays epoch jd + n = reduceTo360 $ (360/U.tropicalYearLen) * d + meanAnomaly = reduceTo360 $ n + eps - omega + ec = (360/pi)*e*(sin $ U.toRadians meanAnomaly) + DD nutation = nutationLongitude jd + in DD $ reduceTo360 $ n + ec + eps + nutation + + +-- | Calculate Equatorial Coordinates of the Sun with the given SunDetails at the given JulianDate. +-- It is recommended to use 'j2010SunDetails' as a first parameter. +sunPosition1 :: SunDetails -> JulianDate -> EquatorialCoordinates1 +sunPosition1 sd jd = + let lambda = sunEclipticLongitude1 sd jd + beta = DD 0 + in eclipticToEquatorial (EcC beta lambda) jd + + +-- | Calculate mean anomaly using the second 'more accurate' method +sunMeanAnomaly2 :: SunDetails -> DecimalDegrees +sunMeanAnomaly2 sd = reduceDegrees $ (sdEpsilon sd) - (sdOmega sd) + + +-- | Calculate true anomaly using the second 'more accurate' method +trueAnomaly2 :: SunDetails -> DecimalDegrees +trueAnomaly2 sd = + let m = toRadians $ sunMeanAnomaly2 sd + e = sdE sd + bigE = solveKeplerEquation e m 0.000000001 + tanHalfNu = sqrt((1+e)/(1-e)) * tan (0.5 * bigE) + nu = reduceTo360 $ U.fromRadians $ 2 * (atan tanHalfNu) + in DD nu + + +-- | Calculate the ecliptic longitude of the Sun +sunEclipticLongitude2 :: SunDetails -> DecimalDegrees +sunEclipticLongitude2 sd = + let DD omega = sdOmega sd + DD nu = trueAnomaly2 sd + DD nutation = nutationLongitude $ sdEpoch sd + in DD $ reduceTo360 $ nu + omega + nutation + + +-- | More accurate method to calculate position of the Sun +sunPosition2 :: JulianDate -> EquatorialCoordinates1 +sunPosition2 jd = + let sd = sunDetails jd + lambda = sunEclipticLongitude2 sd + beta = DD 0 + in eclipticToEquatorial (EcC beta lambda) jd + + +-- Distance and Angular Size helper function +dasf sd = + let e = sdE sd + nu = toRadians $ trueAnomaly2 sd + in (1 + e*(cos nu)) / (1 - e*e) + + +-- | Calculate Sun-Earth distance. +sunDistance :: JulianDate -> Double +sunDistance jd = r0 / (dasf $ sunDetails jd) + + +-- | Calculate the Sun's angular size (i.e. its angular diameter). +sunAngularSize :: JulianDate -> DecimalDegrees +sunAngularSize jd = theta0 * (DD $ dasf $ sunDetails jd) + + +-- | Calculatesthe Sun's rise and set +-- It takes coordinates of the observer, +-- local civil date, +-- vertical shift (good value is 0.833333). +-- It returns Nothing if fails to calculate rise and/or set. +-- It should be accurate to within a minute of time. +sunRiseAndSet :: GeographicCoordinates + -> DecimalDegrees + -> LocalCivilDate + -> RiseSetMB +sunRiseAndSet = riseAndSet2 0.000001 (sunPosition1 j2010SunDetails) + + +-- | Calculates discrepancy between the mean solar time and real solar time +-- at the given date. +equationOfTime :: JulianDate -> DecimalHours +equationOfTime jd = + let (day, _) = splitToDayAndTime jd + midday = addHours (DH 12) day -- mean solar time + EC1 _ ra = sunPosition1 j2010SunDetails midday + ut = gstToUT day $ dhToGST ra + JD time = midday - ut + in DH $ time*24 + + +-- | Calculates the angle between the lines of sight to the Sun and to a celestial object +-- specified by the given coordinates at the given Universal Time. +solarElongation :: EquatorialCoordinates1 -> JulianDate -> DecimalDegrees +solarElongation (EC1 deltaP alphaP) jd = + let (EC1 deltaS alphaS) = sunPosition1 j2010SunDetails jd + deltaP' = toRadians deltaP + alphaP' = toRadians $ fromDecimalHours alphaP + deltaS' = toRadians deltaS + alphaS' = toRadians $ fromDecimalHours alphaS + eps = acos $ (sin deltaP')*(sin deltaS') + (cos $ alphaP' - alphaS')*(cos deltaP')*(cos deltaS') + in fromRadians eps
src/Data/Astro/Sun/SunInternals.hs view
@@ -1,28 +1,28 @@-{-|-Module: Data.Astro.Sun.SunInternals-Description: Internal functions of Sun module.-Copyright: Alexander Ignatyev, 2016--Internal functions of Sun module. Exposed only for Unit Tests--}--module Data.Astro.Sun.SunInternals-(- solveKeplerEquation-)--where----- | Solve Kepler's Equation: E - e * (sin E) = M--- It takes eccentricity,--- mean anomaly in radians equals epsilon - omega (see 'SunDetails').--- It returns E in radians.-solveKeplerEquation :: Double -> Double -> Double -> Double-solveKeplerEquation e m eps = iter m- where iter x =- let delta = x - e*(sin x) - m- dx = delta / (1 - e*(cos x))- in if abs delta < eps- then x- else iter (x-dx)+{-| +Module: Data.Astro.Sun.SunInternals +Description: Internal functions of Sun module. +Copyright: Alexander Ignatyev, 2016 + +Internal functions of Sun module. Exposed only for Unit Tests +-} + +module Data.Astro.Sun.SunInternals +( + solveKeplerEquation +) + +where + + +-- | Solve Kepler's Equation: E - e * (sin E) = M +-- It takes eccentricity, +-- mean anomaly in radians equals epsilon - omega (see 'SunDetails'). +-- It returns E in radians. +solveKeplerEquation :: Double -> Double -> Double -> Double +solveKeplerEquation e m eps = iter m + where iter x = + let delta = x - e*(sin x) - m + dx = delta / (1 - e*(cos x)) + in if abs delta < eps + then x + else iter (x-dx)
src/Data/Astro/Time.hs view
@@ -1,60 +1,60 @@-{-|-Module: Data.Astro.Time-Description: Time-Copyright: Alexander Ignatyev, 2016--Root Time module--}---module Data.Astro.Time-(- utToLST- , lctToLST- , lstToLCT-)--where--import Data.Astro.Types (DecimalDegrees)-import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), LocalCivilDate(..), splitToDayAndTime, addHours)-import Data.Astro.Time.Sidereal (LocalSiderealTime, utToGST, gstToUT, gstToLST, lstToGST, lstToGSTwDC)----- | Universal Time to Local Sidereal Time.--- It takes longitude in decimal degrees and local civil time-utToLST :: DecimalDegrees -> JulianDate -> LocalSiderealTime-utToLST longitude ut = gstToLST longitude $ utToGST ut----- | Local Civil Time to Local Sidereal Time.--- It takes longitude in decimal degrees and local civil time-lctToLST :: DecimalDegrees -> LocalCivilTime -> LocalSiderealTime-lctToLST longitude lct = utToLST longitude $ lctUniversalTime lct----- | Local Sidereal Time to Local Civil Time.--- It takes longitude in decimal degrees, local civil date and local sidereal time-lstToLCT :: DecimalDegrees -> LocalCivilDate -> LocalSiderealTime -> LocalCivilTime-lstToLCT longitude lcd lst =- let gst = lstToGST longitude lst- ut = gstToUT (lcdDate lcd) gst- lct = LCT (lcdTimeZone lcd) ut- in if sameDay lcd lct- then lct -- lstToLCTwDC longitude timeZone jd lst- else lstToLCTwDC longitude lcd lst---lstToLCTwDC :: DecimalDegrees -> LocalCivilDate -> LocalSiderealTime -> LocalCivilTime-lstToLCTwDC longitude lcd lst =- let gst = lstToGSTwDC longitude lst- ut = gstToUT (lcdDate lcd) gst- lct = LCT (lcdTimeZone lcd) ut- in lct----- | Returns True if both JulianDates hve the same day-sameDay :: LocalCivilDate -> LocalCivilTime -> Bool-sameDay (LCD _ (JD d1)) (LCT tz jd2) =- let (JD d2, _) = splitToDayAndTime $ addHours tz jd2- in abs (d1 - d2) < 0.000001+{-| +Module: Data.Astro.Time +Description: Time +Copyright: Alexander Ignatyev, 2016 + +Root Time module +-} + + +module Data.Astro.Time +( + utToLST + , lctToLST + , lstToLCT +) + +where + +import Data.Astro.Types (DecimalDegrees) +import Data.Astro.Time.JulianDate (JulianDate(..), LocalCivilTime(..), LocalCivilDate(..), splitToDayAndTime, addHours) +import Data.Astro.Time.Sidereal (LocalSiderealTime, utToGST, gstToUT, gstToLST, lstToGST, lstToGSTwDC) + + +-- | Universal Time to Local Sidereal Time. +-- It takes longitude in decimal degrees and local civil time +utToLST :: DecimalDegrees -> JulianDate -> LocalSiderealTime +utToLST longitude ut = gstToLST longitude $ utToGST ut + + +-- | Local Civil Time to Local Sidereal Time. +-- It takes longitude in decimal degrees and local civil time +lctToLST :: DecimalDegrees -> LocalCivilTime -> LocalSiderealTime +lctToLST longitude lct = utToLST longitude $ lctUniversalTime lct + + +-- | Local Sidereal Time to Local Civil Time. +-- It takes longitude in decimal degrees, local civil date and local sidereal time +lstToLCT :: DecimalDegrees -> LocalCivilDate -> LocalSiderealTime -> LocalCivilTime +lstToLCT longitude lcd lst = + let gst = lstToGST longitude lst + ut = gstToUT (lcdDate lcd) gst + lct = LCT (lcdTimeZone lcd) ut + in if sameDay lcd lct + then lct -- lstToLCTwDC longitude timeZone jd lst + else lstToLCTwDC longitude lcd lst + + +lstToLCTwDC :: DecimalDegrees -> LocalCivilDate -> LocalSiderealTime -> LocalCivilTime +lstToLCTwDC longitude lcd lst = + let gst = lstToGSTwDC longitude lst + ut = gstToUT (lcdDate lcd) gst + lct = LCT (lcdTimeZone lcd) ut + in lct + + +-- | Returns True if both JulianDates hve the same day +sameDay :: LocalCivilDate -> LocalCivilTime -> Bool +sameDay (LCD _ (JD d1)) (LCT tz jd2) = + let (JD d2, _) = splitToDayAndTime $ addHours tz jd2 + in abs (d1 - d2) < 0.000001
src/Data/Astro/Time/Conv.hs view
@@ -1,74 +1,74 @@-{-|-Module: Data.Astro.Time.Conv-Description: Julian Date-Copyright: Alexander Ignatyev, 2017---Conversion functions between datetime types defined in Data.Time and Data.Astro.Time modules.--}-module Data.Astro.Time.Conv-(- zonedTimeToLCT- , zonedTimeToLCD- , lctToZonedTime-)--where---import Data.Time.LocalTime (ZonedTime(..), LocalTime(..)- , TimeOfDay(..), TimeZone(..)- , minutesToTimeZone)-import Data.Time.Calendar (toGregorian, fromGregorian)--import Data.Astro.Types(DecimalHours(..))-import Data.Astro.Utils (fromFixed)-import Data.Astro.Time.JulianDate (JulianDate(..)- , LocalCivilTime(..)- , LocalCivilDate(..)- , fromYMDHMS, toYMDHMS- , lctFromYMDHMS, lcdFromYMD- , lctToYMDHMS)----------------------------------------------------------------- Data.Time types -> Data.Astro types-timeZoneToDH :: TimeZone -> DecimalHours-timeZoneToDH tz = DH hours- where toMinutes = fromIntegral . timeZoneMinutes- hours = (toMinutes tz) / 60.0----- | Convert ZonedTime to LocalCivilTime-zonedTimeToLCT :: ZonedTime -> LocalCivilTime-zonedTimeToLCT zonedTime = lctFromYMDHMS tz y m d hours mins (fromFixed secs)- where tz = timeZoneToDH (zonedTimeZone zonedTime)- lt = zonedTimeToLocalTime zonedTime- (y, m, d) = toGregorian (localDay lt)- TimeOfDay hours mins secs = localTimeOfDay lt----- | Convert ZonedTime to LocalCivilDate-zonedTimeToLCD :: ZonedTime -> LocalCivilDate-zonedTimeToLCD zonedTime = lcdFromYMD tz y m d- where tz = timeZoneToDH (zonedTimeZone zonedTime)- lt = zonedTimeToLocalTime zonedTime- (y, m, d) = toGregorian (localDay lt)----------------------------------------------------------------- Data.Astro Types -> Data.Time types--dhToTimeZone :: DecimalHours -> TimeZone-dhToTimeZone (DH hours) = minutesToTimeZone minutes- where minutes = round (60*hours)----- | Convert LocalCivilTime to ZonedTime-lctToZonedTime :: LocalCivilTime -> ZonedTime-lctToZonedTime lct = ZonedTime { zonedTimeToLocalTime = lt, zonedTimeZone = tz }- where tz = dhToTimeZone $ lctTimeZone lct- (y, m, d, hours, mins, secs) = lctToYMDHMS lct- day = fromGregorian y m d- time = TimeOfDay hours mins (realToFrac secs)- lt = LocalTime { localDay = day, localTimeOfDay = time }+{-| +Module: Data.Astro.Time.Conv +Description: Julian Date +Copyright: Alexander Ignatyev, 2017 + + +Conversion functions between datetime types defined in Data.Time and Data.Astro.Time modules. +-} +module Data.Astro.Time.Conv +( + zonedTimeToLCT + , zonedTimeToLCD + , lctToZonedTime +) + +where + + +import Data.Time.LocalTime (ZonedTime(..), LocalTime(..) + , TimeOfDay(..), TimeZone(..) + , minutesToTimeZone) +import Data.Time.Calendar (toGregorian, fromGregorian) + +import Data.Astro.Types(DecimalHours(..)) +import Data.Astro.Utils (fromFixed) +import Data.Astro.Time.JulianDate (JulianDate(..) + , LocalCivilTime(..) + , LocalCivilDate(..) + , fromYMDHMS, toYMDHMS + , lctFromYMDHMS, lcdFromYMD + , lctToYMDHMS) + + +----------------------------------------------------------- +-- Data.Time types -> Data.Astro types +timeZoneToDH :: TimeZone -> DecimalHours +timeZoneToDH tz = DH hours + where toMinutes = fromIntegral . timeZoneMinutes + hours = (toMinutes tz) / 60.0 + + +-- | Convert ZonedTime to LocalCivilTime +zonedTimeToLCT :: ZonedTime -> LocalCivilTime +zonedTimeToLCT zonedTime = lctFromYMDHMS tz y m d hours mins (fromFixed secs) + where tz = timeZoneToDH (zonedTimeZone zonedTime) + lt = zonedTimeToLocalTime zonedTime + (y, m, d) = toGregorian (localDay lt) + TimeOfDay hours mins secs = localTimeOfDay lt + + +-- | Convert ZonedTime to LocalCivilDate +zonedTimeToLCD :: ZonedTime -> LocalCivilDate +zonedTimeToLCD zonedTime = lcdFromYMD tz y m d + where tz = timeZoneToDH (zonedTimeZone zonedTime) + lt = zonedTimeToLocalTime zonedTime + (y, m, d) = toGregorian (localDay lt) + + +----------------------------------------------------------- +-- Data.Astro Types -> Data.Time types + +dhToTimeZone :: DecimalHours -> TimeZone +dhToTimeZone (DH hours) = minutesToTimeZone minutes + where minutes = round (60*hours) + + +-- | Convert LocalCivilTime to ZonedTime +lctToZonedTime :: LocalCivilTime -> ZonedTime +lctToZonedTime lct = ZonedTime { zonedTimeToLocalTime = lt, zonedTimeZone = tz } + where tz = dhToTimeZone $ lctTimeZone lct + (y, m, d, hours, mins, secs) = lctToYMDHMS lct + day = fromGregorian y m d + time = TimeOfDay hours mins (realToFrac secs) + lt = LocalTime { localDay = day, localTimeOfDay = time }
src/Data/Astro/Time/Epoch.hs view
@@ -1,51 +1,51 @@-{-|-Module: Data.Astro.Time.Epoch-Description: Astronomical Epochs-Copyright: Alexander Ignatyev, 2016--Definitions of well-known astronomical epochs.--}-module Data.Astro.Time.Epoch-(- -- * Epochs- -- ** Besselian Epochs- b1900- , b1950- -- ** New Epochs- , j1900- , j2000- , j2050- -- ** Well-known epochs- , j2010-)--where---import Data.Astro.Time.JulianDate (JulianDate(..))---- | Epoch B1900.0, 1900 January 0.8135-b1900 :: JulianDate-b1900 = JD 2415020.3135---- | Epoch B1950.0, January 0.9235-b1950 :: JulianDate-b1950 = JD 2433282.4235----- | Epoch J1900.0 1900 January 0.5-j1900 :: JulianDate-j1900 = JD 2415020.0---- | Epoch J2000.0, 12h on 1 January 2000-j2000 :: JulianDate-j2000 = JD 2451545.0---- | Epoch J2050.0, 12h on 1 January 2000-j2050 :: JulianDate-j2050 = JD 2469807.50----- | The Sun's and planets reference Epoch J2010.0 (2010 January 0.0)-j2010 :: JulianDate-j2010 = JD 2455196.5+{-| +Module: Data.Astro.Time.Epoch +Description: Astronomical Epochs +Copyright: Alexander Ignatyev, 2016 + +Definitions of well-known astronomical epochs. +-} +module Data.Astro.Time.Epoch +( + -- * Epochs + -- ** Besselian Epochs + b1900 + , b1950 + -- ** New Epochs + , j1900 + , j2000 + , j2050 + -- ** Well-known epochs + , j2010 +) + +where + + +import Data.Astro.Time.JulianDate (JulianDate(..)) + +-- | Epoch B1900.0, 1900 January 0.8135 +b1900 :: JulianDate +b1900 = JD 2415020.3135 + +-- | Epoch B1950.0, 1950 January 0.9235 +b1950 :: JulianDate +b1950 = JD 2433282.4235 + + +-- | Epoch J1900.0 1900 January 0.5 +j1900 :: JulianDate +j1900 = JD 2415020.0 + +-- | Epoch J2000.0, 12h on 1 January 2000 +j2000 :: JulianDate +j2000 = JD 2451545.0 + +-- | Epoch J2050.0, 0h on 1 January 2050 +j2050 :: JulianDate +j2050 = JD 2469807.50 + + +-- | The Sun's and planets reference Epoch J2010.0 (2010 January 0.0) +j2010 :: JulianDate +j2010 = JD 2455196.5
src/Data/Astro/Time/GregorianCalendar.hs view
@@ -1,86 +1,86 @@-{-|-Module: Data.Astro.Time.GregorianCalendar-Description: Gregorian Calendar-Copyright: Alexander Ignatyev, 2016---Gregorian Calendar was introduced by Pope Gregory XIII.-He abolished the days 1582-10-05 to 1582-10-14 inclusive to bring back civil and tropical years back to line.--}--module Data.Astro.Time.GregorianCalendar-(- isLeapYear- , dayNumber- , easterDayInYear- , gregorianDateAdjustment-)--where--import Data.Time.Calendar (Day(..), fromGregorian, toGregorian)---- Date after 15 October 1582 belongs to Gregorian Calendar--- Before this date - to Julian Calendar-isGregorianDate :: Integer -> Int -> Int -> Bool-isGregorianDate y m d = y > gyear- || (y == gyear && m > gmonth)- || (y == gyear && m == gmonth && d >= gday)- where gyear = 1582- gmonth = 10- gday = 15---gregorianDateAdjustment :: Integer -> Int ->Int -> Int-gregorianDateAdjustment year month day =- if isGregorianDate year month day- then let y = if month < 3 then year - 1 else year- y' = fromIntegral y- a = truncate (y' / 100)- in 2 - a + truncate(fromIntegral a/4)- else 0----- | Check Gregorian calendar leap year-isLeapYear :: Integer -> Bool-isLeapYear year =- year `mod` 4 == 0- && (year `mod` 100 /= 0 || year `mod` 400 == 0)----- | Day Number in a year-dayNumber :: Day -> Int-dayNumber date =- (daysBeforeMonth year month) + day- where (year, month, day) = toGregorian date----- | Get Easter date--- function uses absolutely crazy Butcher's algorithm-easterDayInYear :: Int -> Day-easterDayInYear year =- let a = year `mod` 19- b = year `div` 100- c = year `mod` 100- d = b `div` 4- e = b `mod` 4- f = (b+8) `div` 25- g = (b-f+1) `div` 3- h = (19*a+b-d-g+15) `mod` 30- i = c `div` 4- k = c `mod` 4- l = (32+2*e+2*i-h-k) `mod` 7- m = (a+11*h+22*l) `div` 451- n' = (h+l-7*m+114)- n = n' `div` 31- p = n' `mod` 31- in fromGregorian (fromIntegral year) n (p+1)---daysBeforeMonth :: Integer -> Int -> Int-daysBeforeMonth year month =- let a = if isLeapYear year then 62 else 63- month' = (fromIntegral month) :: Double- in if month > 2 then- truncate $ ((month' + 1.0) * 30.6) - a- else truncate $ (month' - 1.0)*a*0.5+{-| +Module: Data.Astro.Time.GregorianCalendar +Description: Gregorian Calendar +Copyright: Alexander Ignatyev, 2016 + + +Gregorian Calendar was introduced by Pope Gregory XIII. +He abolished the days 1582-10-05 to 1582-10-14 inclusive to bring back civil and tropical years back to line. +-} + +module Data.Astro.Time.GregorianCalendar +( + isLeapYear + , dayNumber + , easterDayInYear + , gregorianDateAdjustment +) + +where + +import Data.Time.Calendar (Day(..), fromGregorian, toGregorian) + +-- Date after 15 October 1582 belongs to Gregorian Calendar +-- Before this date - to Julian Calendar +isGregorianDate :: Integer -> Int -> Int -> Bool +isGregorianDate y m d = y > gyear + || (y == gyear && m > gmonth) + || (y == gyear && m == gmonth && d >= gday) + where gyear = 1582 + gmonth = 10 + gday = 15 + + +gregorianDateAdjustment :: Integer -> Int ->Int -> Int +gregorianDateAdjustment year month day = + if isGregorianDate year month day + then let y = if month < 3 then year - 1 else year + y' = fromIntegral y + a = truncate (y' / 100) + in 2 - a + truncate(fromIntegral a/4) + else 0 + + +-- | Check Gregorian calendar leap year +isLeapYear :: Integer -> Bool +isLeapYear year = + year `mod` 4 == 0 + && (year `mod` 100 /= 0 || year `mod` 400 == 0) + + +-- | Day Number in a year +dayNumber :: Day -> Int +dayNumber date = + (daysBeforeMonth year month) + day + where (year, month, day) = toGregorian date + + +-- | Get Easter date +-- function uses absolutely crazy Butcher's algorithm +easterDayInYear :: Int -> Day +easterDayInYear year = + let a = year `mod` 19 + b = year `div` 100 + c = year `mod` 100 + d = b `div` 4 + e = b `mod` 4 + f = (b+8) `div` 25 + g = (b-f+1) `div` 3 + h = (19*a+b-d-g+15) `mod` 30 + i = c `div` 4 + k = c `mod` 4 + l = (32+2*e+2*i-h-k) `mod` 7 + m = (a+11*h+22*l) `div` 451 + n' = (h+l-7*m+114) + n = n' `div` 31 + p = n' `mod` 31 + in fromGregorian (fromIntegral year) n (p+1) + + +daysBeforeMonth :: Integer -> Int -> Int +daysBeforeMonth year month = + let a = if isLeapYear year then 62 else 63 + month' = (fromIntegral month) :: Double + in if month > 2 then + truncate $ ((month' + 1.0) * 30.6) - a + else truncate $ (month' - 1.0)*a*0.5
src/Data/Astro/Time/JulianDate.hs view
@@ -1,240 +1,240 @@-{-|-Module: Data.Astro.Time.JulianDate-Description: Julian Date-Copyright: Alexander Ignatyev, 2016---Julian date is the continuous count of days since noon on January 1, 4713 BC,-the beginning of the Julian Period.--= Examples--== /JulianDate/-@-import Data.Astro.Time.JulianDate---- 2017-06-25 9:29:00 (GMT)-jd :: JulianDate-jd = fromYMDHMS 2017 6 25 9 29 0--- JD 2457929.895138889-@--== /LocalCiviTime and LocalCivilDate/--@-import Data.Astro.Time.JulianDate-import Data.Astro.Types---- 2017-06-25 10:29:00 +0100 (BST)-lct :: LocalCivilTime-lct = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0--- 2017-06-25 10:29:00.0000 +1.0--lctJD :: JulianDate-lctJD = lctUniversalTime lct--- JD 2457929.895138889--lctTZ :: DecimalHours-lctTZ = lctTimeZone lct--- DH 1.0--lcd :: LocalCivilDate-lcd = lcdFromYMD (DH 1) 2017 6 25--lcdJD :: JulianDate-lcdJD = lcdDate lcd--- JD 2457929.5--lcdTZ :: DecimalHours-lcdTZ = lcdTimeZone lcd--- DH 1.0-@--}--module Data.Astro.Time.JulianDate-(- JulianDate(..)- , julianStartDateTime- , LocalCivilTime(..)- , LocalCivilDate(..)- , TimeBaseType- , numberOfDays- , numberOfYears- , numberOfCenturies- , addHours- , fromYMD- , fromYMDHMS- , toYMDHMS- , dayOfWeek- , splitToDayAndTime- , lctFromYMDHMS- , lctToYMDHMS- , lcdFromYMD- , printLctHs-)--where--import Text.Printf (printf)--import Data.Astro.Types(DecimalHours(..), fromHMS, toHMS)-import Data.Astro.Time.GregorianCalendar (gregorianDateAdjustment)-import Data.Astro.Utils (trunc, fraction)---type TimeBaseType = Double---- | A number of days since noon of 1 January 4713 BC-newtype JulianDate = JD TimeBaseType- deriving (Show, Eq)----- | Represents Local Civil Time-data LocalCivilTime = LCT {- lctTimeZone :: DecimalHours -- Time Zone correction- , lctUniversalTime :: JulianDate- } deriving (Eq)---instance Show LocalCivilTime where- show = printLct----- | Local Civil Date, used for time conversions when base date is needed-data LocalCivilDate = LCD {- lcdTimeZone :: DecimalHours- , lcdDate :: JulianDate- } deriving (Eq)----- | Beginning of the Julian Period-julianStartDateTime = fromYMDHMS (-4712) 1 1 12 0 0---instance Num JulianDate where- (+) (JD d1) (JD d2) = JD (d1+d2)- (-) (JD d1) (JD d2) = JD (d1-d2)- (*) (JD d1) (JD d2) = JD (d1*d2)- negate (JD d) = JD (negate d)- abs (JD d) = JD (abs d)- signum (JD d) = JD (signum d)- fromInteger int = JD (fromInteger int)----- | Return number of days since the first argument till the second one-numberOfDays :: JulianDate -> JulianDate -> TimeBaseType-numberOfDays (JD jd1) (JD jd2) = jd2 - jd1----- | Return number of years since the first argument till the second one-numberOfYears :: JulianDate -> JulianDate -> TimeBaseType-numberOfYears (JD jd1) (JD jd2) = (jd2-jd1) / 365.25----- | Return number of centuries since the first argument till the second one-numberOfCenturies :: JulianDate -> JulianDate -> TimeBaseType-numberOfCenturies (JD jd1) (JD jd2) = (jd2-jd1) / 36525----- | add Decimal Hours-addHours :: DecimalHours -> JulianDate -> JulianDate-addHours (DH hours) jd = jd + (JD $ hours/24)----- | Create Julian Date.--- It takes year, month [1..12], Day [1..31].-fromYMD :: Integer -> Int -> Int -> JulianDate-fromYMD year month day =- let (y, m) = if month < 3 then (year-1, month+12) else (year, month)- y' = fromIntegral y- m' = fromIntegral m- b = gregorianDateAdjustment year month day- c = if y < 0- then truncate (365.25*y' - 0.75) -- 365.25 - number of solar days in a year- else truncate (365.25*y')- d = truncate (30.6001 * (m'+1))- jd = fromIntegral (b + c + d + day) + 1720994.5 -- add 1720994.5 to process BC/AC border- in JD jd----- | Create Julian Date.--- It takes year, month [1..12], Day [1..31], hours, minutes, seconds.-fromYMDHMS :: Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate-fromYMDHMS year month day hs ms ss = addHours (fromHMS hs ms ss) (fromYMD year month day)----- | It returns year, month [1..12], Day [1..31], hours, minutes, seconds.-toYMDHMS :: JulianDate -> (Integer, Int, Int, Int, Int, TimeBaseType)-toYMDHMS (JD jd) =- let (i, time) = fraction (jd + 0.5)- b = if i > 2299160 -- 2299161 - first day of Georgian Calendar- then let a = trunc $ (i-1867216.25)/36524.25- in i + a - trunc (a*0.25) + 1- else i- c = b + 1524- d = trunc $ (c-122.1)/365.25- e = trunc $ d * 365.25- g = trunc $ (c-e)/30.6001- day = truncate $ c - e - trunc (30.6001*g)- month = truncate $ if g < 13.5 then g - 1 else g - 13- year = truncate $ if month > 2 then d-4716 else d-4715- (h, m, s) = toHMS $ DH $ 24*time- in (year, month, day, h, m, s)----- | Get Day of the Week--- 0 is for Sunday, 1 for manday and 6 for Saturday-dayOfWeek :: JulianDate -> Int-dayOfWeek jd =- let JD d = removeHours jd- (_, f) = properFraction $ (d+1.5) / 7- in round (7*f)----- | Extract Day and Time parts of Date-splitToDayAndTime :: JulianDate -> (JulianDate, JulianDate)-splitToDayAndTime jd@(JD n) =- let day = JD $ 0.5 + trunc (n - 0.5)- time = jd - day- in (day, time)----- | Get Julian date corresponding to midnight-removeHours :: JulianDate -> JulianDate-removeHours jd =- let (d, _) = splitToDayAndTime jd- in d----- | Create LocalCivilTime from tize zone, local year, local month, local day, local hours, local minutes and local secunds.-lctFromYMDHMS :: DecimalHours ->Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> LocalCivilTime-lctFromYMDHMS tz y m d hs ms ss =- let jd = fromYMDHMS y m d hs ms ss- jd' = addHours (-tz) jd- in LCT tz jd'----- | Get from LocalCivilTime local year, local month, local day, local hours, local minutes and local secunds.-lctToYMDHMS :: LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType)-lctToYMDHMS (LCT tz jd)= toYMDHMS (addHours tz jd)----- Create LocalCivilDate from time zone, local year, local month, local day-lcdFromYMD :: DecimalHours -> Integer -> Int -> Int -> LocalCivilDate-lcdFromYMD tz y m d = LCD tz (fromYMD y m d)----- | Print Local Civil Time in human-readable format-printLct :: LocalCivilTime -> String-printLct lct =- printf "%d-%02d-%02d %02d:%02d:%07.4f %+03.1f" y m d hs ms ss tz- where (y, m, d, hs, ms, ss) = lctToYMDHMS lct- DH tz = lctTimeZone lct----- | Print local civil time in machine readable format-printLctHs :: LocalCivilTime -> String-printLctHs lct =- printf "lctFromYMDHMS (%1.0f) %d %d %d %d %d %.4f" tz y m d hs ms ss- where (y, m, d, hs, ms, ss) = lctToYMDHMS lct- DH tz = lctTimeZone lct+{-| +Module: Data.Astro.Time.JulianDate +Description: Julian Date +Copyright: Alexander Ignatyev, 2016 + + +Julian date is the continuous count of days since noon on January 1, 4713 BC, +the beginning of the Julian Period. + += Examples + +== /JulianDate/ +@ +import Data.Astro.Time.JulianDate + +-- 2017-06-25 9:29:00 (GMT) +jd :: JulianDate +jd = fromYMDHMS 2017 6 25 9 29 0 +-- JD 2457929.895138889 +@ + +== /LocalCiviTime and LocalCivilDate/ + +@ +import Data.Astro.Time.JulianDate +import Data.Astro.Types + +-- 2017-06-25 10:29:00 +0100 (BST) +lct :: LocalCivilTime +lct = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0 +-- 2017-06-25 10:29:00.0000 +1.0 + +lctJD :: JulianDate +lctJD = lctUniversalTime lct +-- JD 2457929.895138889 + +lctTZ :: DecimalHours +lctTZ = lctTimeZone lct +-- DH 1.0 + +lcd :: LocalCivilDate +lcd = lcdFromYMD (DH 1) 2017 6 25 + +lcdJD :: JulianDate +lcdJD = lcdDate lcd +-- JD 2457929.5 + +lcdTZ :: DecimalHours +lcdTZ = lcdTimeZone lcd +-- DH 1.0 +@ +-} + +module Data.Astro.Time.JulianDate +( + JulianDate(..) + , julianStartDateTime + , LocalCivilTime(..) + , LocalCivilDate(..) + , TimeBaseType + , numberOfDays + , numberOfYears + , numberOfCenturies + , addHours + , fromYMD + , fromYMDHMS + , toYMDHMS + , dayOfWeek + , splitToDayAndTime + , lctFromYMDHMS + , lctToYMDHMS + , lcdFromYMD + , printLctHs +) + +where + +import Text.Printf (printf) + +import Data.Astro.Types(DecimalHours(..), fromHMS, toHMS) +import Data.Astro.Time.GregorianCalendar (gregorianDateAdjustment) +import Data.Astro.Utils (trunc, fraction) + + +type TimeBaseType = Double + +-- | A number of days since noon of 1 January 4713 BC +newtype JulianDate = JD TimeBaseType + deriving (Show, Eq) + + +-- | Represents Local Civil Time +data LocalCivilTime = LCT { + lctTimeZone :: DecimalHours -- Time Zone correction + , lctUniversalTime :: JulianDate + } deriving (Eq) + + +instance Show LocalCivilTime where + show = printLct + + +-- | Local Civil Date, used for time conversions when base date is needed +data LocalCivilDate = LCD { + lcdTimeZone :: DecimalHours + , lcdDate :: JulianDate + } deriving (Eq) + + +-- | Beginning of the Julian Period +julianStartDateTime = fromYMDHMS (-4712) 1 1 12 0 0 + + +instance Num JulianDate where + (+) (JD d1) (JD d2) = JD (d1+d2) + (-) (JD d1) (JD d2) = JD (d1-d2) + (*) (JD d1) (JD d2) = JD (d1*d2) + negate (JD d) = JD (negate d) + abs (JD d) = JD (abs d) + signum (JD d) = JD (signum d) + fromInteger int = JD (fromInteger int) + + +-- | Return number of days since the first argument till the second one +numberOfDays :: JulianDate -> JulianDate -> TimeBaseType +numberOfDays (JD jd1) (JD jd2) = jd2 - jd1 + + +-- | Return number of years since the first argument till the second one +numberOfYears :: JulianDate -> JulianDate -> TimeBaseType +numberOfYears (JD jd1) (JD jd2) = (jd2-jd1) / 365.25 + + +-- | Return number of centuries since the first argument till the second one +numberOfCenturies :: JulianDate -> JulianDate -> TimeBaseType +numberOfCenturies (JD jd1) (JD jd2) = (jd2-jd1) / 36525 + + +-- | add Decimal Hours +addHours :: DecimalHours -> JulianDate -> JulianDate +addHours (DH hours) jd = jd + (JD $ hours/24) + + +-- | Create Julian Date. +-- It takes year, month [1..12], Day [1..31]. +fromYMD :: Integer -> Int -> Int -> JulianDate +fromYMD year month day = + let (y, m) = if month < 3 then (year-1, month+12) else (year, month) + y' = fromIntegral y + m' = fromIntegral m + b = gregorianDateAdjustment year month day + c = if y < 0 + then truncate (365.25*y' - 0.75) -- 365.25 - number of solar days in a year + else truncate (365.25*y') + d = truncate (30.6001 * (m'+1)) + jd = fromIntegral (b + c + d + day) + 1720994.5 -- add 1720994.5 to process BC/AC border + in JD jd + + +-- | Create Julian Date. +-- It takes year, month [1..12], Day [1..31], hours, minutes, seconds. +fromYMDHMS :: Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate +fromYMDHMS year month day hs ms ss = addHours (fromHMS hs ms ss) (fromYMD year month day) + + +-- | It returns year, month [1..12], Day [1..31], hours, minutes, seconds. +toYMDHMS :: JulianDate -> (Integer, Int, Int, Int, Int, TimeBaseType) +toYMDHMS (JD jd) = + let (i, time) = fraction (jd + 0.5) + b = if i > 2299160 -- 2299161 - first day of Gregorian Calendar + then let a = trunc $ (i-1867216.25)/36524.25 + in i + a - trunc (a*0.25) + 1 + else i + c = b + 1524 + d = trunc $ (c-122.1)/365.25 + e = trunc $ d * 365.25 + g = trunc $ (c-e)/30.6001 + day = truncate $ c - e - trunc (30.6001*g) + month = truncate $ if g < 13.5 then g - 1 else g - 13 + year = truncate $ if month > 2 then d-4716 else d-4715 + (h, m, s) = toHMS $ DH $ 24*time + in (year, month, day, h, m, s) + + +-- | Get Day of the Week: +-- 0 is for Sunday, 1 for Monday and 6 for Saturday +dayOfWeek :: JulianDate -> Int +dayOfWeek jd = + let JD d = removeHours jd + (_, f) = properFraction $ (d+1.5) / 7 + in round (7*f) + + +-- | Extract Day and Time parts of Date +splitToDayAndTime :: JulianDate -> (JulianDate, JulianDate) +splitToDayAndTime jd@(JD n) = + let day = JD $ 0.5 + trunc (n - 0.5) + time = jd - day + in (day, time) + + +-- | Get Julian date corresponding to midnight +removeHours :: JulianDate -> JulianDate +removeHours jd = + let (d, _) = splitToDayAndTime jd + in d + + +-- | Create LocalCivilTime from tize zone, local year, local month, local day, local hours, local minutes and local seconds. +lctFromYMDHMS :: DecimalHours ->Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> LocalCivilTime +lctFromYMDHMS tz y m d hs ms ss = + let jd = fromYMDHMS y m d hs ms ss + jd' = addHours (-tz) jd + in LCT tz jd' + + +-- | Get from LocalCivilTime local year, local month, local day, local hours, local minutes and local seconds. +lctToYMDHMS :: LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType) +lctToYMDHMS (LCT tz jd)= toYMDHMS (addHours tz jd) + + +-- Create LocalCivilDate from time zone, local year, local month, local day +lcdFromYMD :: DecimalHours -> Integer -> Int -> Int -> LocalCivilDate +lcdFromYMD tz y m d = LCD tz (fromYMD y m d) + + +-- | Print Local Civil Time in human-readable format +printLct :: LocalCivilTime -> String +printLct lct = + printf "%d-%02d-%02d %02d:%02d:%07.4f %+03.1f" y m d hs ms ss tz + where (y, m, d, hs, ms, ss) = lctToYMDHMS lct + DH tz = lctTimeZone lct + + +-- | Print local civil time in machine readable format +printLctHs :: LocalCivilTime -> String +printLctHs lct = + printf "lctFromYMDHMS (%1.0f) %d %d %d %d %d %.4f" tz y m d hs ms ss + where (y, m, d, hs, ms, ss) = lctToYMDHMS lct + DH tz = lctTimeZone lct
src/Data/Astro/Time/Sidereal.hs view
@@ -1,143 +1,143 @@-{-|-Module: Data.Astro.Time.Sidereal-Description: Sidereal Time-Copyright: Alexander Ignatyev, 2016--According to the Sidereal Clock any observed star returns to the same position-in the sky every 24 hours.--Each sidereal day is shorter than the solar day, 24 hours of sidereal time-corresponding to 23:56:04.0916 of solar time.--}--module Data.Astro.Time.Sidereal-(- GreenwichSiderealTime- , LocalSiderealTime- , dhToGST- , dhToLST- , gstToDH- , lstToDH- , hmsToGST- , hmsToLST- , utToGST- , gstToUT- , gstToLST- , lstToGST- , lstToGSTwDC-)-where--import Data.Astro.Types (DecimalHours(..), fromHMS)-import Data.Astro.Time.JulianDate (JulianDate(..), TimeBaseType, numberOfCenturies, splitToDayAndTime)-import Data.Astro.Time.Epoch (j2000)-import Data.Astro.Utils (reduceToZeroRange)-import qualified Data.Astro.Types as C----- | Greenwich Sidereal Time--- GST can be in range [-12h, 36h] carrying out a day correction-newtype GreenwichSiderealTime = GST TimeBaseType deriving (Show, Eq)----- | Local Sidereal Time-newtype LocalSiderealTime = LST TimeBaseType deriving (Show, Eq)----- | Convert Decimal Hours to Greenwich Sidereal Time-dhToGST :: DecimalHours -> GreenwichSiderealTime-dhToGST (DH t) = GST t----- | Convert Decimal Hours to Local Sidereal Time-dhToLST :: DecimalHours -> LocalSiderealTime-dhToLST (DH t) = LST t----- | Convert Greenwich Sidereal Time to Decimal Hours-gstToDH :: GreenwichSiderealTime -> DecimalHours-gstToDH (GST t) = DH t----- | Convert Local Sidereal Time to Decimal Hours-lstToDH :: LocalSiderealTime -> DecimalHours-lstToDH (LST t) = DH t----- | Comvert Hours, Minutes, Seconds to Greenwich Sidereal Time-hmsToGST :: Int -> Int -> TimeBaseType -> GreenwichSiderealTime-hmsToGST h m s = dhToGST $ fromHMS h m s----- | Comvert Hours, Minutes, Seconds to Local Sidereal Time-hmsToLST :: Int -> Int -> TimeBaseType -> LocalSiderealTime-hmsToLST h m s = dhToLST $ fromHMS h m s----- | Convert from Universal Time (UT) to Greenwich Sidereal Time (GST)-utToGST :: JulianDate -> GreenwichSiderealTime-utToGST jd =- let (JD day, JD time) = splitToDayAndTime jd- t = solarSiderealTimesDiff day- time' = reduceToZeroRange 24 $ time*24/siderealDayLength + t- in GST $ time'----- | Convert from Greenwich Sidereal Time (GST) to Universal Time (UT).--- It takes GST and Greenwich Date, returns JulianDate.--- Because the sidereal day is shorter than the solar day (see comment to the module).--- In case of such ambiguity the early time will be returned.--- You can easily check the ambiguity: if time is equal or less 00:03:56--- you can get the second time by adding 23:56:04-gstToUT :: JulianDate -> GreenwichSiderealTime -> JulianDate-gstToUT jd gst =- let (day, time) = dayTime jd gst- t = solarSiderealTimesDiff day- time' = (reduceToZeroRange 24 (time-t)) * siderealDayLength- in JD $ day + time'/24- where dayTime jd (GST gst)- | gst < 0 = (day-1, gst+24)- | gst >= 24 = (day+1, gst-24)- | otherwise = (day, gst)- where (JD day, _) = splitToDayAndTime jd----- | Convert Greenwich Sidereal Time to Local Sidereal Time.--- It takes GST and longitude in decimal degrees-gstToLST :: C.DecimalDegrees -> GreenwichSiderealTime -> LocalSiderealTime-gstToLST longitude (GST gst) =- let C.DH dhours = C.toDecimalHours longitude- lst = reduceToZeroRange 24 $ gst + dhours- in LST lst----- | Convert Local Sidereal Time to Greenwich Sidereal Time--- It takes LST and longitude in decimal degrees-lstToGST :: C.DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime-lstToGST longitude (LST lst) =- let C.DH dhours = C.toDecimalHours longitude- gst = reduceToZeroRange 24 $ lst - dhours- in GST gst----- | Convert Local Sidereal Time to Greenwich Sidereal Time with Day Correction.--- It takes LST and longitude in decimal degrees-lstToGSTwDC :: C.DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime-lstToGSTwDC longitude (LST lst) =- let C.DH dhours = C.toDecimalHours longitude- gst = lst - dhours- in GST gst----- Sidereal time internal functions---- sidereal 24h correspond to 23:56:04 of solar time-siderealDayLength :: TimeBaseType-siderealDayLength = hours/24- where C.DH hours = fromHMS 23 56 04.0916---solarSiderealTimesDiff :: TimeBaseType -> TimeBaseType-solarSiderealTimesDiff d =- let t = numberOfCenturies j2000 (JD d)- in reduceToZeroRange 24 $ 6.697374558 + 2400.051336*t + 0.000025862*t*t+{-| +Module: Data.Astro.Time.Sidereal +Description: Sidereal Time +Copyright: Alexander Ignatyev, 2016 + +According to the Sidereal Clock any observed star returns to the same position +in the sky every 24 hours. + +Each sidereal day is shorter than the solar day, 24 hours of sidereal time +corresponding to 23:56:04.0916 of solar time. +-} + +module Data.Astro.Time.Sidereal +( + GreenwichSiderealTime + , LocalSiderealTime + , dhToGST + , dhToLST + , gstToDH + , lstToDH + , hmsToGST + , hmsToLST + , utToGST + , gstToUT + , gstToLST + , lstToGST + , lstToGSTwDC +) +where + +import Data.Astro.Types (DecimalHours(..), fromHMS) +import Data.Astro.Time.JulianDate (JulianDate(..), TimeBaseType, numberOfCenturies, splitToDayAndTime) +import Data.Astro.Time.Epoch (j2000) +import Data.Astro.Utils (reduceToZeroRange) +import qualified Data.Astro.Types as C + + +-- | Greenwich Sidereal Time +-- GST can be in range [-12h, 36h] carrying out a day correction +newtype GreenwichSiderealTime = GST TimeBaseType deriving (Show, Eq) + + +-- | Local Sidereal Time +newtype LocalSiderealTime = LST TimeBaseType deriving (Show, Eq) + + +-- | Convert Decimal Hours to Greenwich Sidereal Time +dhToGST :: DecimalHours -> GreenwichSiderealTime +dhToGST (DH t) = GST t + + +-- | Convert Decimal Hours to Local Sidereal Time +dhToLST :: DecimalHours -> LocalSiderealTime +dhToLST (DH t) = LST t + + +-- | Convert Greenwich Sidereal Time to Decimal Hours +gstToDH :: GreenwichSiderealTime -> DecimalHours +gstToDH (GST t) = DH t + + +-- | Convert Local Sidereal Time to Decimal Hours +lstToDH :: LocalSiderealTime -> DecimalHours +lstToDH (LST t) = DH t + + +-- | Comvert Hours, Minutes, Seconds to Greenwich Sidereal Time +hmsToGST :: Int -> Int -> TimeBaseType -> GreenwichSiderealTime +hmsToGST h m s = dhToGST $ fromHMS h m s + + +-- | Comvert Hours, Minutes, Seconds to Local Sidereal Time +hmsToLST :: Int -> Int -> TimeBaseType -> LocalSiderealTime +hmsToLST h m s = dhToLST $ fromHMS h m s + + +-- | Convert from Universal Time (UT) to Greenwich Sidereal Time (GST) +utToGST :: JulianDate -> GreenwichSiderealTime +utToGST jd = + let (JD day, JD time) = splitToDayAndTime jd + t = solarSiderealTimesDiff day + time' = reduceToZeroRange 24 $ time*24/siderealDayLength + t + in GST $ time' + + +-- | Convert from Greenwich Sidereal Time (GST) to Universal Time (UT). +-- It takes GST and Greenwich Date, returns JulianDate. +-- Because the sidereal day is shorter than the solar day (see comment to the module). +-- In case of such ambiguity the early time will be returned. +-- You can easily check the ambiguity: if time is equal or less 00:03:56 +-- you can get the second time by adding 23:56:04 +gstToUT :: JulianDate -> GreenwichSiderealTime -> JulianDate +gstToUT jd gst = + let (day, time) = dayTime jd gst + t = solarSiderealTimesDiff day + time' = (reduceToZeroRange 24 (time-t)) * siderealDayLength + in JD $ day + time'/24 + where dayTime jd (GST gst) + | gst < 0 = (day-1, gst+24) + | gst >= 24 = (day+1, gst-24) + | otherwise = (day, gst) + where (JD day, _) = splitToDayAndTime jd + + +-- | Convert Greenwich Sidereal Time to Local Sidereal Time. +-- It takes GST and longitude in decimal degrees +gstToLST :: C.DecimalDegrees -> GreenwichSiderealTime -> LocalSiderealTime +gstToLST longitude (GST gst) = + let C.DH dhours = C.toDecimalHours longitude + lst = reduceToZeroRange 24 $ gst + dhours + in LST lst + + +-- | Convert Local Sidereal Time to Greenwich Sidereal Time +-- It takes LST and longitude in decimal degrees +lstToGST :: C.DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime +lstToGST longitude (LST lst) = + let C.DH dhours = C.toDecimalHours longitude + gst = reduceToZeroRange 24 $ lst - dhours + in GST gst + + +-- | Convert Local Sidereal Time to Greenwich Sidereal Time with Day Correction. +-- It takes LST and longitude in decimal degrees +lstToGSTwDC :: C.DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime +lstToGSTwDC longitude (LST lst) = + let C.DH dhours = C.toDecimalHours longitude + gst = lst - dhours + in GST gst + + +-- Sidereal time internal functions + +-- sidereal 24h correspond to 23:56:04 of solar time +siderealDayLength :: TimeBaseType +siderealDayLength = hours/24 + where C.DH hours = fromHMS 23 56 04.0916 + + +solarSiderealTimesDiff :: TimeBaseType -> TimeBaseType +solarSiderealTimesDiff d = + let t = numberOfCenturies j2000 (JD d) + in reduceToZeroRange 24 $ 6.697374558 + 2400.051336*t + 0.000025862*t*t
src/Data/Astro/Types.hs view
@@ -1,224 +1,224 @@-{-|-Module: Data.Astro.Types-Description: Common Types-Copyright: Alexander Ignatyev, 2016--Common Types are usfull across all subsystems like Time and Coordinate.--= Examples--== /Decimal hours and Decimal degrees/--@-import Data.Astro.Types---- 10h 15m 19.7s-dh :: DecimalHours-dh = fromHMS 10 15 19.7--- DH 10.255472222222222--(h, m, s) = toHMS dh--- (10,15,19.699999999999562)----- 51°28′40″-dd :: DecimalDegrees-dd = fromDMS 51 28 40--- DD 51.477777777777774--(d, m, s) = toDMS dd--- (51,28,39.999999999987494)-@--== /Geographic Coordinates/-@-import Data.Astro.Types---- the Royal Observatory, Greenwich-ro :: GeographicCoordinates-ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))--- GeoC {geoLatitude = DD 51.4778, geoLongitude = DD (-0.0014)}-@--}--module Data.Astro.Types-(- DecimalDegrees(..)- , DecimalHours (..)- , GeographicCoordinates(..)- , AstronomicalUnits(..)- , lightTravelTime- , kmToAU- , auToKM- , toDecimalHours- , fromDecimalHours- , toRadians- , fromRadians- , fromDMS- , toDMS- , fromHMS- , toHMS-)--where--import qualified Data.Astro.Utils as U---newtype DecimalDegrees = DD Double- deriving (Show, Eq, Ord)---instance Num DecimalDegrees where- (+) (DD d1) (DD d2) = DD (d1+d2)- (-) (DD d1) (DD d2) = DD (d1-d2)- (*) (DD d1) (DD d2) = DD (d1*d2)- negate (DD d) = DD (negate d)- abs (DD d) = DD (abs d)- signum (DD d) = DD (signum d)- fromInteger int = DD (fromInteger int)--instance Real DecimalDegrees where- toRational (DD d) = toRational d--instance Fractional DecimalDegrees where- (/) (DD d1) (DD d2) = DD (d1/d2)- recip (DD d) = DD (recip d)- fromRational r = DD (fromRational r)--instance RealFrac DecimalDegrees where- properFraction (DD d) =- let (i, f) = properFraction d- in (i, DD f)---newtype DecimalHours = DH Double- deriving (Show, Eq, Ord)---instance Num DecimalHours where- (+) (DH d1) (DH d2) = DH (d1+d2)- (-) (DH d1) (DH d2) = DH (d1-d2)- (*) (DH d1) (DH d2) = DH (d1*d2)- negate (DH d) = DH (negate d)- abs (DH d) = DH (abs d)- signum (DH d) = DH (signum d)- fromInteger int = DH (fromInteger int)--instance Real DecimalHours where- toRational (DH d) = toRational d--instance Fractional DecimalHours where- (/) (DH d1) (DH d2) = DH (d1/d2)- recip (DH d) = DH (recip d)- fromRational r = DH (fromRational r)--instance RealFrac DecimalHours where- properFraction (DH d) =- let (i, f) = properFraction d- in (i, DH f)----- | Convert decimal degrees to decimal hours-toDecimalHours :: DecimalDegrees -> DecimalHours-toDecimalHours (DD d) = DH $ d/15 -- 360 / 24 = 15---- | Convert decimal hours to decimal degrees-fromDecimalHours :: DecimalHours -> DecimalDegrees-fromDecimalHours (DH h) = DD $ h*15----- | Geographic Coordinates-data GeographicCoordinates = GeoC {- geoLatitude :: DecimalDegrees- , geoLongitude :: DecimalDegrees- } deriving (Show, Eq)----- | Astronomical Units, 1AU = 1.4960×1011 m--- (originally, the average distance of Earth's aphelion and perihelion).-newtype AstronomicalUnits = AU Double deriving (Show, Eq, Ord)---instance Num AstronomicalUnits where- (+) (AU d1) (AU d2) = AU (d1+d2)- (-) (AU d1) (AU d2) = AU (d1-d2)- (*) (AU d1) (AU d2) = AU (d1*d2)- negate (AU d) = AU (negate d)- abs (AU d) = AU (abs d)- signum (AU d) = AU (signum d)- fromInteger int = AU (fromInteger int)--instance Real AstronomicalUnits where- toRational (AU d) = toRational d--instance Fractional AstronomicalUnits where- (/) (AU d1) (AU d2) = AU (d1/d2)- recip (AU d) = AU (recip d)- fromRational r = AU (fromRational r)--instance RealFrac AstronomicalUnits where- properFraction (AU d) =- let (i, f) = properFraction d- in (i, AU f)----- | Light travel time of the distance in Astronomical Units-lightTravelTime :: AstronomicalUnits -> DecimalHours-lightTravelTime (AU ro) = DH $ 0.1386*ro---kmInOneAU :: Double-kmInOneAU = 149597870.700----- | Convert from kilometers to Astronomical Units-kmToAU :: Double -> AstronomicalUnits-kmToAU km = AU (km / kmInOneAU)----- | Comvert from Astronomical Units to kilometers-auToKM :: AstronomicalUnits -> Double-auToKM (AU au) = au * kmInOneAU----- | Convert from DecimalDegrees to Radians-toRadians (DD deg) = U.toRadians deg----- | Convert from Radians to DecimalDegrees-fromRadians rad = DD $ U.fromRadians rad----- | Convert Degrees, Minutes, Seconds to DecimalDegrees-fromDMS :: RealFrac a => Int -> Int -> a -> DecimalDegrees-fromDMS d m s =- let d' = fromIntegral d- m' = fromIntegral m- s' = realToFrac s- in DD $ d'+(m'+(s'/60))/60----- | Convert DecimalDegrees to Degrees, Minutes, Seconds-toDMS (DD dd) =- let (d, rm) = properFraction dd- (m, rs) = properFraction $ 60 * rm- s = 60 * rs- in (d, m, s)----- | Comvert Hours, Minutes, Seconds to DecimalHours-fromHMS :: RealFrac a => Int -> Int -> a -> DecimalHours-fromHMS h m s =- let h' = fromIntegral h- m' = fromIntegral m- s' = realToFrac s- in DH $ h'+(m'+(s'/60))/60----- | Convert DecimalDegrees to Degrees, Minutes, Seconds-toHMS (DH dh) =- let (h, rm) = properFraction dh- (m, rs) = properFraction $ 60 * rm- s = 60 * rs- in (h, m, s)+{-| +Module: Data.Astro.Types +Description: Common Types +Copyright: Alexander Ignatyev, 2016 + +Common Types are usfull across all subsystems like Time and Coordinate. + += Examples + +== /Decimal hours and Decimal degrees/ + +@ +import Data.Astro.Types + +-- 10h 15m 19.7s +dh :: DecimalHours +dh = fromHMS 10 15 19.7 +-- DH 10.255472222222222 + +(h, m, s) = toHMS dh +-- (10,15,19.699999999999562) + + +-- 51°28′40″ +dd :: DecimalDegrees +dd = fromDMS 51 28 40 +-- DD 51.477777777777774 + +(d, m, s) = toDMS dd +-- (51,28,39.999999999987494) +@ + +== /Geographic Coordinates/ +@ +import Data.Astro.Types + +-- the Royal Observatory, Greenwich +ro :: GeographicCoordinates +ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5)) +-- GeoC {geoLatitude = DD 51.4778, geoLongitude = DD (-0.0014)} +@ +-} + +module Data.Astro.Types +( + DecimalDegrees(..) + , DecimalHours (..) + , GeographicCoordinates(..) + , AstronomicalUnits(..) + , lightTravelTime + , kmToAU + , auToKM + , toDecimalHours + , fromDecimalHours + , toRadians + , fromRadians + , fromDMS + , toDMS + , fromHMS + , toHMS +) + +where + +import qualified Data.Astro.Utils as U + + +newtype DecimalDegrees = DD Double + deriving (Show, Eq, Ord) + + +instance Num DecimalDegrees where + (+) (DD d1) (DD d2) = DD (d1+d2) + (-) (DD d1) (DD d2) = DD (d1-d2) + (*) (DD d1) (DD d2) = DD (d1*d2) + negate (DD d) = DD (negate d) + abs (DD d) = DD (abs d) + signum (DD d) = DD (signum d) + fromInteger int = DD (fromInteger int) + +instance Real DecimalDegrees where + toRational (DD d) = toRational d + +instance Fractional DecimalDegrees where + (/) (DD d1) (DD d2) = DD (d1/d2) + recip (DD d) = DD (recip d) + fromRational r = DD (fromRational r) + +instance RealFrac DecimalDegrees where + properFraction (DD d) = + let (i, f) = properFraction d + in (i, DD f) + + +newtype DecimalHours = DH Double + deriving (Show, Eq, Ord) + + +instance Num DecimalHours where + (+) (DH d1) (DH d2) = DH (d1+d2) + (-) (DH d1) (DH d2) = DH (d1-d2) + (*) (DH d1) (DH d2) = DH (d1*d2) + negate (DH d) = DH (negate d) + abs (DH d) = DH (abs d) + signum (DH d) = DH (signum d) + fromInteger int = DH (fromInteger int) + +instance Real DecimalHours where + toRational (DH d) = toRational d + +instance Fractional DecimalHours where + (/) (DH d1) (DH d2) = DH (d1/d2) + recip (DH d) = DH (recip d) + fromRational r = DH (fromRational r) + +instance RealFrac DecimalHours where + properFraction (DH d) = + let (i, f) = properFraction d + in (i, DH f) + + +-- | Convert decimal degrees to decimal hours +toDecimalHours :: DecimalDegrees -> DecimalHours +toDecimalHours (DD d) = DH $ d/15 -- 360 / 24 = 15 + +-- | Convert decimal hours to decimal degrees +fromDecimalHours :: DecimalHours -> DecimalDegrees +fromDecimalHours (DH h) = DD $ h*15 + + +-- | Geographic Coordinates +data GeographicCoordinates = GeoC { + geoLatitude :: DecimalDegrees + , geoLongitude :: DecimalDegrees + } deriving (Show, Eq) + + +-- | Astronomical Units, 1AU = 1.4960×1011 m +-- (originally, the average distance of Earth's aphelion and perihelion). +newtype AstronomicalUnits = AU Double deriving (Show, Eq, Ord) + + +instance Num AstronomicalUnits where + (+) (AU d1) (AU d2) = AU (d1+d2) + (-) (AU d1) (AU d2) = AU (d1-d2) + (*) (AU d1) (AU d2) = AU (d1*d2) + negate (AU d) = AU (negate d) + abs (AU d) = AU (abs d) + signum (AU d) = AU (signum d) + fromInteger int = AU (fromInteger int) + +instance Real AstronomicalUnits where + toRational (AU d) = toRational d + +instance Fractional AstronomicalUnits where + (/) (AU d1) (AU d2) = AU (d1/d2) + recip (AU d) = AU (recip d) + fromRational r = AU (fromRational r) + +instance RealFrac AstronomicalUnits where + properFraction (AU d) = + let (i, f) = properFraction d + in (i, AU f) + + +-- | Light travel time of the distance in Astronomical Units +lightTravelTime :: AstronomicalUnits -> DecimalHours +lightTravelTime (AU ro) = DH $ 0.1386*ro + + +kmInOneAU :: Double +kmInOneAU = 149597870.700 + + +-- | Convert from kilometers to Astronomical Units +kmToAU :: Double -> AstronomicalUnits +kmToAU km = AU (km / kmInOneAU) + + +-- | Comvert from Astronomical Units to kilometers +auToKM :: AstronomicalUnits -> Double +auToKM (AU au) = au * kmInOneAU + + +-- | Convert from DecimalDegrees to Radians +toRadians (DD deg) = U.toRadians deg + + +-- | Convert from Radians to DecimalDegrees +fromRadians rad = DD $ U.fromRadians rad + + +-- | Convert Degrees, Minutes, Seconds to DecimalDegrees +fromDMS :: RealFrac a => Int -> Int -> a -> DecimalDegrees +fromDMS d m s = + let d' = fromIntegral d + m' = fromIntegral m + s' = realToFrac s + in DD $ d'+(m'+(s'/60))/60 + + +-- | Convert DecimalDegrees to Degrees, Minutes, Seconds +toDMS (DD dd) = + let (d, rm) = properFraction dd + (m, rs) = properFraction $ 60 * rm + s = 60 * rs + in (d, m, s) + + +-- | Comvert Hours, Minutes, Seconds to DecimalHours +fromHMS :: RealFrac a => Int -> Int -> a -> DecimalHours +fromHMS h m s = + let h' = fromIntegral h + m' = fromIntegral m + s' = realToFrac s + in DH $ h'+(m'+(s'/60))/60 + + +-- | Convert DecimalDegrees to Degrees, Minutes, Seconds +toHMS (DH dh) = + let (h, rm) = properFraction dh + (m, rs) = properFraction $ 60 * rm + s = 60 * rs + in (h, m, s)
src/Data/Astro/Utils.hs view
@@ -1,68 +1,68 @@-{-|-Module: Data.Astro.Utils-Description: Utility functions-Copyright: Alexander Ignatyev, 2016--Utility functions.--}---module Data.Astro.Utils-(- fromFixed- , trunc- , fraction- , reduceToZeroRange- , toRadians- , fromRadians- , roundToN- , tropicalYearLen-)--where--import Data.Fixed(Fixed(MkFixed), HasResolution(resolution))---- | Convert From Fixed to Fractional-fromFixed :: (Fractional a, HasResolution b) => Fixed b -> a-fromFixed fv@(MkFixed v) = (fromIntegral v) / (fromIntegral $ resolution fv)----- | return the integral part of a number--- almost the same as truncate but result type is Real-trunc :: RealFrac a => a -> a-trunc = fromIntegral . truncate----- | Almost the same the properFraction function but result type-fraction :: (RealFrac a, Num b) => a -> (b, a)-fraction v = let (i, f) = (properFraction v)- in (fromIntegral i, f)----- | Reduce to range from 0 to n-reduceToZeroRange :: RealFrac a => a -> a -> a-reduceToZeroRange r n =- let b = n - (trunc (n / r)) * r- in if b < 0 then b + r else b----- | Convert from degrees to radians-toRadians :: Floating a => a -> a-toRadians deg = deg*pi/180----- | Convert from radians to degrees-fromRadians :: Floating a => a -> a-fromRadians rad = rad*180/pi----- | Round to a specified number of digits-roundToN :: RealFrac a => Int -> a -> a-roundToN n f = (fromInteger $ round $ f * factor) / factor- where factor = 10.0^^n----- | Length of a tropical year in days-tropicalYearLen :: Double-tropicalYearLen = 365.242191+{-| +Module: Data.Astro.Utils +Description: Utility functions +Copyright: Alexander Ignatyev, 2016 + +Utility functions. +-} + + +module Data.Astro.Utils +( + fromFixed + , trunc + , fraction + , reduceToZeroRange + , toRadians + , fromRadians + , roundToN + , tropicalYearLen +) + +where + +import Data.Fixed(Fixed(MkFixed), HasResolution(resolution)) + +-- | Convert From Fixed to Fractional +fromFixed :: (Fractional a, HasResolution b) => Fixed b -> a +fromFixed fv@(MkFixed v) = (fromIntegral v) / (fromIntegral $ resolution fv) + + +-- | return the integral part of a number +-- almost the same as truncate but result type is Real +trunc :: RealFrac a => a -> a +trunc = fromIntegral . truncate + + +-- | Almost the same the properFraction function but result type +fraction :: (RealFrac a, Num b) => a -> (b, a) +fraction v = let (i, f) = (properFraction v) + in (fromIntegral i, f) + + +-- | Reduce to range from 0 to n +reduceToZeroRange :: RealFrac a => a -> a -> a +reduceToZeroRange r n = + let b = n - (trunc (n / r)) * r + in if b < 0 then b + r else b + + +-- | Convert from degrees to radians +toRadians :: Floating a => a -> a +toRadians deg = deg*pi/180 + + +-- | Convert from radians to degrees +fromRadians :: Floating a => a -> a +fromRadians rad = rad*180/pi + + +-- | Round to a specified number of digits +roundToN :: RealFrac a => Int -> a -> a +roundToN n f = (fromInteger $ round $ f * factor) / factor + where factor = 10.0^^n + + +-- | Length of a tropical year in days +tropicalYearLen :: Double +tropicalYearLen = 365.242191
test/Data/Astro/CelestialObject/RiseSetTest.hs view
@@ -1,81 +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+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
@@ -1,32 +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)))- ]- ]+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
@@ -1,180 +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))+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
@@ -1,47 +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 ++ ")"+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
@@ -1,86 +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 ++ ")"+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
@@ -1,81 +1,81 @@-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.Types (GeographicCoordinates(..))-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 "moonPosition2" [- testEC1 "at 2003-09-01 00:00:00 UT"- 0.000001- (EC1 (-12.174888) 14.178731)- (moonPosition2 j2010MoonDetails (MDU 1) (GeoC 51 0) 20 (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+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.Types (GeographicCoordinates(..)) +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 "moonPosition2" [ + testEC1 "at 2003-09-01 00:00:00 UT" + 0.000001 + (EC1 (-12.174888) 14.178731) + (moonPosition2 j2010MoonDetails (MDU 1) (GeoC 51 0) 20 (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
@@ -1,25 +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- ]- ]+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
@@ -1,131 +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)- ]- ]+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
@@ -1,35 +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))+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
@@ -1,181 +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+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
@@ -1,50 +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-+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/EpochTest.hs view
@@ -0,0 +1,27 @@+module Data.Astro.Time.EpochTest +( + tests +) + +where + +import Data.Astro.Time.Epoch +import Data.Astro.Time.JulianDate + +import Test.Framework (testGroup) +import Test.Framework.Providers.HUnit +import Test.HUnit +import Test.HUnit.Approx + + +tests = [ testGroup "Epoch" [ + testCase "B1900" $ b1900 @?= jdAdd (fromYMDHMS 1900 1 0 0 0 0) 0.8135 + , testCase "B1950" $ b1950 @?= jdAdd (fromYMDHMS 1950 1 0 0 0 0) 0.9235 + , testCase "J1900" $ j1900 @?= fromYMDHMS 1900 1 0 12 0 0 + , testCase "J2000" $ j2000 @?= fromYMDHMS 2000 1 1 12 0 0 + , testCase "J2050" $ j2050 @?= fromYMDHMS 2050 1 1 0 0 0 + , testCase "J2010" $ j2010 @?= fromYMDHMS 2010 1 0 0 0 0 + ] + ] + +jdAdd (JD jd) days = JD (jd + days)
test/Data/Astro/Time/GregorianCalendarTest.hs view
@@ -1,57 +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)-+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
@@ -1,161 +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+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
@@ -1,112 +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+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
@@ -1,42 +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))- ]- ]+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
@@ -1,172 +1,172 @@-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 "KM <-> AU" [- testCase "KM -> AU" $ assertApproxEqual "" 1e-5 (AU 7.8) (kmToAU 1166863391.46)- , testCase "AU -> KM" $ assertApproxEqual "" 1e-5 1166863391.46 (auToKM 7.8)- ]- , 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+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 "KM <-> AU" [ + testCase "KM -> AU" $ assertApproxEqual "" 1e-5 (AU 7.8) (kmToAU 1166863391.46) + , testCase "AU -> KM" $ assertApproxEqual "" 1e-5 1166863391.46 (auToKM 7.8) + ] + , 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
@@ -1,86 +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)+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/Main.hs view
@@ -1,43 +1,45 @@-import Test.Framework (defaultMain, testGroup)---import qualified Data.Astro.TimeTest as Time-import qualified Data.Astro.Time.GregorianCalendarTest as Time.GregorianCalendar-import qualified Data.Astro.Time.JulianDateTest as Time.JulianDate-import qualified Data.Astro.Time.SiderealTest as Time.Sidereal-import qualified Data.Astro.Time.ConvTest as Time.Conv-import qualified Data.Astro.CoordinateTest as Coordinate-import qualified Data.Astro.TypesTest as Types-import qualified Data.Astro.UtilsTest as Utils-import qualified Data.Astro.CelestialObjectTest as CelestialObject-import qualified Data.Astro.CelestialObject.RiseSetTest as CelestialObject.RiseSet-import qualified Data.Astro.EffectsTest as Effects-import qualified Data.Astro.Effects.ParallaxTest as Effects.Parallax-import qualified Data.Astro.SunTest as Sun-import qualified Data.Astro.Sun.SunInternalsTest as SunInternals-import qualified Data.Astro.Planet.PlanetDetailsTest as PlanetDetails-import qualified Data.Astro.Planet.PlanetMechanicsTest as PlanetMechanics-import qualified Data.Astro.MoonTest as Moon---main = defaultMain tests--tests = [- testGroup "Data.Astro.Time" Time.tests- , testGroup "Data.Astro.Time.GregorianCalendar" Time.GregorianCalendar.tests- , testGroup "Data.Astro.Time.JulianDate" Time.JulianDate.tests- , testGroup "Data.Astro.Time.Sidereal" Time.Sidereal.tests- , testGroup "Data.Astro.Time.Conv" Time.Conv.tests- , testGroup "Data.Astro.Coordinate" Coordinate.tests- , testGroup "Data.Astro.Types" Types.tests- , testGroup "Data.Astro.Utils" Utils.tests- , testGroup "Data.Astro.CelestialObject" CelestialObject.tests- , testGroup "Data.Astro.CelestialObject.RiseSet" CelestialObject.RiseSet.tests- , testGroup "Data.Astro.Effects" Effects.tests- , testGroup "Data.Astro.Effects.Parallax" Effects.Parallax.tests- , testGroup "Data.Astro.Sun" Sun.tests- , testGroup "Data.Astro.Sun.SunInternals" SunInternals.tests- , testGroup "Data.Astro.Planet.PlanetDetails" PlanetDetails.tests- , testGroup "Data.Astro.Planet.PlanetMechanics" PlanetMechanics.tests- , testGroup "Data.Astro.Moon" Moon.tests- ]+import Test.Framework (defaultMain, testGroup) + + +import qualified Data.Astro.TimeTest as Time +import qualified Data.Astro.Time.GregorianCalendarTest as Time.GregorianCalendar +import qualified Data.Astro.Time.JulianDateTest as Time.JulianDate +import qualified Data.Astro.Time.SiderealTest as Time.Sidereal +import qualified Data.Astro.Time.ConvTest as Time.Conv +import qualified Data.Astro.Time.EpochTest as Time.Epoch +import qualified Data.Astro.CoordinateTest as Coordinate +import qualified Data.Astro.TypesTest as Types +import qualified Data.Astro.UtilsTest as Utils +import qualified Data.Astro.CelestialObjectTest as CelestialObject +import qualified Data.Astro.CelestialObject.RiseSetTest as CelestialObject.RiseSet +import qualified Data.Astro.EffectsTest as Effects +import qualified Data.Astro.Effects.ParallaxTest as Effects.Parallax +import qualified Data.Astro.SunTest as Sun +import qualified Data.Astro.Sun.SunInternalsTest as SunInternals +import qualified Data.Astro.Planet.PlanetDetailsTest as PlanetDetails +import qualified Data.Astro.Planet.PlanetMechanicsTest as PlanetMechanics +import qualified Data.Astro.MoonTest as Moon + + +main = defaultMain tests + +tests = [ + testGroup "Data.Astro.Time" Time.tests + , testGroup "Data.Astro.Time.GregorianCalendar" Time.GregorianCalendar.tests + , testGroup "Data.Astro.Time.JulianDate" Time.JulianDate.tests + , testGroup "Data.Astro.Time.Sidereal" Time.Sidereal.tests + , testGroup "Data.Astro.Time.Conv" Time.Conv.tests + , testGroup "Data.Astro.Time.Epoch" Time.Epoch.tests + , testGroup "Data.Astro.Coordinate" Coordinate.tests + , testGroup "Data.Astro.Types" Types.tests + , testGroup "Data.Astro.Utils" Utils.tests + , testGroup "Data.Astro.CelestialObject" CelestialObject.tests + , testGroup "Data.Astro.CelestialObject.RiseSet" CelestialObject.RiseSet.tests + , testGroup "Data.Astro.Effects" Effects.tests + , testGroup "Data.Astro.Effects.Parallax" Effects.Parallax.tests + , testGroup "Data.Astro.Sun" Sun.tests + , testGroup "Data.Astro.Sun.SunInternals" SunInternals.tests + , testGroup "Data.Astro.Planet.PlanetDetails" PlanetDetails.tests + , testGroup "Data.Astro.Planet.PlanetMechanics" PlanetMechanics.tests + , testGroup "Data.Astro.Moon" Moon.tests + ]
test/Test/HUnit/Approx.hs view
@@ -1,85 +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 ~?~+{-# 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 ~?~