diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Joel Stanley + +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 Joel Stanley 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. diff --git a/README.org b/README.org new file mode 100644 --- /dev/null +++ b/README.org @@ -0,0 +1,11 @@ +* Welcome! + + This package contains a Haskell module for computing approximate sunrise and + sunset UTC times from latitude and longitude. + + Note that approximations are provided in UTC time only, no additional support + for time zones is implemented. + + This module has only been lightly tested, and produces values close to those + found at http://aa.usno.navy.mil/data/docs/RS_OneYear.php. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/horizon.cabal b/horizon.cabal new file mode 100644 --- /dev/null +++ b/horizon.cabal @@ -0,0 +1,31 @@ +name: horizon +version: 0.1.0 +synopsis: Sunrise and sunset UTC approximations from latitude and longitude coordinates +description: Provides a basic implementation of the sunrise and sunset equations from . +license: BSD3 +license-file: LICENSE +author: Joel Stanley +maintainer: intractable@gmail.com +category: Data +build-type: Simple +extra-source-files: README.org +cabal-version: >=1.10 +stability: provisional +homepage: https://github.com/intractable/horizon +bug-reports: https://github.com/intractable/horizon/issues +Package-url: http://hackage.haskell.org/package/horizon +tested-with: GHC == 7.8.3 + +library + exposed-modules: Data.Time.Horizon + -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && < 4.8, + time >= 1.4.2 && < 1.5, + AC-Angle >= 1.0 && < 2.0 + hs-source-dirs: src + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/intractable/horizon.git diff --git a/src/Data/Time/Horizon.hs b/src/Data/Time/Horizon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Horizon.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE ViewPatterns #-} + +{- + Module : Data.Time.Horizon + License : BSD3 + Copyright : (C) 2015 Joel Stanley + Maintainer : Joel Stanley + Stability : provisional + + Provides approximate sunrise and sunset times in UTC from latitude and + longitude coordinates. + + See https://en.wikipedia.org/wiki/Sunrise_equation. + See http://aa.usno.navy.mil/data/docs/RS_OneYear.php. + +-} + +module Data.Time.Horizon + ( LatitudeNorth + , LongitudeWest + , sunrise + , sunset + ) + where + +import Data.Angle +import Data.Fixed +import Data.Time + +type LatitudeNorth = Double +type LongitudeWest = Double + +-- | Returns an approximated UTC time of the sunrise on the given UTC day at the given location. +sunrise :: Day -> LongitudeWest -> LatitudeNorth -> UTCTime +sunrise d lw ln = mkUTC d . jdToSeconds $ sunrise' d lw ln + +-- | Returns an approximated UTC time of the sunset on the given UTC day at the given location. +sunset :: Day -> LongitudeWest -> LatitudeNorth -> UTCTime +sunset d lw ln = mkUTC d . jdToSeconds $ sunset' d lw ln + +-- | Approximate the Julian date of the sunrise on the given UTC day at the given location. +sunrise' :: Day -> LongitudeWest -> LatitudeNorth -> Double +sunrise' d lw ln = jtransit - (jset - jtransit) + where + u = mkUTC d 0 + jtransit = solarTransit u lw + jset = sunset' d lw ln + +-- | Approximate the Julian date of the sunset on the given UTC day at the given location. +sunset' :: Day -> LongitudeWest -> LatitudeNorth -> Double +sunset' d lw ln = + 2451545.0009 + ((w0 + lw) / 360) + n + 0.0053 * sine m - 0.0069 * sine (2 * lambda) + where + u = mkUTC d 0 + Degrees w0 = omega0 u lw ln + n = fromIntegral (julianCycle u lw :: Integer) + m = solarMeanAnomaly u lw + lambda = eclipticLongitude u lw + +toJD :: RealFrac a => UTCTime -> a +toJD = (+2400000.5) . toMJD + where + toMJD (UTCTime (fromIntegral . toModifiedJulianDay -> d) (toRational -> dt)) = + fromRational (d + dt / 86401) + +jdToSeconds :: (RealFrac a, Integral b) => a -> b +jdToSeconds jd = floor (dayFrac * 86401) + where + dayFrac = mjd - fromIntegral (floor mjd :: Integer) + mjd = jd - 2400000.5 + +julianCycle :: Integral a => UTCTime -> LongitudeWest -> a +julianCycle u lw = n + where + n = floor (nstar + 0.5) + nstar = jdate - 2451545.0009 - (lw / 360) + jdate = toJD u + +approxSolarNoon :: UTCTime -> LongitudeWest -> Double +approxSolarNoon u lw = jstar + where + jstar = 2451545.0009 + lw / 360 + fromIntegral (julianCycle u lw :: Int) + +solarMeanAnomaly :: UTCTime -> LongitudeWest -> Degrees Double +solarMeanAnomaly u lw = Degrees m + where + m = (357.5291 + 0.98560028 * (approxSolarNoon u lw - 2451545)) `mod'` 360 + +equationOfCenter :: UTCTime -> LongitudeWest -> Double +equationOfCenter u lw = c + where + c = 1.9148 * sine m + 0.0200 * sine (2 * m) + 0.0003 * sine (3 * m) + m = solarMeanAnomaly u lw + +eclipticLongitude :: UTCTime -> LongitudeWest -> Degrees Double +eclipticLongitude u lw = Degrees lambda + where + lambda = (m + 102.9372 + c + 180) `mod'` 360 + Degrees m = solarMeanAnomaly u lw + c = equationOfCenter u lw + +solarTransit :: UTCTime -> LongitudeWest -> Double +solarTransit u lw = jtransit + where + jtransit = jstar + 0.0053 * sine m - 0.0069 * sine (2 * lambda) + jstar = approxSolarNoon u lw + m = solarMeanAnomaly u lw + lambda = eclipticLongitude u lw + +declination :: UTCTime -> LongitudeWest -> Degrees Double +declination u lw = arcsine (sine lambda * sine (Degrees 23.45)) + where + lambda = eclipticLongitude u lw + +omega0 :: UTCTime -> LongitudeWest -> LatitudeNorth -> Degrees Double +omega0 u lw ln = arccosine (num / denom) + where + num = sine (Degrees (-0.83)) - sine phi * sine gamma' + denom = cosine phi * cosine gamma' + phi = Degrees ln + gamma' = declination u lw + +mkUTC :: Day -> Integer -> UTCTime +mkUTC d = UTCTime d . secondsToDiffTime