@@ 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"