1 ;;; solar.el --- calendar functions for solar events.
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
6 ;; Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
27 ;; This collection of functions implements the features of calendar.el and
28 ;; diary.el that deal with sunrise/sunset and eqinoxes/solstices.
30 ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
31 ;; Almanac Office, United States Naval Observatory, Washington, 1984 and
32 ;; on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
33 ;; Willmann-Bell, Inc., 1985.
36 ;; 1. SUNRISE/SUNSET calculations will be accurate only to +/- 2 minutes.
37 ;; Locations should be between +/- 65 degrees of latitude.
38 ;; Dates should be in the latter half of the 20th century.
40 ;; 2. Equinox/solstice times will be accurate only to +/- 15 minutes.
42 ;; The author would be delighted to have an astronomically more sophisticated
43 ;; person rewrite the code for the solar calculations in this file!
45 ;; Comments, corrections, and improvements should be sent to
46 ;; Edward M. Reingold Department of Computer Science
47 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
48 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
49 ;; Urbana, Illinois 61801
54 (require 'lisp-float-type
)
55 (error "Solar calculations impossible since floating point is unavailable."))
60 "Prompt user for latitude, longitude, and time zone."
62 (if (not calendar-longitude
)
63 (setq calendar-longitude
65 "Enter longitude (decimal fraction; + east, - west): ")))
66 (if (not calendar-latitude
)
67 (setq calendar-latitude
69 "Enter latitude (decimal fraction; + north, - south): ")))
70 (if (not calendar-time-zone
)
71 (setq calendar-time-zone
73 "Enter difference from Universal Time (in minutes): "))))
75 (defun solar-get-number (prompt)
76 "Return a number from the minibuffer, prompting with PROMPT.
77 Returns nil if nothing was entered."
78 (let ((x (read-string prompt
"")))
79 (if (not (string-equal x
""))
82 (defun solar-sin-degrees (x)
83 (sin (degrees-to-radians x
)))
85 (defun solar-cosine-degrees (x)
86 (cos (degrees-to-radians x
)))
88 (defun solar-tangent-degrees (x)
89 (tan (degrees-to-radians x
)))
91 (defun solar-xy-to-quadrant (x y
)
92 "Determines the quadrant of the point X, Y."
97 (defun solar-degrees-to-quadrant (angle)
98 "Determines the quadrant of ANGLE."
99 (1+ (truncate (/ (solar-mod angle
360.0) 90.0))))
101 (defun solar-arctan (x quad
)
102 "Arctangent of X in quadrant QUAD."
103 (let ((deg (radians-to-degrees (atan x
))))
104 (cond ((equal quad
2) (+ deg
180))
105 ((equal quad
3) (+ deg
180))
106 ((equal quad
4) (+ deg
360))
109 (defun solar-arccos (x)
110 (let ((y (sqrt (- 1 (* x x
)))))
111 (solar-arctan (/ y x
) (solar-xy-to-quadrant x y
))))
113 (defun solar-arcsin (y)
114 (let ((x (sqrt (- 1 (* y y
)))))
115 (solar-arctan (/ y x
) (solar-xy-to-quadrant x y
))))
117 (defun solar-mod (x y
)
118 "Returns X mod Y; value is *always* non-negative."
124 (defconst solar-earth-inclination
23.441884
125 "Inclination of earth's equator to its solar orbit in degrees.")
127 (defconst solar-cos-inclination
(solar-cosine-degrees solar-earth-inclination
)
128 "Cosine of earth's inclination.")
130 (defconst solar-sin-inclination
(solar-sin-degrees solar-earth-inclination
)
131 "Sine of earth's inclination.")
133 (defconst solar-earth-orbit-eccentricity
0.016718
134 "Eccentricity of orbit of the earth around the sun.")
136 (defmacro solar-degrees-to-hours
(deg)
139 (defmacro solar-hours-to-days
(hour)
142 (defun solar-longitude-of-sun (day)
143 "Longitude of the sun at DAY in the year."
144 (let ((mean-anomaly (- (* 0.9856 day
) 3.289)))
145 (solar-mod (+ mean-anomaly
146 (* 1.916 (solar-sin-degrees mean-anomaly
))
147 (* 0.020 (solar-sin-degrees (* 2 mean-anomaly
)))
151 (defun solar-right-ascension (longitude)
152 "Right ascension of the sun, given its LONGITUDE."
153 (solar-degrees-to-hours
155 (* solar-cos-inclination
(solar-tangent-degrees longitude
))
156 (solar-degrees-to-quadrant longitude
))))
158 (defun solar-declination (longitude)
159 "Declination of the sun, given its LONGITUDE."
161 (* solar-sin-inclination
162 (solar-sin-degrees longitude
))))
164 (defun solar-sunrise (date)
165 "Calculates the *standard* time of sunrise for Gregorian DATE for location
166 given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fraction
167 of hours. Returns nil if the sun does not rise at that location on that day."
168 (let* ((day-of-year (calendar-day-number date
))
172 (- 6 (solar-degrees-to-hours calendar-longitude
)))))
173 (solar-longitude-of-sun-at-sunrise
174 (solar-longitude-of-sun approx-sunrise
))
175 (solar-right-ascension-at-sunrise
176 (solar-right-ascension solar-longitude-of-sun-at-sunrise
))
177 (solar-declination-at-sunrise
178 (solar-declination solar-longitude-of-sun-at-sunrise
))
180 (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0)))
181 (* (solar-sin-degrees solar-declination-at-sunrise
)
182 (solar-sin-degrees calendar-latitude
)))
183 (* (solar-cosine-degrees solar-declination-at-sunrise
)
184 (solar-cosine-degrees calendar-latitude
)))))
185 (if (<= (abs cos-local-sunrise
) 1);; otherwise, no sunrise that day
186 (let* ((local-sunrise (solar-degrees-to-hours
187 (- 360 (solar-arccos cos-local-sunrise
))))
189 (solar-mod (- (+ local-sunrise solar-right-ascension-at-sunrise
)
190 (+ (* 0.065710 approx-sunrise
)
193 (+ (- local-mean-sunrise
(solar-degrees-to-hours calendar-longitude
))
194 (/ calendar-time-zone
60.0))))))
196 (defun solar-sunset (date)
197 "Calculates the *standard* time of sunset for Gregorian DATE for location
198 given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fractions
199 of hours. Returns nil if the sun does not set at that location on that day."
200 (let* ((day-of-year (calendar-day-number date
))
204 (- 18 (solar-degrees-to-hours calendar-longitude
)))))
205 (solar-longitude-of-sun-at-sunset
206 (solar-longitude-of-sun approx-sunset
))
207 (solar-right-ascension-at-sunset
208 (solar-right-ascension solar-longitude-of-sun-at-sunset
))
209 (solar-declination-at-sunset
210 (solar-declination solar-longitude-of-sun-at-sunset
))
212 (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0)))
213 (* (solar-sin-degrees solar-declination-at-sunset
)
214 (solar-sin-degrees calendar-latitude
)))
215 (* (solar-cosine-degrees solar-declination-at-sunset
)
216 (solar-cosine-degrees calendar-latitude
)))))
217 (if (<= (abs cos-local-sunset
) 1);; otherwise, no sunset that day
218 (let* ((local-sunset (solar-degrees-to-hours
219 (solar-arccos cos-local-sunset
)))
221 (solar-mod (- (+ local-sunset solar-right-ascension-at-sunset
)
222 (+ (* 0.065710 approx-sunset
) 6.622))
224 (+ (- local-mean-sunset
(solar-degrees-to-hours calendar-longitude
))
225 (/ calendar-time-zone
60.0))))))
227 (defun solar-time-string (time date
)
228 "Printable form for decimal fraction standard TIME on DATE.
229 Format used is given by `calendar-time-display-form'. Converted to daylight
230 savings time according to `calendar-daylight-savings-starts' and
231 `calendar-daylight-savings-ends', if those variables are not nil."
232 (let* ((year (extract-calendar-year date
))
233 (abs-date (calendar-absolute-from-gregorian date
))
234 (dst (and calendar-daylight-savings-starts
235 calendar-daylight-savings-ends
236 (<= (calendar-absolute-from-gregorian
237 (eval calendar-daylight-savings-starts
))
240 (calendar-absolute-from-gregorian
241 (eval calendar-daylight-savings-ends
)))))
242 (time (if dst
(1+ time
) time
))
244 calendar-daylight-time-zone-name
245 calendar-standard-time-zone-name
))
246 (24-hours (truncate time
))
247 (12-hours (format "%d" (if (> 24-hours
12)
249 (if (= 24-hours
0) 12 24-hours
))))
250 (am-pm (if (>= 24-hours
12) "pm" "am"))
251 (minutes (format "%02d" (round (* 60 (- time
24-hours
)))))
252 (24-hours (format "%02d" 24-hours
)))
253 (mapconcat 'eval calendar-time-display-form
"")))
255 (defun solar-sunrise-sunset (date)
256 "String giving local times of sunrise and sunset on Gregorian DATE."
257 (let ((rise (solar-sunrise date
))
258 (set (solar-sunset date
)))
259 (format "%s, %s at %s"
261 (concat "Sunrise " (solar-time-string rise date
))
264 (concat "sunset " (solar-time-string set date
))
266 (eval calendar-location-name
))))
268 (defun solar-apparent-longitude-of-sun (date)
269 "Apparent longitude of the sun on Gregorian DATE."
270 (let* ((time (/ (- (calendar-absolute-from-gregorian date
)
271 (calendar-absolute-from-gregorian '(1 0.5 1900)))
275 (* 0.0003025 time time
)))
278 (* -
0.000150 time time
)
279 (* -
0.0000033 time time time
)))
282 (* -
0.000014 time time
))
283 (solar-sin-degrees m
))
286 (solar-sin-degrees (* 2 m
)))
288 (solar-sin-degrees (* 3 m
)))))
295 (solar-sin-degrees omega
)))))
298 (defun solar-ephemeris-correction (year)
299 "Difference in minutes between Ephemeris time an Universal time in YEAR.
300 Value is only an approximation."
301 (let ((T (/ (- year
1900) 100.0)))
302 (+ 0.41 (* 1.2053 T
) (* 0.4992 T T
))))
304 (defun solar-equinoxes/solstices
(k year
)
305 "Date of equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer
306 solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within
308 (let ((date (list (+ 3 (* k
3)) 21 year
))
310 (while (> correction
0.00001)
311 (setq app
(solar-mod (solar-apparent-longitude-of-sun date
) 360.0))
312 (setq correction
(* 58 (solar-sin-degrees (- (* k
90) app
))))
313 (setq date
(list (extract-calendar-month date
)
314 (+ (extract-calendar-day date
) correction
)
316 (list (extract-calendar-month date
)
317 (+ (extract-calendar-day date
) (/ calendar-time-zone
60.0 24.0)
318 (- (/ (solar-ephemeris-correction year
) 60.0 24.0)))
322 (defun sunrise-sunset (&optional arg
)
323 "Local time of sunrise and sunset for today. Accurate to +/- 2 minutes.
324 If called with an optional prefix argument, prompts for date.
326 If called with an optional double prefix argument, prompts for longitude,
327 latitude, time zone, and date.
329 This function is suitable for execution in a .emacs file."
332 (not (and calendar-latitude calendar-longitude calendar-time-zone
)))
334 (let* ((calendar-longitude
335 (if (< arg
16) calendar-longitude
337 "Enter longitude (decimal fraction; + east, - west): ")))
339 (if (< arg
16) calendar-latitude
341 "Enter latitude (decimal fraction; + north, - south): ")))
343 (if (< arg
16) calendar-time-zone
345 "Enter difference from Universal Time (in minutes): ")))
346 (calendar-location-name
347 (if (< arg
16) calendar-location-name
348 (let ((float-output-format "%.1f"))
350 (abs calendar-latitude
)
351 (if (> calendar-latitude
0) "N" "S")
352 (abs calendar-longitude
)
353 (if (> calendar-longitude
0) "E" "W")))))
354 (calendar-standard-time-zone-name
355 (if (< arg
16) calendar-standard-time-zone-name
356 (cond ((= calendar-time-zone
0) "UT")
357 ((< calendar-time-zone
0)
358 (format "UT%dmin" calendar-time-zone
))
359 (t (format "UT+%dmin" calendar-time-zone
)))))
360 (calendar-daylight-savings-starts
361 (if (< arg
16) calendar-daylight-savings-starts
))
362 (calendar-daylight-savings-ends
363 (if (< arg
16) calendar-daylight-savings-ends
))
364 (date (if (< arg
4) (calendar-current-date) (calendar-read-date)))
365 (date-string (calendar-date-string date t
))
366 (time-string (solar-sunrise-sunset date
))
367 (msg (format "%s: %s" date-string time-string
))
368 (one-window (one-window-p t
)))
369 (if (<= (length msg
) (screen-width))
371 (with-output-to-temp-buffer "*temp*"
372 (princ (concat date-string
"\n" time-string
)))
373 (message (substitute-command-keys
376 "Type \\[delete-other-windows] to remove temp window."
377 "Type \\[switch-to-buffer] RET to remove temp window.")
378 "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))
380 (defun calendar-sunrise-sunset ()
381 "Local time of sunrise and sunset for date under cursor.
382 Accurate to +/- 2 minutes."
384 (if (not (and calendar-latitude calendar-longitude calendar-time-zone
))
387 (solar-sunrise-sunset
388 (or (calendar-cursor-to-date)
389 (error "Cursor is not on a date!")))))
391 (defun diary-sunrise-sunset ()
392 "Local time of sunrise and sunset as a diary entry.
393 Accurate to +/- 2 minutes."
394 (if (not (and calendar-latitude calendar-longitude calendar-time-zone
))
396 (solar-sunrise-sunset date
))
398 (defun diary-sabbath-candles ()
399 "Local time of candle lighting diary entry--applies if date is a Friday.
400 No diary entry if there is no sunset on that date."
401 (if (not (and calendar-latitude calendar-longitude calendar-time-zone
))
403 (if (= (%
(calendar-absolute-from-gregorian date
) 7) 5);; Friday
404 (let* ((sunset (solar-sunset date
))
405 (light (if sunset
(- sunset
(/ 18.0 60.0)))))
406 (if light
(format "%s Sabbath candle lighting"
407 (solar-time-string light date
))))))
409 (defun calendar-holiday-function-solar-equinoxes-solstices ()
410 "Date and time of equinoxes and solstices, if visible in the calendar window.
411 Requires floating point."
412 (let* ((m displayed-month
)
414 (increment-calendar-month m y
(cond ((= 1 (% m
3)) -
1)
417 (let* ((calendar-standard-time-zone-name
418 (if calendar-time-zone calendar-standard-time-zone-name
"UT"))
419 (calendar-daylight-savings-starts
420 (if calendar-time-zone calendar-daylight-savings-starts
))
421 (calendar-daylight-savings-ends
422 (if calendar-time-zone calendar-daylight-savings-ends
))
423 (calendar-time-zone (if calendar-time-zone calendar-time-zone
0))
425 (date (solar-equinoxes/solstices k y
))
426 (day (extract-calendar-day date
))
427 (time (* 24 (- day
(truncate day
))))
428 ;; Time zone/DST can't move the date out of range,
429 ;; so let solar-time-string do the conversion.
430 (date (list (extract-calendar-month date
)
432 (extract-calendar-year date
))))
435 (cond ((= k
0) "Vernal Equinox")
436 ((= k
1) "Summer Solstice")
437 ((= k
2) "Fall Equinox")
438 ((= k
3) "Winter Solstice"))
439 (solar-time-string time date
)))))))
443 ;;; solar.el ends here