~rgrjr/rgr-hacks

6082cd0f941819236d28c44c4cea37ecfa422f8d — Bob Rogers a month ago 68d95fa
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.
1 files changed, 64 insertions(+), 9 deletions(-)

M rgr-pumpernickel.el
M rgr-pumpernickel.el => rgr-pumpernickel.el +64 -9
@@ 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