~rgrjr/rgr-hacks

2f5393aeaf85534cf017e4d7479ed415f4833174 — Bob Rogers 4 months ago 0dae5ea
Add the rgr-show-pumpernickel-intervals command

* rgr-pumpernickel.el (added):
   + (rgr-show-pumpernickel-intervals):  Use a bonehead-simple machine
     learning technique to predict the likely next week when my local
     bagel shop will have pumpernickel bagels as "bagel of the week."
* compile-rgr-hacks.el:
   + (rgr-hacks-source-files):  Compile rgr-pumpernickel.
2 files changed, 77 insertions(+), 0 deletions(-)

M compile-rgr-hacks.el
A rgr-pumpernickel.el
M compile-rgr-hacks.el => compile-rgr-hacks.el +1 -0
@@ 70,6 70,7 @@ rgr-hacks-compile-module (see below).")
	  ("rgr-mouse" use (tex-mode) require (ilisp-mouse browse-url))
	  "rgr-mouse-doc"
	  "rgr-perl-hacks"
	  "rgr-pumpernickel"
	  ("rgr-ruby-hacks" require (ruby-mode))
	  ("rgr-python-hacks" require (python))
	  "rgr-rect-hacks"

A rgr-pumpernickel.el => rgr-pumpernickel.el +76 -0
@@ 0,0 1,76 @@
;;;; Hacking pumpernickel timing
;;;
;;; [created.  -- rgr, 20-Aug-23.]
;;;

(require 'url-vars)
(require 'parse-date)

(eval-when-compile
  (require 'cl-lib))

(defun rgr-date-to-day (date)
  (time-to-days
    (encode-time (decoded-time-set-defaults (parse-date date 'us-date)))))

(defun rgr-days-between (date1 date2)
  (- (rgr-date-to-day date1) (rgr-date-to-day date2)))

(defun rgr-date-weekday (date)
  (mod (rgr-date-to-day date) 7))

(defun rgr-format-days (days)
  ;; Output helper.
  (let ((time
	  ;; [time-to-days and days-to-time are not inverses!  -- rgr,
	  ;; 4-Oct-23.]
	  (days-to-time (- days (time-to-days 0)))))
    (format-time-string "%Y-%m-%d" time)))

;;;###autoload
(defun rgr-show-pumpernickel-intervals ()
  "Print a table of intervals between known pumpernickel weeks.
The dominant intervals correspond (so far) to 6 or 5 weeks."
  (interactive)
  (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"
		   "2023 Feb 22" "2023 Mar 29" "2023 May 17" "2023 Jun 21"
		   "2023 Jul 26" "2023 Sep 06" "2023 Oct 18"))
	   (histogram-size 100)
	   (histogram (make-vector histogram-size 0))
	   (last nil))
      (while (cdr tail)
	(let* ((from (car tail))
	       (to (cadr tail))
	       (days (rgr-days-between to from))
	       (weekday (rgr-date-weekday from))
	       ;; [note that url-weekday-alist is unreferenced in current emacs
	       ;; code (apparently since 2014) and therefore may disappear
	       ;; 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))
	  (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)))
	(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)))))
	(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))))))))))