health-template/health-template.el

;;; health-template.el --- generating org-gnuplot templates for health data  -*- lexical-binding: t; -*-

;; Copyright (C) 2022 by David O'Toole

;; Author: David O'Toole <deeteeoh1138@gmail.com>

;;; Commentary:

;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:

;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.

;;; Code:

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

(defvar health-y-max 40)

(defvar health-number-of-days 7)

(defclass health-factor ()
  ((name :initform nil :accessor health-name :initarg :name) 
   (goal :initform nil :accessor health-goal :initarg :goal)
   (unit :initform nil :accessor health-unit :initarg :unit)
   (color :initform "gray50" :accessor health-color :initarg :color)
   (thickness :initform 2 :accessor health-thickness :initarg :thickness)
   (plot-type :initform :lines :accessor health-plot-type :initarg :plot-type)
   (point-type :initform nil :accessor health-point-type :initarg :point-type)
   (dash-type :initform nil :accessor health-dash-type :initarg :dash-type)
   (formula :initform nil :accessor health-formula :initarg :formula)))

(defvar health-factors ())

(defvar health-plot-types '(:lines :points :linespoints))
(defvar health-unit-types '(:score :hours :minutes :milligrams :doses :points))

(defvar health-xtics-format "%a %m/%d")

(defun health-gnuplot-preamble ()
  (concat "
#+begin_src gnuplot :var data=mydata
# clear graphics from any previous run
reset

# define output parameters
set terminal svg font \"Arial\" size 900,900
set output './test.svg'

# use org-mode format for input
set datafile separator \"\\t\"
set timefmt \"%Y-%m-%d\"

# set up for time series data
set xdata time
set x2tics 1 format '' scale 0

# one X tick per day
set xtics 24*60*60

# vertical line on each day
set grid xtics

# one Y tick every five points
set ytics 5

# rotate labels to fit better
set xtics rotate by 60 right

set key box lc 'gray60'
"
          (format "set xtics format \"%s\"\n" health-xtics-format)
          (format "set yrange [0:%d]\n" health-y-max)
          ))

(defun health-factors-from-list (specs)
  (mapcar (lambda (spec)
            (apply #'make-instance 'health-factor spec))
          specs))

(cl-defmethod health-factor-gnuplot-linetype ((h health-factor) n)
  (with-slots (name goal unit color thickness plot-type point-type dash-type) h
    (format "set linetype %d lw %d lc rgb '%s' ps 1 pt %d %s\n"
            n thickness color (or point-type 1)
            (if dash-type
                (format "dt \"%s\"" dash-type)
              ""))))

(cl-defmethod health-factor-gnuplot-goal-line ((h health-factor) n)
  (with-slots (name goal unit color thickness plot-type point-type) h
    (format "set linetype %d lw 1 lc rgb '%s'
set arrow %d from graph 0, first %d to graph 1, first %d lt %d dt '..'
set label \"%d\" at graph 0.52, first %d font 'Arial,16' tc rgb '%s'\n"
            n color n goal goal n goal goal color)))

(cl-defmethod health-factor-gnuplot-plot-line ((h health-factor) n)
  (with-slots (name goal unit color thickness plot-type point-type formula) h
    (format "data using 1:%s with %s title '%s' lt %d"
            (if formula
                formula
              (if (eq plot-type :points)
                  (format "($%d == 0 ? NaN : $%d)" (1+ n) (1+ n))
                (format "%d" (1+ n))))
            (substring (symbol-name plot-type) 1)
            (format "%s (%s)" name (substring (symbol-name unit) 1))
            n)))

(defun health-generate-gnuplot-block (factors)                           
  (with-temp-buffer
    (insert (health-gnuplot-preamble))
    (let ((n 1)
          (num-factors (length factors)))
      (cl-dolist (f factors)
        (insert (health-factor-gnuplot-linetype f n))
        (cl-incf n))
      (cl-dolist (f factors)
        (when (health-goal f)
          (insert (health-factor-gnuplot-goal-line f n))
          (cl-incf n)))
      (insert "plot ")
      (setf n 1)
      (cl-dolist (f factors)
        (when (not (= n 1))
          (insert ", \\\n"))
        (insert (health-factor-gnuplot-plot-line f n))
        (cl-incf n)))
    (insert "\n#+end_src\n\n")
    (buffer-substring-no-properties (point-min) (point-max))))

(defun health-block (lang content)
  (format "\n#+begin_src %s\n%s\n#+end_src\n\n" lang content))

(defun health-update-all-block ()
  (health-block "elisp"
                "(save-excursion
  (let ((old-value org-confirm-babel-evaluate))
    (setq org-confirm-babel-evaluate nil)
    (org-update-all-dblocks)
    (org-show-all)
    (org-next-block 1)
    (org-babel-execute-src-block)
    (setq org-confirm-babel-evaluate old-value)))
"))

(defun health-generate-journal-heading (factors)
  (format "\n* Journal\n :PROPERTIES:\n :columns: %s\n:ID: myid\n:END:\n\n"
          (concat
           "%timestamp(Date) "
           (mapconcat (lambda (f)
                        (format "%%%s(%s %s)"
                                (health-name f)
                                (health-name f)
                                (substring (symbol-name (health-unit f)) 1)))
                      factors
                      " "))))

(defun health-generate-data-table-stub ()
  "\n#+BEGIN: columnview :hlines 1 :id myid\n#+tblname: mydata\n\n\n#+END:\n\n")

(defun health-generate-org-capture-template (factors)
  (health-block "elisp"
                (format "(setq org-capture-templates '((\"j\" \"Journal\" entry (file+headline \"~/tracking/tracking.org\" \"Journal\")\n\"* %%t\n:PROPERTIES:%s\n:END:\n\")))"
                        (mapconcat (lambda (f)
                                     (format "\n:%s:" (health-name f)))
                                   factors
                                   " "))))

(defun* health-generate-org-template (&optional (factors health-factors))
  (switch-to-buffer (get-buffer-create "*healthdata*"))
  (delete-region (point-min) (point-max))
  (insert (health-update-all-block))
  (insert (health-generate-org-capture-template factors))
  (insert (health-generate-gnuplot-block factors))
  (insert (health-generate-data-table-stub))
  (insert (health-generate-journal-heading factors)))

(setf health-factors
      (health-factors-from-list 
      '((:name "exercise" :goal 20 :unit :minutes :color "forest-green" :thickness 2 :plot-type :points :point-type 9) 
        (:name "sleep" :goal 8 :unit :hours :color "purple" :thickness 2 :plot-type :lines)
        (:name "nicotine" :goal 5 :unit :doses :color "dark-yellow" :thickness 2 :plot-type :lines)
        (:name "distress" :unit :scale :color "dark-pink" :thickness 2 :plot-type :lines)
        (:name "missed" :unit :doses :color "red" :thickness 2 :plot-type :points :point-type 11)
        (:name "pain" :unit :scale :color "orange" :thickness 2 :plot-type :lines))))

;; (health-generate-org-template)

(provide 'health-template)
;;; health-template.el ends here