bug#43677: 27.1; Calc holidays off-by-one error, incorrect business day calculation

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 411 bytes --]

Aaron, does this patch solve your problem?

It turned out that the ability to select arbitrary holiday weekdays never really worked correctly; the patch attempts to do something about that as well.

The business days code also doesn't work at all very well for BC dates, which of course limits its applicability somewhat but perhaps not critically so. Please tell me if that is something you need fixed.


[-- Attachment #2: 0001-Calc-fix-business-days-calculation-bug43677.patch --]
[-- Type: application/octet-stream, Size: 6946 bytes --]

From 802089648160a91876f471c17a400b84b465ce5a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Wed, 30 Sep 2020 23:57:27 +0200
Subject: [PATCH] Calc: fix business days calculation (bug43677)

The calculation of business days was broken in 2012 (probably
310e60d9454fe2 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.

* 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.
---
 lisp/calc/calc-forms.el      | 13 +++---
 test/lisp/calc/calc-tests.el | 76 ++++++++++++++++++++++++++++++++++++
 2 files changed, 83 insertions(+), 6 deletions(-)

diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 5a8f0a38d2..6d70126c09 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -1870,8 +1870,8 @@ math-to-business-day
       (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 @@ math-from-business-day
 	(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
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index dce82b6f53..4dded007f7 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -458,6 +458,82 @@ calc-choose
                   (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
 
-- 
2.21.1 (Apple Git-122.3)


[-- Attachment #3: Type: text/plain, Size: 2 bytes --]