Sparkly Stats — Stats and sparks from daily data (Emacs package)

(use-package sparkly-stats :demand t)

(require 'sparkly-stats)

;;; sparkly-stats.el --- Stats and sparks from daily data -*- lexical-binding: t -*-
;;; Commentary:
;;;; For all the details, please do see the README
;;; Code:
;;;; Libraries
;;;; Package metadata
;;;; Customizable variables
;;;; Functions
;;;;; Report
;;;;; Support
;;;;;; Parse input
;;;;;; Make parts of output
;;;;;; Statistics
;;;;;; Date operations
;;;;; See README
;;;; Wrapping up
;;; sparkly-stats.el ends here

;;; sparkly-stats.el --- Stats and sparks from daily data -*- lexical-binding: t -*-

;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:   flandrew
;; Created:  2023-11-12
;; Updated:  2025-01-10
;; Keywords: extensions
;; Homepage: <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  0.1.0
;; Package-Requires: ((emacs "25.1")(sparkly "0.2")(xht "1.0.6")(dash "2.18"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; With Sparkly Stats you can create statistics and sparks from daily data.
;;
;;;; For all the details, please do see the README
;;
;; Open it easily with:
;;   (find-file-read-only "README.org")   <--- C-x C-e here¹
;;
;; or from any buffer:
;;   M-x sparkly-stats-see-readme
;;
;; or read it online:
;;   <https://flandrew.srht.site/listful/sw-emacs-sparkly-stats.html>
;;
;; ¹ or the key that ‘eval-last-sexp’ is bound to, if not C-x C-e.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;; Code:
;;;; Libraries

(require 'sparkly)
(require 'time-date)
(require 'lisp-mnt)  ; ‘lm-summary’, ‘lm-homepage’, ‘lm-version’, ‘lm-header’


;;;; Package metadata

(defvar sparkly-stats--name "Sparkly Stats")

(defvar sparkly-stats--dot-el
  (format "%s.el" (file-name-sans-extension (eval-and-compile
                                              (or load-file-name
                                                  buffer-file-name)))))
(defvar sparkly-stats--readme-org
  (expand-file-name "README.org" (file-name-directory sparkly-stats--dot-el)))

(defvar sparkly-stats--summary  (lm-summary   sparkly-stats--dot-el))
(defvar sparkly-stats--homepage (lm-homepage  sparkly-stats--dot-el))
(defvar sparkly-stats--version  (lm-with-file sparkly-stats--dot-el
                                  (or (lm-header "package-version")
                                      (lm-version))))


;;;; Customizable variables

(defgroup sparkly-stats nil
  (format "%s." sparkly-stats--summary)
  :group 'extensions
  :link  '(emacs-library-link :tag "Lisp file" "sparkly-stats.el")
  :link  `(file-link :tag "README.org" ,sparkly-stats--readme-org)
  :link  `(url-link  :tag "Homepage"   ,sparkly-stats--homepage))


;;;; Functions
;;;;; Report

;;;###autoload
(defun sparkly-stats-report (&rest args)
  "Given an org table, return stats and sparks.

The following optional KEYS are available:
- `:tbl'
- `:end'
- `:num'
- `:frq-args'
- `:rng-args'

If the value of `:tbl' is nil, look for an org table at point and
insert the output after it (useful mostly for interactive use).
Otherwise, the value should refer to an org table string, and the
function returns the output as a string.

You can also refer to a named table by passing an `org-sbe' sexp:

#+name: my-flanges
| Date             | Flanges |
|------------------+---------|
| [2042-04-18 Fri] |       5 |
| [2042-04-19 Sat] |       5 |
| [2042-04-21 Mon] |      13 |
| [2042-04-22 Tue] |       2 |

#+begin_src emacs-lisp
\(sparkly-stats-report :tbl (org-sbe my-flanges))
#+end_src

: [2042-04-18 Fri]--[2042-04-22 Tue] (5 days)
: mode     median   average    sum
: 5        5        5.0        25
:    ▅
: ▅▅_█▂
: b   e
: ▁_▁__▂_______▁
: 0            13

If the value of `:end' is \\='today, make today the end of the date
range. Otherwise use the last date given.

The KEY `:num' passes the report number. If nil, it defaults to 1:
the current version only has one kind of report.

Both `:rng-args' and `:frq-args' consist of `sparkly-vs' arguments,
each of which as a list, which could be passed to each of the spark
blocks of the output — the date range sparks and the frequency
sparks, respectively — to control their vertical size.

\(fn &optional KEY-1 VALUE-1 KEY-2 VALUE-2 ...)"
  (interactive)
  (-let* (((&plist :tbl :num :rng-args :frq-args) args)
          ((&plist :beg :end :htbl) (apply #'sparkly-stats--parse-input args))
          (values (sparkly-stats--make-values beg end htbl))
          (output (--> (sparkly-stats--make-output beg end values num
                                                   :rng-args rng-args
                                                   :frq-args frq-args)
                       ;; If no ORGTBL, we're at point.
                       ;; So we add leading colons "by hand".
                       (if tbl it (s-replace "\n" "\n: " (format "\n%s" it)))
                       (format "%s\n" it))))
    (if tbl output (save-excursion
                     (-let [(_b . e) (sparkly-stats--orgtbl-get-boundaries)]
                       (goto-char e)
                       (sparkly--smart-insert output))))))


;;;;; Support
;;;;;; Parse input

(defun sparkly-stats--parse-input (&rest args)
  "Try to parse input. Return (BEG END HTBL)."
  (-let [(&plist :tbl :end) args]
    (let* ((htbl  (sparkly-stats--orgtbl-try-read-make-1d tbl))
           (dates (->> htbl  h-keys  (-sort #'string<)))
           (beg   (-> dates  car  sparkly-stats--date-org-to-iso))
           (end   (pcase end
                    ('today (format-time-string "%F"))
                    ('nil   (-> dates  last  car
                                sparkly-stats--date-org-to-iso)))))
      (list :beg beg :end end :htbl htbl))))

(defun sparkly-stats--orgtbl-try-read-make-1d (&optional orgtbl)
  "Try to read orgtbl-like object ORGTBL, make it 1D.

The input may originally be:
1) An orgtbl with 2 cols, header, therefore 2d: convert, make 1d.
2) An orgtbl with 2 cols, no header, therefore 1d: just convert.
3) A list-of-lists with no header: add header, convert, make 1d.

This last case will happen if you use `org-sbe' to refer to a named
table in the org file, as `org-sbe' converts the table to a
list-of-lists and strips any headers."
  (let ((otbl (or orgtbl (sparkly-stats--orgtbl-get-string))))
    (pcase (h-type otbl)
      ;; Will happen when using orgtbl string, or at point.
      (:orgtbl (--> otbl  h<-orgtbl
                    (pcase (h-dim it)
                      (1 it)
                      (2 (h-2d->1d it))
                      (_ (error "Wrong orgtbl dimension")))))
      ;; Will happen when using org-sbe.
      (:lines  (let ((rotbl (cons '(k v) (h-read-list otbl))))
                 (if (eq (h-type rotbl) :lol)
                     (->> rotbl  h<-lol  h-2d->1d
                          (h--hmap key (number-to-string value)))
                   (error "Can't read it as list of lists"))))
      (_ (error "Neither orgtbl nor list of lists")))))

(defun sparkly-stats--orgtbl-get-boundaries ()
  "Cons cell with boundaries of org table at point."
  (autoload #'org-at-table-p  "org")
  (autoload #'org-table-begin "org-table")
  (autoload #'org-table-end   "org-table")
  (unless (org-at-table-p)
    (error "No org table at point"))
  (cons (org-table-begin) (org-table-end)))

(defun sparkly-stats--orgtbl-get-string ()
  "String of org table at point."
  (autoload #'org-table-begin "org-table")
  (autoload #'org-table-end   "org-table")
  (buffer-substring-no-properties (org-table-begin) (org-table-end)))


;;;;;; Make parts of output

(defun sparkly-stats--make-output (beg end values &optional num &rest args)
  "Make output from BEG, END, LEN and NUM."
  (unless num (setq num 1))
  (pcase num
    (1 (apply #'sparkly-stats--make-output-1 beg end values args))
    (_ (error "%s is not a valid report number" num))))

(defun sparkly-stats--make-output-1 (beg end values &rest args)
  "Make output from BEG, END, and LEN.
KEYS `:rng-args' and `:frq-args' are `sparkly-vs' params, each of
which as a list, that can be passed to each of the two spark blocks
of the output to control their stretch."
  (-let* ((lbl "mode    median    average    sum")
          (beg (sparkly-stats--date-iso-to-org beg))
          (end (sparkly-stats--date-iso-to-org end))
          (len (sparkly-stats--date-range-length beg end))
          (hdr (sparkly-stats--make-header beg end len))
          ((&plist :mod :med :avg :sum) (sparkly-stats--make-stats values))
          ((&plist :rng-args :frq-args) args)
          (rng (sparkly-stats--make-sparks-of-date-range  values rng-args))
          (frq (sparkly-stats--make-sparks-of-frequencies values frq-args)))
    (format "%s\n %s\n %-8s%-10s%-11s%s\n%s\n%s"
            hdr   lbl  mod med avg sum  rng frq)))

(defun sparkly-stats--make-values (beg end htbl)
  "Return list of VALUES given BEG, END, and HTBL."
  (let* ((len (sparkly-stats--date-range-length beg end))
         (full-ht (h-new len))
         date vals)
    (--each (-iota len)
      (setq date (sparkly-stats--date-add-days beg it)
            vals (string-to-number
                  (h-get htbl (sparkly-stats--date-iso-to-org date) "0")))
      (h-put! full-ht date vals))
    (h-values full-ht)))

(defun sparkly-stats--make-header (beg end len)
  "Make header from BEG, END, and LEN."
  (format "%s--%s (%s days)" beg end len))

(defun sparkly-stats--make-stats (values)
  "Return plist of stats given list of VALUES."
  (list :sum (-sum values)
        :min (-min values)
        :max (-max values)
        :mod (sparkly-stats--mode    values)
        :med (sparkly-stats--median  values)
        :avg (sparkly-stats--average values)))

(defun sparkly-stats--make-sparks-of-date-range (values &optional rng-args)
  "Return sparks of date range given list of VALUES.
Optional RNG-ARGS is a list of `sparks-vs' arguments."
  (let* ((len    (length values))
         (rngspk (apply #'sparkly-vs values rng-args))
         (rnglbl (if (= len 1)
                     "beg"
                   (let* ((repeat (- len (if (<= len 7) 2 6)))
                          (spaces (s-repeat repeat " "))
                          (labels (if (<= len 7) "b e" "beg end")))
                     (s-replace " " spaces labels)))))
    (format "%s\n%s" rngspk rnglbl)))

(defun sparkly-stats--make-sparks-of-frequencies (values &optional frq-args)
  "Return sparks of frequencies given list of VALUES."
  (-let* (((&plist :min :max) (sparkly-stats--make-stats values))
          (cnt-ht (h-count<-list values))
          (counts (number-sequence min max))
          (frqnce (--map (h-get cnt-ht it 0) counts))
          (frqspk (apply #'sparkly-vs frqnce frq-args))
          (frqlbl (if (= min max)
                      (format "%s" min)
                    (let* ((digmin (sparkly-stats--num-digits min))
                           (digmax (sparkly-stats--num-digits max))
                           (repeat (- max min -1 digmin digmax))
                           (spaces (s-repeat repeat " ")))
                      (format "%s%s%s" min spaces max)))))
    (format "%s\n%s" frqspk frqlbl)))


;;;;;; Statistics

(defun sparkly-stats--average (list &optional precision)
  "Return the average of LIST of numbers.
PRECISION is an integer representing the number of decimal digits
to round to. When nil, default to no more than 2."
  (sparkly-stats--roundf (/ (apply #'+ list) (length list) 1.0)
                         (or precision 2)))

(defun sparkly-stats--median (list)
  "Return the median of LIST of numbers."
  (let ((len (length list))
        (lis (-sort #'< list)))
    (if (= 0 (% len 2))
        (let* ((1st (elt lis     (/ len 2)))
               (2nd (elt lis (1- (/ len 2))))
               (sum (+ 1st 2nd))
               (avg (/ sum 2.0)))
          (if (and (integerp 1st)
                   (integerp 2nd)
                   (= 0 (% sum 2)))
              (round avg)
            (sparkly-stats--roundf avg 2)))
      (elt lis (/ (1- len) 2)))))

(defun sparkly-stats--mode (list)
  "Return the mode(s) of LIST.
If multimodal, return a list of modes. Otherwise, the mode."
  (let* ((hcount (h-count<-list list))
         (maxval (->> hcount  h-values  -max))
         (modes  (->> hcount  (h--sel (= value maxval))  h-keys)))
    (if (cdr modes) (-sort #'< modes) (car modes))))

(defun sparkly-stats--roundf (number precision)
  "Round a NUMBER to a maximum PRECISION of decimal digits.
If NUMBER is an integer, return it as float with one decimal digit.
If a float, round it to no more decimal digits than PRECISION."
  (let ((pow10 (expt 10 precision)))
    (-> number  (* pow10)  fround  (/ pow10))))

(defun sparkly-stats--num-digits (int)
  "Return the number of digits of integer INT."
  (if (= 0 int) 1 (-> int  abs  (log 10)  floor  1+)))


;;;;;; Date operations

(defun sparkly-stats--date-range-length (beg end)
  "How many days are there from date BEG to END?
Notice that it's 1+ the difference: the number of elements in the
sequence going from BEG to END."
  (--> (list beg end)
       (-map  #'date-to-time  it)
       (apply #'time-subtract it)
       (/ (abs it) 86400)
       1+))

(defun sparkly-stats--date-add-days (beg days)
  "Add DAYS to date BEG."
  (->> beg  date-to-time
       (time-add (* 86400 days))
       (format-time-string "%F")))

(defun sparkly-stats--date-org-to-iso (date)
  "Convert org timestamp DATE to ISO 8601."
  (substring date 1 11))

(defun sparkly-stats--date-iso-to-org (date)
  "Convert ISO 8601 DATE to org timestamp format."
  (format "[%s %s]" date (sparkly-stats--date-iso-to-dow date)))

(defun sparkly-stats--date-iso-to-dow (date)
  "Convert ISO 8601 DATE to weekday."
  (format-time-string "%a" (date-to-time date)))


;;;;; See README

;;;###autoload
(defun sparkly-stats-see-readme (&optional heading narrow)
  "Open sparkly-stats's README.org file.
Search for the file in sparkly-stats.el's directory.

If found, open it read-only.

If optional argument HEADING is passed, try to navigate to the
heading after opening it. HEADING should be a string.

If optional argument NARROW is non-nil, narrow to that heading.
This argument has no effect if HEADING is nil or not found."
  (interactive)
  (let ((readme sparkly-stats--readme-org))
    (if (file-exists-p readme)
      (let ((pr (make-progress-reporter
                   (format "Opening %s ... "
                           (abbreviate-file-name readme)))))
          (find-file-read-only readme)
          (when heading
            (sparkly-stats--goto-org-heading heading narrow))
          (progress-reporter-done pr))
      (message "Couldn't find %s's README.org" sparkly-stats--name))))

;;;###autoload
(defun sparkly-stats-see-news ()
  "See the News in sparkly-stats's README.org file."
  (interactive)
  (sparkly-stats-see-readme "News" 'narrow)
  (sparkly-stats--display-org-subtree))

(defun sparkly-stats--display-org-subtree ()
  "Selectively display org subtree."
  (let ((cmds '(outline-hide-subtree
                outline-show-children
                outline-next-heading
                outline-show-branches)))
    (and (fboundp (nth 0 cmds))
         (fboundp (nth 1 cmds))
         (fboundp (nth 2 cmds))
         (fboundp (nth 3 cmds))
         (mapc #'funcall cmds))))

(defun sparkly-stats--goto-org-heading (heading &optional narrow)
  "Navigate to org HEADING and optionally NARROW to it."
  (let* ((hrx (format "^[*]+ %s" heading))
         (pos (save-match-data
                (save-excursion
                  (save-restriction
                    (widen)
                    (goto-char (point-max))
                    (re-search-backward hrx nil t 1))))))
    (when pos
      (widen)
      (goto-char pos)
      (if (and narrow (fboundp 'org-narrow-to-subtree))
          (org-narrow-to-subtree)
        (recenter-top-bottom 1))
      (when (fboundp 'outline-show-subtree)
        (outline-show-subtree))
      (when (fboundp 'org-flag-drawer)
        (save-excursion
          (forward-line 1)
          (org-flag-drawer t))))))


;;;; Wrapping up

(provide 'sparkly-stats)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; sparkly-stats.el ends here