212 lines
8.1 KiB
EmacsLisp
212 lines
8.1 KiB
EmacsLisp
|
;;; 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 "ADL" :goal 4 :unit :points :color "royalblue" :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)
|
||
|
(:name "meditation" :unit :minutes :color "light-magenta" :thickness 2 :plot-type :points :point-type 22)
|
||
|
(:name "trouble" :unit :points :color "gray" :thickness 2 :plot-type :lines :dash-type ".."
|
||
|
:formula "( (abs($3 - 8) * 3) + $6 + $8 + ($7 * 3) + ($4 < 3 ? 3 : 0) + (($5 - 5) * 2) - ($2 * 0.15) )"))))
|
||
|
|
||
|
;; (health-generate-org-template)
|
||
|
|
||
|
(provide 'health-template)
|
||
|
;;; health-template.el ends here
|