procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Calc: fix business days calculation (bug43677)

Browse source 
The calculation of business days was broken in 2012 (probably
310e60d945 or thereabouts) when the date representation changed
epoch so that Jan 1, 1 AD became day number 1 instead of 0.  Repair
this, along with an unrelated bug that prevented arbitrary holiday
weekdays from working.

Reported by Aaron Zeng.

* lisp/calc/calc-forms.el (math-to-business-day)
(math-from-business-day): Correct calculation of weekdays using Calc's
current (Rata Die) chronology.  Modify loop condition to cope with odd
sets of holiday weekdays.
* test/lisp/calc/calc-tests.el (calc-business-days): New test.
This commit is contained in:
Mattias Engdegård 2020-09-30 23:57:27 +02:00
parent d037a6a2e6
commit 4cb16b6f42
2 changed files with 83 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lisp/calc/calc-forms.el
View file

@ -1870,8 +1870,8 @@ and ends on the last Sunday of October at 2 a.m."
(and days (= day (car days))
(setq holiday t)))
(let* ((weekdays (nth 3 math-holidays-cache))
(weeks (1- (/ (+ day 6) 7)))
(wkday (- day 1 (* weeks 7))))
(weeks (/ day 7))
(wkday (mod day 7))) ; Day of week: 0=Sunday, 6=Saturday
(setq delta (+ delta (* weeks (length weekdays))))
(while (and weekdays (< (car weekdays) wkday))
(setq weekdays (cdr weekdays)
@ -1905,14 +1905,15 @@ and ends on the last Sunday of October at 2 a.m."
(setq delta (1+ delta)))
(setq day (+ day delta)))
(let* ((weekdays (nth 3 math-holidays-cache))
(bweek (- 7 (length weekdays)))
(weeks (1- (/ (+ day (1- bweek)) bweek)))
(wkday (- day 1 (* weeks bweek)))
(bweek (- 7 (length weekdays))) ; Business days in a week, 1..7.
(weeks (/ day bweek)) ; Whole weeks.
(wkday (mod day bweek)) ; Business day in last week, 0..bweek-1
(w 0))
(setq day (+ day (* weeks (length weekdays))))
;; Add business days in the last week; `w' is weekday, 0..6.
(while (if (memq w weekdays)
(setq day (1+ day))
(> (setq wkday (1- wkday)) 0))
(>= (setq wkday (1- wkday)) 0))
(setq w (1+ w)))
(let ((hours (nth 7 math-holidays-cache)))
(if hours

76
test/lisp/calc/calc-tests.el
View file

@ -458,6 +458,82 @@ An existing calc stack is reused, otherwise a new one is created."
(calcFunc-choose '(frac -15 2) 3))
(calc-tests--choose -7.5 3))))
(ert-deftest calc-business-days ()
(cl-flet ((m (s) (math-parse-date s))
(b+ (a b) (calcFunc-badd a b))
(b- (a b) (calcFunc-bsub a b)))
;; Sanity check.
(should (equal (m "2020-09-07") '(date 737675)))
;; Test with standard business days (Mon-Fri):
(should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-08") 1) (m "2020-09-09"))) ; Tue->Wed
(should (equal (b+ (m "2020-09-09") 1) (m "2020-09-10"))) ; Wed->Thu
(should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
(should (equal (b+ (m "2020-09-11") 1) (m "2020-09-14"))) ; Fri->Mon
(should (equal (b+ (m "2020-09-07") 4) (m "2020-09-11"))) ; Mon->Fri
(should (equal (b+ (m "2020-09-07") 6) (m "2020-09-15"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-12") 1) (m "2020-09-14"))) ; Sat->Mon
(should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
(should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
(should (equal (b- (m "2020-09-10") 1) (m "2020-09-09"))) ; Thu->Wed
(should (equal (b- (m "2020-09-09") 1) (m "2020-09-08"))) ; Wed->Tue
(should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
(should (equal (b- (m "2020-09-07") 1) (m "2020-09-04"))) ; Mon->Fri
(should (equal (b- (m "2020-09-11") 4) (m "2020-09-07"))) ; Fri->Mon
(should (equal (b- (m "2020-09-15") 6) (m "2020-09-07"))) ; Tue->Mon
(should (equal (b- (m "2020-09-12") 1) (m "2020-09-11"))) ; Sat->Fri
(should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
;; Stepping fractional days
(should (equal (b+ (m "2020-09-08 21:00") '(frac 1 2))
(m "2020-09-09 09:00")))
(should (equal (b+ (m "2020-09-11 21:00") '(frac 1 2))
(m "2020-09-14 09:00")))
(should (equal (b- (m "2020-09-08 21:00") '(frac 1 2))
(m "2020-09-08 09:00")))
(should (equal (b- (m "2020-09-14 06:00") '(frac 1 2))
(m "2020-09-11 18:00")))
;; Test with a couple of extra days off:
(let ((var-Holidays (list 'vec
'(var sat var-sat) '(var sun var-sun)
(m "2020-09-09") (m "2020-09-11"))))
(should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-08") 1) (m "2020-09-10"))) ; Tue->Thu
(should (equal (b+ (m "2020-09-10") 1) (m "2020-09-14"))) ; Thu->Mon
(should (equal (b+ (m "2020-09-14") 1) (m "2020-09-15"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-15") 1) (m "2020-09-16"))) ; Tue->Wed
(should (equal (b- (m "2020-09-16") 1) (m "2020-09-15"))) ; Wed->Tue
(should (equal (b- (m "2020-09-15") 1) (m "2020-09-14"))) ; Tue->Mon
(should (equal (b- (m "2020-09-14") 1) (m "2020-09-10"))) ; Mon->Thu
(should (equal (b- (m "2020-09-10") 1) (m "2020-09-08"))) ; Thu->Tue
(should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
)
;; Test with odd non-business weekdays (Tue, Wed, Sat):
(let ((var-Holidays '(vec (var tue var-tue)
(var wed var-wed)
(var sat var-sat))))
(should (equal (b+ (m "2020-09-07") 1) (m "2020-09-10"))) ; Mon->Thu
(should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
(should (equal (b+ (m "2020-09-11") 1) (m "2020-09-13"))) ; Fri->Sun
(should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
(should (equal (b- (m "2020-09-14") 1) (m "2020-09-13"))) ; Mon->Sun
(should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
(should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
(should (equal (b- (m "2020-09-10") 1) (m "2020-09-07"))) ; Thu->Mon
)
))
(provide 'calc-tests)
;;; calc-tests.el ends here