From f1bf9b3f38b930e58852d554c4ed12db6f637a73 Mon Sep 17 00:00:00 2001 From: Bob Rogers Date: Sat, 4 May 2024 19:04:46 -0700 Subject: [PATCH] Don't predict pumpernickel weeks in the past * rgr-pumpernickel.el: + (rgr-show-pumpernickel-intervals): Add a verbose parameter to use a numeric arg to display the table of dates and intervals. Allow for the passage of time to the present since the last pumpernickel week by dropping the counts for all shorter intervals, regarding them as impossible. That is done for the "next week" prediction, then use that data with the full set for the subsequent prediction. + (rgr-alist-convolution): Add another arg so we can convolve a list against another. --- rgr-pumpernickel.el | 46 +++++++++++++++++++++++++++++++++------------ 1 file changed, 34 insertions(+), 12 deletions(-) diff --git a/rgr-pumpernickel.el b/rgr-pumpernickel.el index c0021e7..ceb4fff 100644 --- a/rgr-pumpernickel.el +++ b/rgr-pumpernickel.el @@ -95,11 +95,11 @@ (forward-line -1) (fill-paragraph))) -(defun rgr-alist-convolution (alist) - ;; Given an alist of (key . count), produce its self-convolution. +(defun rgr-alist-convolution (alist1 alist2) + ;; Given two alists of (key . count), the convolution of one with the other. (let ((result nil)) - (dolist (pair1 alist) - (dolist (pair2 alist) + (dolist (pair1 alist1) + (dolist (pair2 alist2) (let* ((key (+ (car pair1) (car pair2))) (count (* (cdr pair1) (cdr pair2))) (result-pair (assoc key result))) @@ -109,10 +109,10 @@ (sort result #'(lambda (a b) (> (cdr a) (cdr b)))))) ;;;###autoload -(defun rgr-show-pumpernickel-intervals () +(defun rgr-show-pumpernickel-intervals (&optional verbose) "Print a table of intervals between known pumpernickel weeks. The dominant intervals correspond (so far) to 6 or 5 weeks." - (interactive) + (interactive "P") (with-help-window (help-buffer) ;; The "bagel of the week" starts on Wednesday. Go figure. (let* ((tail '("2022 Sep 21" "2022 Nov 02" "2022 Nov 30" "2023 Jan 11" @@ -132,25 +132,47 @@ The dominant intervals correspond (so far) to 6 or 5 weeks." ;; without warning. -- rgr, 20-Aug-23.] (weekday-name (car (rassoc weekday url-weekday-alist)))) ;; (message "%S => %d" from (rgr-date-to-day from)) - (princ (format "%s %s .. %s => %d days\n" - weekday-name from to days)) + (when verbose + (princ (format "%s %s .. %s => %d days\n" + weekday-name from to days))) (cl-incf (aref histogram days)) (setq last to)) (setq tail (cdr tail))) + ;; Report the two most popular intervals. (let ((hist nil) (n 0) - (last-day (rgr-date-to-day last))) + (last-day (rgr-date-to-day last)) + (elapsed-hist nil)) (dotimes (i histogram-size) (let ((count (aref histogram i))) (when (> count 0) (cl-incf n count) (push (cons i count) hist)))) (setq hist (sort hist #'(lambda (a b) (> (cdr a) (cdr b))))) - (rgr-pump--draw-histogram hist) - (rgr-pump--make-prediction "Next pumpernickel week" last-day hist) + + ;; Allow for the passage of time since the last pumpernickel week. + (let ((elapsed-days (- (time-to-days (current-time)) last-day)) + (missed-week-count 0)) + ;; Assume there's been no pumpernickel this week or any previous week + ;; by dropping the counts for all shorter intervals. + (setq elapsed-hist hist) + (while (and elapsed-hist + (<= (car (car elapsed-hist)) elapsed-days)) + (cl-incf missed-week-count) + (pop elapsed-hist)) + (if (not elapsed-hist) + (insert (format "\nIt's been a longer interval (%d days)" + elapsed-days) + " than we've ever seen before.\n") + (when (> missed-week-count 0) + (insert "\nAssuming it's not this week:\n")) + (rgr-pump--draw-histogram elapsed-hist) + (rgr-pump--make-prediction "Next pumpernickel week" + last-day elapsed-hist))) + ;; Now do the two-interval prediction. - (let ((twice-hist (rgr-alist-convolution hist))) + (let ((twice-hist (rgr-alist-convolution hist elapsed-hist))) ;; (insert (prin1-to-string twice-hist)) (rgr-pump--draw-histogram twice-hist) (rgr-pump--make-prediction "The following pumpernickel week" -- 2.45.2