How to count days excluding weekends and holidays in Emacs calendar - emacs

In Emacs calendar, one can count days between two dates (including both the start and the end date) using the M-= which runs the command calendar-count-days-region. How can I count days excluding the weekends (Saturday and Sunday) and if defined holidays coming from the variables: holiday-general-holidays and holiday-local-holidays?

I think this essentially breaks down into three parts:
Count the days in a region
subtract the weekend days
subtract the holidays
Emacs already has the first part covered with M-= (calendar-count-days-region), so let's take a look at that function.
Helpful, but unfortunately it reads the buffer and sends the output directly. Let's make a generalized version which takes start and end date parameters and returns the number of days instead of printing them:
(defun my-calendar-count-days(d1 d2)
(let* ((days (- (calendar-absolute-from-gregorian d1)
(calendar-absolute-from-gregorian d2)))
(days (1+ (if (> days 0) days (- days)))))
days))
This is pretty much just a copy of the calendar-count-days-region function, but without the buffer reading & writing stuff. Some tests:
(ert-deftest test-count-days ()
"Test my-calendar-count-days function"
(should (equal (my-calendar-count-days '(5 1 2014) '(5 31 2014)) 31))
(should (equal (my-calendar-count-days '(12 29 2013) '(1 4 2014)) 7))
(should (equal (my-calendar-count-days '(2 28 2012) '(3 1 2012)) 3))
(should (equal (my-calendar-count-days '(2 28 2014) '(3 1 2014)) 2)))
Now, for step 2, I can't find any built-in function to calculate weekend days for a date range (surprisingly!). Luckily, this /might/ be pretty simple when working with absolute dates. Here's a very naive attempt which simply loops through all absolute dates in the range and looks for Saturdays & Sundays:
(defun my-calendar-count-weekend-days(date1 date2)
(let* ((tmp-date (if (< date1 date2) date1 date2))
(end-date (if (> date1 date2) date1 date2))
(weekend-days 0))
(while (<= tmp-date end-date)
(let ((day-of-week (calendar-day-of-week
(calendar-gregorian-from-absolute tmp-date))))
(if (or (= day-of-week 0)
(= day-of-week 6))
(incf weekend-days ))
(incf tmp-date)))
weekend-days))
That function should be optimized since it does a bunch of unnecessary looping (e.g. we know that the 5 days after Sunday won't be weekend days, so there is no need to convert & test them), but for the purpose of this example I think it's pretty clear and simple. Good Enough for now, indeed. Some tests:
(ert-deftest test-count-weekend-days ()
"Test my-calendar-count-weekend-days function"
(should (equal (my-calendar-count-weekend-days
(calendar-absolute-from-gregorian '(5 1 2014))
(calendar-absolute-from-gregorian '(5 31 2014))) 9))
(should (equal (my-calendar-count-weekend-days
(calendar-absolute-from-gregorian '(4 28 2014))
(calendar-absolute-from-gregorian '(5 2 2014))) 0))
(should (equal (my-calendar-count-weekend-days
(calendar-absolute-from-gregorian '(2 27 2004))
(calendar-absolute-from-gregorian '(2 29 2004))) 2)))
Lastly, we need to know the holidays in the range, and emacs provides this in the holiday-in-range function! Note that this function calls calendar-holiday-list to determine which holidays to include, so if you really want to search only holiday-general-holidays and holiday-local-holidays you would need to set your calendar-holidays variable appropriately. See C-h v calendar-holidays for the details.
Now we can wrap all this up in a new interactive function which does the three steps above. This is essentially another modified version of calendar-count-days-region that subtracts weekends and holidays before printing the results (see edit below before running):
(defun calendar-count-days-region2 ()
"Count the number of days (inclusive) between point and the mark
excluding weekends and holidays."
(interactive)
(let* ((d1 (calendar-cursor-to-date t))
(d2 (car calendar-mark-ring))
(date1 (calendar-absolute-from-gregorian d1))
(date2 (calendar-absolute-from-gregorian d2))
(start-date (if (< date1 date2) date1 date2))
(end-date (if (> date1 date2) date1 date2))
(days (- (my-calendar-count-days d1 d2)
(+ (my-calendar-count-weekend-days start-date end-date)
(my-calendar-count-holidays-on-weekdays-in-range
start-date end-date)))))
(message "Region has %d workday%s (inclusive)"
days (if (> days 1) "s" ""))))
I'm sure someone more knowledgeable about lisp/elisp could simplify/improve these examples considerably, but I hope it at least serves as a starting point.
Actually, now that I've gone through it, I expect somebody to come along any minute and point out that there is an emacs package that already does this...
Edit: DOH!, Bug #001: If a holiday falls on a weekend, that day is removed twice...
Once solution would be to simply wrap holiday-in-range so we can eliminate holidays which were already removed for being on a weekend:
(defun my-calendar-count-holidays-on-weekdays-in-range (start end)
(let ((holidays (holiday-in-range start end))
(counter 0))
(dolist (element holidays)
(let ((day (calendar-day-of-week (car element))))
(if (and (> day 0)
(< day 6))
(incf counter))))
counter))
I've updated the calendar-count-days-region2 above to use this new function.

Related

Application not a procedure error in Racket

I'm trying to write a function called dates_in_month that takes a list of dates and a month and returns a list holding the dates from the argument list of dates that are in the month. The returned list should contain dates in the order they were originally given. However I'm new to Racket and I'm getting the error "application: not a procedure;
expected a procedure that can be applied to arguments
given: 5"
Does anyone know what this means or how to fix it? If anyone can point out my error that'd be much appreciated.
This is the code i am working on with my test case at the bottom.
#lang racket
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1) (append (cdr lst1) lst2))))
(define (dates_in_month dates month)
(if (null? dates)
'()
(let ((date (car dates)))
(if (= (month date) month)
(cons date (dates_in_month (cdr dates) month))
(dates_in_month (cdr dates) month)))))
(define test-dates '(#(1 1 2000) #(2 2 2000) #(3 3 2000) #(4 4
2000) #(5 5 2000) #(6 6 2000)))
(dates_in_month test-dates 5)
Your error is caused by calling (month date)- month should be some procedure, which you want to call with the argument date (date will be some vector), but month has value 5, that isn't a procedure.
That is the meaning of the error message:
"application: not a procedure; expected a procedure that can be applied to arguments given: 5"
I guess you need to get somehow the second element of the vector date and then compare it with the value of month. You should use the function vector-ref- example:
> (vector-ref #(5 5 2000) 1)
5
See also DrRacket docs for Vectors for other functions for working with vectors.
And if you can, you could also use filter instead of recursion. Here are both variants:
(define (dates-in-month dates month)
(if (null? dates)
'()
(let ((date (car dates)))
(if (= (vector-ref date 1) month)
(cons date (dates-in-month (cdr dates) month))
(dates-in-month (cdr dates) month)))))
(define (dates-in-month2 dates month)
(filter (lambda (date) (= (vector-ref date 1) month))
dates))
(define test-dates '(#(1 1 2000) #(2 2 2000) #(3 3 2000) #(4 4 2000) #(5 5 2000) #(6 6 2000)))
(dates-in-month test-dates 5)
(dates-in-month2 test-dates 5)
And append is already part of the DrRacket language, so you don't have to reimplement it.

How to list all the leap year from 1800 in LISP?

I have this code below which takes one parameter and prints all the list of leap year in reverse order. how can I make it take 1800 as default input and just run command (leap) to list all the leap years from 1800-2018?
CODE:
(defun leap (q)
(if (< q 1800)
(RETURN-FROM leap nil)
)
(leap (- q 1))
(if (leapyear q)
(push q mylist)
)
mylist
)
(reverse(leap 2018))
I can't completely understand what you are trying to do, but:
(defun leapyearp (y)
;; is Y a leap year, as best we can tell?
(= (nth-value 3 (decode-universal-time
(+ (encode-universal-time 0 0 0 28 2 y)
(* 60 60 24))))
29))
(defun leapyears (&key (start 1800) (end (nth-value 5 (get-decoded-time))))
;; all the leap years in a range
(loop for y from start to end
if (leapyearp y) collect y))

Function to determine holiday in elisp

It's there any function to determine current system date is holiday or not in elisp.
function like this.
(is-holiday (current-time))
The answer requires that the user set up a calendar of predefined holidays, like this example. I have included a test holiday for May 9 -- if the user wishes to test out this function on any day other than May 9, the user may wish to change the Arbitrary Test Holiday to whatever day the test is being performed -- after the function has been tested, the test entry can be removed.
For examples of how to format the holidays, please refer to the doc-string for the variable calendar-holidays within the library holidays.el -- e.g., holiday-fixed; holiday-float; holiday-sexp; (lunar-phases); (solar-equinoxes-solstices); holiday-hebrew; holiday-islamic; holiday-bahai; holiday-julian; holiday-chinese; etc.
How can you try out this example?: Block/copy/paste the code into your *scratch* buffer; and type M-x eval-buffer RET; and then type M-x is-holiday RET. It is a fully functional working draft. If you decide that you don't like it after you try it, just restart Emacs and you'll be back to where you were before you tried it.
The testing that was performed was done with the most recent public release of Emacs: GNU Emacs 24.4.1 (x86_64-apple-darwin10.8.0, NS apple-appkit-1038.36) of 2014-10-20 on builder10-6.porkrind.org.
(require 'holidays)
(defcustom my-custom-holiday-list (mapcar 'purecopy '(
(holiday-fixed 1 1 "New Year's Day")
(holiday-float 1 1 3 "Martin Luther King Day")
(holiday-float 2 1 3 "President's Day")
(holiday-float 5 1 -1 "Memorial Day")
;; ARBITRARY TEST HOLIDAY -- MAY 9
(holiday-fixed 5 9 "Arbitrary Test Holiday -- May 9")
(holiday-fixed 7 4 "Independence Day")
(holiday-float 9 1 1 "Labor Day")
(holiday-float 10 1 2 "Columbus Day")
(holiday-fixed 11 11 "Veteran's Day")
(holiday-float 11 4 4 "Thanksgiving")
(holiday-fixed 12 25 "Christmas")
(solar-equinoxes-solstices)
(holiday-sexp calendar-daylight-savings-starts
(format "Daylight Saving Time Begins %s"
(solar-time-string
(/ calendar-daylight-savings-starts-time (float 60))
calendar-standard-time-zone-name)))
(holiday-sexp calendar-daylight-savings-ends
(format "Daylight Saving Time Ends %s"
(solar-time-string
(/ calendar-daylight-savings-ends-time (float 60))
calendar-daylight-time-zone-name))) ))
"Custom holidays defined by the user."
:type 'sexp
:group 'holidays)
(defun is-holiday ()
"Is today a holiday?"
(interactive)
(let* (
(d1 (time-to-days (current-time)))
(date (calendar-gregorian-from-absolute d1))
ee
res-holidays
(displayed-month (nth 0 date))
(displayed-year (nth 2 date))
(holiday-list
(dolist (p my-custom-holiday-list res-holidays)
(let* (h)
(when (setq h (eval p))
(setq res-holidays (append h res-holidays)))))) )
(mapcar
(lambda (x)
(let ((txt (format "%s -- %s" (car x) (car (cdr x)))))
(when (eq d1 (calendar-absolute-from-gregorian (car x)))
(push txt ee))))
holiday-list)
(if ee
(message "The following holiday(s) is/are today: %s" (nreverse ee))
(message "Today is not a holiday."))))

How to implement the 24 solar terms in Lisp with Emacs Calendar

I tried to learn the code in cal-china.el in Emacs source code and found the following code:
;;;###holiday-autoload
(defun holiday-chinese-winter-solstice ()
"Date of Chinese winter solstice, if visible in calendar.
Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian."
(when (memq displayed-month '(11 12 1)) ; is December visible?
(list (list (calendar-gregorian-from-absolute
(calendar-chinese-zodiac-sign-on-or-after
(calendar-absolute-from-gregorian
(list 12 15 (if (eq displayed-month 1)
(1- displayed-year)
displayed-year)))))
"Winter Solstice Festival"))))
This code is used to calculate the winter solstice. I also knew that these 24 solar terms are needed for calculating Chinese calendar. So I wonder how to calculate all the 24 solar terms in Lisp.
Thank you.
For anyone interested in Chinese calendar, please refer to this repo for details.
https://github.com/xwl/cal-china-x
The solar terms can be calculated with the following code after you install cal-china-x
;;;###autoload
(defun holiday-solar-term (solar-term str)
"A holiday(STR) on SOLAR-TERM day.
See `cal-china-x-solar-term-name' for a list of solar term names ."
(cal-china-x-sync-solar-term displayed-year)
(let ((terms cal-china-x-solar-term-alist)
i date)
(while terms
(setq i (car terms)
terms (cdr terms))
(when (string= (cdr i) solar-term)
(let ((m (caar i))
(y (cl-caddar i)))
;; displayed-year, displayed-month is accurate for the centered month
;; only. Cross year view: '(11 12 1), '(12 1 2)
(when (or (and (cal-china-x-cross-year-view-p)
(or (and (= displayed-month 12)
(= m 1)
(= y (1+ displayed-year)))
(and (= displayed-month 1)
(= m 12)
(= y (1- displayed-year)))))
(= y displayed-year))
(setq terms '()
date (car i))))))
(holiday-fixed (car date) (cadr date) str)))

How do I get the number of days in the month specified by an elisp time?

In elisp I have a time in the (form of three integers), and I can get the month using decode-time. What I'd like to get is the number of days in that month (and year), using elisp functions (rather than write my own).
i.e:
(defun days-in-month-at-time(t)
; Figure out month and year with decode-time
; return number of days in that month
)
(require 'timezone)
(defun days-in-month-at-time (time)
"Return number of days in month at TIME."
(let ((datetime (decode-time time)))
(timezone-last-day-of-month (nth 4 datetime) (nth 5 datetime))))
Looks like this is better since time-zone doesn't seem to be in all recent emacs versions
edit: Sorry you just need to require timezone, or calendar depending on whether you use this or the other answer.
(defun days-in-month-at-time (time)
"Return number of days in month at TIME."
(let ((datetime (decode-time time)))
(calendar-last-day-of-month (nth 4 datetime) (nth 5 datetime))))
I came up with a solution that doesn't require timezone or calendar by extracting the day from the last day of the month:
(defun days-in-month-at-time(tm)
(let ((d (decoded-time-add (decode-time tm) (make-decoded-time :month 1))))
(setf (decoded-time-day d) 1)
(decoded-time-day (decoded-time-add d (make-decoded-time :day -1))))
)