From 36eaa8ce8c1452db61bf239af99516ae499446df Mon Sep 17 00:00:00 2001 From: David O'Toole Date: Wed, 26 Oct 2022 10:40:15 -0400 Subject: [PATCH] check in health template --- health-template.el | 211 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 211 insertions(+) create mode 100644 health-template.el diff --git a/health-template.el b/health-template.el new file mode 100644 index 0000000..9a45ac0 --- /dev/null +++ b/health-template.el @@ -0,0 +1,211 @@ +;;; health-template.el --- generating org-gnuplot templates for health data -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 by David O'Toole + +;; Author: David O'Toole + +;;; 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