;;; bench-org-columns-set-widths.el --- Compare org-columns--set-widths variants -*- lexical-binding: t -*-
;;
;; Usage:
;;     emacs -Q --batch -l bench-org-columns-set-widths.el
;;
;; Tunable parameters at the bottom (`bench/rows', `bench/cols-list',
;; `bench/repeats').
;;
;; The script benchmarks four implementations of `org-columns--set-widths'
;; on synthetic cache data and prints a table modeled on commit f06c61e41's
;; commit message.  The variants are:
;;
;;   Old O(n×m)    — original `assoc'-based version (pre-f06c61e41).
;;   cl-loop nth   — `cl-loop' with `(nth index widths)' (O(k) per access).
;;   cl-loop on    — `cl-loop' walking pointers via `for ... on ...'
;;                   and `setcar' (idiomatic AND O(1) per step).
;;   while         — hand-rolled `while' loop with manual `cdr' walking
;;                   (current implementation on `main' after f06c61e41).
;;
;; No org installation is required — the benchmark is self-contained.

(require 'cl-lib)
(require 'benchmark)

;; Dynamic variables that the original functions touch.  Declared here so
;; the benchmark stays independent of a loaded `org-colview' library.
(defvar org-columns-current-maxwidths nil)
(defvar org-columns-current-fmt-compiled nil)


;;; --- Variant 1: Old O(n×m) (pre-f06c61e41) ----------------------------------

(defun bench/old-assoc (cache)
  "Original `assoc'-based variant.  Iterates the cache once per column."
  (setq org-columns-current-maxwidths
        (apply #'vector
               (mapcar
                (lambda (spec)
                  (pcase spec
                    (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
                    (`(,_ ,title . ,_)
                     (let ((width (string-width title)))
                       (dolist (entry cache width)
                         (let ((value (nth 2 (assoc spec (cdr entry)))))
                           (setq width (max (string-width value) width))))))))
                org-columns-current-fmt-compiled))))


;;; --- Variant 2: cl-loop with `nth' ------------------------------------------

(defun bench/cl-loop-nth (cache)
  "`cl-loop' variant using `(nth index widths)' (O(k) per access)."
  (setq org-columns-current-maxwidths
        (let ((widths (mapcar (lambda (spec)
                                (pcase spec
                                  (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
                                  (`(,_ ,title . ,_) (string-width title))))
                              org-columns-current-fmt-compiled)))
          (dolist (entry cache)
            (cl-loop for index from 0
                     for triplet in (cdr entry)
                     for spec in org-columns-current-fmt-compiled
                     unless (wholenump (nth 2 spec))
                     do (setf (nth index widths)
                              (max (nth index widths)
                                   (string-width
                                    (nth 2 triplet))))))
          (apply #'vector widths))))


;;; --- Variant 3: cl-loop with `for ... on ...' (hybrid) ----------------------

(defun bench/cl-loop-on (cache)
  "`cl-loop' variant using `for ... on ...' for O(1) pointer walking."
  (setq org-columns-current-maxwidths
        (let ((widths (mapcar (lambda (spec)
                                (pcase spec
                                  (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
                                  (`(,_ ,title . ,_) (string-width title))))
                              org-columns-current-fmt-compiled)))
          (dolist (entry cache)
            (cl-loop for triplet in (cdr entry)
                     for spec-cons on org-columns-current-fmt-compiled
                     for width-cons on widths
                     unless (wholenump (nth 2 (car spec-cons)))
                     do (setcar width-cons
                                (max (car width-cons)
                                     (string-width
                                      (nth 2 triplet))))))
          (apply #'vector widths))))


;;; --- Variant 4: hand-rolled `while' (commit f06c61e41) ----------------------

(defun bench/while (cache)
  "Hand-rolled `while' loop with manual `cdr' walking."
  (setq org-columns-current-maxwidths
        (let ((widths (mapcar (lambda (spec)
                                (pcase spec
                                  (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
                                  (`(,_ ,title . ,_) (string-width title))))
                              org-columns-current-fmt-compiled)))
          (dolist (entry cache)
            (let ((triplets (cdr entry))
                  (specs org-columns-current-fmt-compiled)
                  (w widths))
              (while (and triplets specs w)
                (unless (wholenump (nth 2 (car specs)))
                  (setcar w (max (car w) (string-width (nth 2 (car triplets))))))
                (setq triplets (cdr triplets))
                (setq specs (cdr specs))
                (setq w (cdr w)))))
          (apply #'vector widths))))


;;; --- Test data generators ---------------------------------------------------

(defun bench/make-fmt (ncols)
  "Build a compiled-format list with NCOLS columns (no fixed widths)."
  (cl-loop for i from 0 below ncols
           collect (list (format "P%d" i) (format "Title%d" i)
                         nil nil nil nil)))

(defun bench/make-cache (nrows ncols fmt)
  "Build a synthetic cache with NROWS rows of NCOLS triplets each.
FMT is the compiled-format list — its specs are used as the first
element of each triplet so the `assoc'-based variant works."
  (cl-loop for r from 0 below nrows
           collect
           (cons r
                 (cl-loop for c from 0 below ncols
                          for spec in fmt
                          collect
                          (list spec
                                (format "v-%d-%d" r c)
                                (format "value-%d-col-%d-extra" r c))))))


;;; --- Benchmark runner -------------------------------------------------------

(defun bench/run (nrows ncols repeats)
  "Run each variant REPEATS times on a NROWS×NCOLS synthetic cache.
Returns the average per-call time for each variant."
  (let* ((org-columns-current-fmt-compiled (bench/make-fmt ncols))
         (cache  (bench/make-cache nrows ncols
                                   org-columns-current-fmt-compiled))
         (t-old   (car (benchmark-run repeats (bench/old-assoc    cache))))
         (t-nth   (car (benchmark-run repeats (bench/cl-loop-nth  cache))))
         (t-on    (car (benchmark-run repeats (bench/cl-loop-on   cache))))
         (t-while (car (benchmark-run repeats (bench/while        cache)))))
    ;; Sanity check: every variant must compute the same widths vector.
    (let ((w1 (progn (bench/old-assoc   cache) org-columns-current-maxwidths))
          (w2 (progn (bench/cl-loop-nth cache) org-columns-current-maxwidths))
          (w3 (progn (bench/cl-loop-on  cache) org-columns-current-maxwidths))
          (w4 (progn (bench/while       cache) org-columns-current-maxwidths)))
      (unless (and (equal w1 w2) (equal w1 w3) (equal w1 w4))
        (error "Variant outputs differ: old=%S nth=%S on=%S while=%S"
               w1 w2 w3 w4)))
    (list nrows ncols
          (/ t-old   repeats)
          (/ t-nth   repeats)
          (/ t-on    repeats)
          (/ t-while repeats))))

(defun bench/print-table (rows ncols repeats)
  (princ (format "   %-6s %-5s %-12s %-14s %-14s %-12s %-9s %-9s %-9s\n"
                 "Rows" "Cols" "Old O(n×m)"
                 "cl-loop nth" "cl-loop on" "while"
                 "Old/nth" "Old/on" "Old/while"))
  (princ "   ")
  (princ (make-string 100 ?─))
  (princ "\n")
  (dolist (nrows rows)
    (let* ((r    (bench/run nrows ncols repeats))
           (told (nth 2 r)) (tnth (nth 3 r))
           (ton  (nth 4 r)) (twh  (nth 5 r)))
      (princ (format "   %-6d %-5d %-12s %-14s %-14s %-12s %-9s %-9s %-9s\n"
                     (nth 0 r) (nth 1 r)
                     (format "%.5f s" told)
                     (format "%.5f s" tnth)
                     (format "%.5f s" ton)
                     (format "%.5f s" twh)
                     (format "%.1f×" (/ told (max tnth 1e-9)))
                     (format "%.1f×" (/ told (max ton  1e-9)))
                     (format "%.1f×" (/ told (max twh  1e-9))))))))


;;; --- Parameters & main ------------------------------------------------------

(defvar bench/rows      '(10 100 300 500 1000))
(defvar bench/cols-list '(10 20))
(defvar bench/repeats   50)

(defun bench/main ()
  (princ (format "Benchmark data (%d runs each, all widths auto-computed from cache):\n\n"
                 bench/repeats))
  (let ((first t))
    (dolist (ncols bench/cols-list)
      (unless first (princ "\n"))
      (setq first nil)
      (princ (format "%d columns:\n\n" ncols))
      (bench/print-table bench/rows ncols bench/repeats))))

(bench/main)

;;; bench-org-columns-set-widths.el ends here