From 6082cd0f941819236d28c44c4cea37ecfa422f8d Mon Sep 17 00:00:00 2001 From: Bob Rogers Date: Sat, 17 Feb 2024 12:13:24 -0800 Subject: [PATCH] Add a pumpernickel histogram and make all predictions >=20% * rgr-pumpernickel.el: + (rgr-pump--draw-histogram): New ASCII-art hack. + (rgr-pump--make-prediction): Split this out, show all weeks with at least 20% probability. --- rgr-pumpernickel.el | 73 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 64 insertions(+), 9 deletions(-) diff --git a/rgr-pumpernickel.el b/rgr-pumpernickel.el index fdea453..2b5481f 100644 --- a/rgr-pumpernickel.el +++ b/rgr-pumpernickel.el @@ -27,6 +27,66 @@ (days-to-time (- days (time-to-days 0))))) (format-time-string "%Y-%m-%d" time))) +(defun rgr-pump--draw-histogram (hist) + ;; hist is an alist of (days . count) sorted in descending order of count. We + ;; rely on the fact that days are all divisible by 7, the days are mostly on + ;; the order of 3-16 weeks, and we're interested in probabilities rather than + ;; raw counts so we can hardwire the geometry. Note that we skip (0,0). + (let ((total 0) + (max-count 0) (max-days 0) + (chars-per-count 0) + (histogram nil)) + ;; Find total, max-count, and max-days. + (dolist (pair hist) + (let ((days (car pair)) (count (cdr pair))) + (cl-incf total count) + (when (< max-count count) + (setq max-count count)) + (when (< max-days days) + (setq max-days days)))) + ;; Make the histogram ten characters high. + (setq chars-per-count (/ 10.0 max-count)) + ;; Build a histogram of weeks as a vector. + (unless (zerop (mod max-days 7)) + (error "the fundamental assumption of weeks is broken")) + (setq histogram (make-vector (1+ (floor max-days 7)) 0)) + (dolist (pair hist) + (let ((days (car pair)) (count (cdr pair))) + (setf (aref histogram (floor days 7)) count))) + ;; Allocate three characters to each week. + (cl-do ((height 9 (1- height)) + (str (make-string (* (length histogram) 3) ?\ ) + (make-string (* (length histogram) 3) ?\ ))) + ((<= height 0)) + (dotimes (idx (length histogram)) + (when (and (> idx 0) + (>= (* (aref histogram idx) chars-per-count) height)) + (setf (aref str (+ 2 (* idx 3))) ?\*))) + (insert (replace-regexp-in-string " +\$" "" str) "\n")) + (insert " ") ;; the missing zero. + (dotimes (idx (length histogram)) + (when (> idx 0) + (insert (format "%3d" idx)))) + (insert " weeks\n"))) + +(defun rgr-pump--make-prediction (last-day n hist) + ;; last-day is the rgr-date-to-day of the most recent pumpernickel week for + ;; basing predictions, hist is an alist of (days . count) sorted in descending + ;; order of count, and n is the total count. Show all predicted dates with + ;; more than 20% of the total probability. + (insert "\nNext week is estimated to start ") + (let ((need-comma nil)) + (dolist (pair hist) + (let ((prob (/ (* (cdr pair) 100.0) n))) + (when (>= prob 20) + (insert (if need-comma ", or " "") + (format "%s (%d%%)" + (rgr-format-days (+ last-day (car pair))) + prob)) + (setq need-comma t))))) + (insert ".\n") + (fill-paragraph)) + ;;;###autoload (defun rgr-show-pumpernickel-intervals () "Print a table of intervals between known pumpernickel weeks. @@ -66,15 +126,10 @@ The dominant intervals correspond (so far) to 6 or 5 weeks." (cl-incf n count) (push (cons i count) hist)))) (setq hist (sort hist #'(lambda (a b) (> (cdr a) (cdr b))))) - (insert - (apply #'format - "\nNext week is estimated to start %s or %s.\n" - (mapcar #'(lambda (pair) - (when pair - (format "%s (%d%%)" - (rgr-format-days (+ last-day (car pair))) - (/ (* (cdr pair) 100.0) n)))) - (list (car hist) (car (cdr hist)))))))))) + ;; (insert (prin1-to-string hist)) + (insert "\n") + (rgr-pump--draw-histogram hist) + (rgr-pump--make-prediction last-day n hist))))) ;; (/ (rgr-days-between "2023 Dec 13" "2023 Oct 18") 7) 8 -- 2.43.4