## ~rgrjr/rgr-hacks

c407f7b804093bb100955356b997ad4d59908a83 — Bob Rogers 2 months ago
```Also predict the pumpernickel week after next

* rgr-pumpernickel.el:
+ (rgr-pump--make-prediction):  Pass in a title, do our own
probability normalization. and fix the fill-paragraph so it works.
+ (rgr-alist-convolution):  Quick and dirty.
+ (rgr-show-pumpernickel-intervals):  Predict the next pumpernickel
week, and the one after.
```
```1 files changed, 35 insertions(+), 10 deletions(-)

M rgr-pumpernickel.el
```
`M rgr-pumpernickel.el => rgr-pumpernickel.el +35 -10`
```@@ 53,7 53,8 @@
(dolist (pair hist)
(let ((days (car pair)) (count (cdr pair)))
(setf (aref histogram (floor days 7)) count)))
-    ;; Allocate three characters to each week.
+    ;; Make the drawing, allocating three characters to each week.
+    (insert "\n")
(cl-do ((height 9 (1- height))
(str (make-string (* (length histogram) 3) ?\ )
(make-string (* (length histogram) 3) ?\ )))

@@ 69,13 70,17 @@
(insert (format "%3d" idx))))
(insert "  weeks\n")))

-(defun rgr-pump--make-prediction (last-day n hist)
+(defun rgr-pump--make-prediction (prediction-title last-day 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))
+  ;; order of count.  Show all predicted dates with more than 20% of the total
+  ;; probability.
+  (insert "\n" prediction-title " is estimated to start ")
+  (let ((need-comma nil)
+	(n 0))
+    (dolist (pair hist)
+      (let ((count (cdr pair)))
+	(cl-incf n count)))
(dolist (pair hist)
(let ((prob (/ (* (cdr pair) 100.0) n)))
(when (>= prob 20)

@@ 85,7 90,23 @@
prob))
(setq need-comma t)))))
(insert ".\n")
-  (fill-paragraph))
+  ;; Now pretty it up a bit.
+  (save-excursion
+    (forward-line -1)
+    (fill-paragraph)))
+
+(defun rgr-alist-convolution (alist)
+  ;; Given an alist of (key . count), produce its self-convolution.
+  (let ((result nil))
+    (dolist (pair1 alist)
+      (dolist (pair2 alist)
+	(let* ((key (+ (car pair1) (car pair2)))
+	       (count (* (cdr pair1) (cdr pair2)))
+	       (result-pair (assoc key result)))
+	  (if result-pair
+	      (cl-incf (cdr result-pair) count)
+	    (push (cons key count) result)))))
+    (sort result #'(lambda (a b) (> (cdr a) (cdr b))))))

(defun rgr-show-pumpernickel-intervals ()

@@ 126,10 147,14 @@ 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 (prin1-to-string hist))
-	(insert "\n")
(rgr-pump--draw-histogram hist)
-	(rgr-pump--make-prediction last-day n hist)))))
+	(rgr-pump--make-prediction "Next pumpernickel week" last-day hist)
+	;; Now do the two-interval prediction.
+	(let ((twice-hist (rgr-alist-convolution hist)))
+	  ;; (insert (prin1-to-string twice-hist))
+	  (rgr-pump--draw-histogram twice-hist)
+	  (rgr-pump--make-prediction "The following pumpernickel week"
+				     last-day twice-hist))))))

;; (/ (rgr-days-between "2023 Dec 13" "2023 Oct 18") 7) 8

```