Display a calendar heat map using Emacs Lisp

| elisp, emacs

I was curious about how to quickly visualize my date-related data in Emacs, such as when I sketched my thoughts or which days had journal entries or how often A- had tantrums. (It's hard to be 6 years old.) I wrote this code based on nrougier's code for colouring calendar days using advice around calendar-generate-entries: 

(defface calendar-scale-1  '((((background light)) :foreground "black" :background "#eceff1")
                             (((background dark))  :foreground "white" :background "#263238")) "")
(defface calendar-scale-2  '((((background light)) :foreground "black" :background "#cfd8dc")
                             (((background dark))  :foreground "white" :background "#37474f")) "")
(defface calendar-scale-3  '((((background light)) :foreground "black" :background "#b0bec5")
                             (((background dark))  :foreground "white" :background "#455a64")) "")
(defface calendar-scale-4  '((((background light)) :foreground "black" :background "#90a4ae")
                             (((background dark))  :foreground "white" :background "#546e7a")) "")
(defface calendar-scale-5  '((((background light)) :foreground "black" :background "#78909c")
                             (((background dark))  :foreground "white" :background "#607d8b")) "")
(defface calendar-scale-6  '((((background light)) :foreground "black" :background "#607d8b")
                             (((background dark))  :foreground "white" :background "#78909c")) "")
(defface calendar-scale-7  '((((background light)) :foreground "black" :background "#546e7a")
                             (((background dark))  :foreground "white" :background "#90a4ae")) "")
(defface calendar-scale-8  '((((background light)) :foreground "black" :background "#455a64")
                             (((background dark))  :foreground "white" :background "#b0bec5")) "")
(defface calendar-scale-9  '((((background light)) :foreground "black" :background "#37474f")
                             (((background dark))  :foreground "white" :background "#cfd8dc")) "")
(defface calendar-scale-10 '((((background light)) :foreground "black" :background "#263238")
                             (((background dark))  :foreground "white" :background "#eceff1")) "")

(defun my-count-calendar-entries (grouped-entries)
  (mapcar (lambda (entry) (cons (car entry) (length (cdr entry)))) grouped-entries))

(defun my-scale-calendar-entries (grouped-entries &optional scale-max)
  (let* ((count (my-count-calendar-entries grouped-entries))
         (count-max (apply #'max (mapcar (lambda (o) (if (car o) (cdr o) 0)) count))))
    (mapcar (lambda (entry)
              (cons (car entry)
                    (/ (* 1.0 (or scale-max 1.0) (cdr entry)) count-max)))
            count)))

(defun my-scale-calendar-entries-logarithmically (grouped-entries &optional scale-max)
  (let* ((count (my-count-calendar-entries grouped-entries))
         (count-max (apply #'max (mapcar (lambda (o) (if (car o) (cdr o) 0)) count))))
    (mapcar (lambda (entry)
              (cons (car entry)
                    (/ (* 1.0 (or scale-max 1.0) (log (cdr entry))) (log count-max))))
            count)))

(defvar my-calendar-count-scaled nil "Values to display.")

(defun my-calendar-heat-map (month year indent)
  (when my-calendar-count-scaled
    (dotimes (i 31)
      (let ((date (list month (1+ i) year))
            (count-scaled (assoc-default (format "%04d-%02d-%02d" year month (1+ i))
                                         my-calendar-count-scaled)))
        (when count-scaled
          (calendar-mark-visible-date
           date
           (intern (format "calendar-scale-%d" count-scaled))))))))

(advice-add #'calendar-generate-month :after #'my-calendar-heat-map)
;(advice-remove #'calendar-generate-month #'my-calendar-heat-map)

(defun my-calendar-visualize (values)
  (setq my-calendar-count-scaled values)
  (calendar))

Journal entries

So if I want to visualize the days with journal entries, I can use this code: 

(defun my-calendar-visualize-journal-entries ()
  (interactive)
  (my-calendar-visualize
   (mapcar
    (lambda (o)
      (cons
       (car o)
       (ceiling (+ 1 (* 7.0 (cdr o))))))
    (my-scale-calendar-entries
     (seq-group-by #'my-journal-date
                   (cdr (pcsv-parse-file "~/Downloads/entries.csv")))))))
2023-01-05_21-42-06.png
Figure 1: Journal entries

Sketches

(defun my-calendar-visualize-sketches ()
  (interactive)
  (let ((my-calendar-sketches
         (assoc-delete-all
          nil
          (seq-group-by
           (lambda (o)
             (when (string-match "^\\([0-9][0-9][0-9][0-9]\\)[-_]?\\([0-9][0-9]\\)[-_]?\\([0-9][0-9]\\)" o)
               (format "%s-%s-%s"
                       (match-string 1 o)
                       (match-string 2 o)
                       (match-string 3 o))))
           (append
            (directory-files "~/sync/sketches" nil "\\.\\(png\\|jpg\\)\\'")
            (directory-files "~/sync/private-sketches" nil "\\.\\(png\\|jpg\\)\\'"))))))
    (my-calendar-visualize
     (mapcar
      (lambda (o)
        (cons (car o)
              ;; many days have just 1 sketch, so I set the low end of the scale
              ;; to make them visible, and use a logarithmic scale for the rest
              (ceiling (+ 3 (* 7.0 (cdr o))))))
      (my-scale-calendar-entries-logarithmically my-calendar-sketches)))))
2023-01-05_21-37-03.png
Figure 2: Sketches

Big feelings

(defun my-calendar-visualize-tantrums ()
  (interactive)
  (my-calendar-visualize
   (mapcar
    (lambda (o)
      (cons
       (car o)
       (ceiling (* 10.0 (cdr o)))))
    (my-scale-calendar-entries
     (seq-group-by #'my-journal-date
                   (seq-filter (lambda (o) (string-match "tantrum\\|grump\\|angry\\|meltdown"
                                                           (my-journal-note o)))
                               (cdr (pcsv-parse-file "~/Downloads/entries.csv"))))))))
2023-01-05_21-46-22.png
Figure 3: Tantrums and meltdowns

(The start of the schoolyear was pretty rough.)

I'd like to figure out a yearly calendar view, and maybe use the calendar as a way to navigate my data too. calendar-mark-visible-date relies on the position and gets confused by the stuff I tried from these yearly calendar hacks, but maybe I can change calendar-date-echo-text to '(calendar-iso-date-string (list month day year)) and then extract the data from the help-echo property, since mysteriously, the date doesn't actually seem to be otherwise stored in the calendar. Anyway, I'll post that when I figure it out!

You can comment with Disqus or you can e-mail me at sacha@sachachua.com.