From 26cc4472dea261a1ad13fbee8fb6a91b019f77bb Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Sun, 31 May 2026 08:35:16 -0500 Subject: feat: add the org-drill statistics dashboard renderer Step 1 shipped the session-log data layer. This is the renderer on top of it. org-drill-statistics opens a read-only dashboard with five sections: an overview (card counts plus a last-session recap), trends (reviews-per-day and pass-rate-per-day quadrant-block sparklines over the trend window, plus a 12-week table), a quality histogram, a needs-attention view (leech candidates, long-overdue, and forgotten-new cards), and a 7-day forecast counted from SCHEDULED dates. A buffer-wide filter (scope, range, algorithm) sits in the header and cycles with s/r/a. The other keys are q to bury, g to refresh, e for the CSV-export hook that lands next, and RET to follow the card link at point. The aggregation math lives in pure helpers (day-bucketing, sparkline scaling, weekly aggregates, the histogram, the attention selectors, forecast bucketing). The render helpers are thin string formatters over them, so the logic is unit-tested independently of the UI. New defcustoms tune the views: org-drill-statistics-trend-days, -forecast-days, -attention-row-limit, and -leech-quality-threshold. I added require 'calendar for the Monday week-start arithmetic in the weekly aggregates. CSV export and the manual and README entries are the step-3 follow-on. --- org-drill.el | 1245 ++++++++++++++++++++ tests/test-org-drill-statistics-attention-data.el | 263 +++++ tests/test-org-drill-statistics-distribution.el | 84 ++ tests/test-org-drill-statistics-forecast.el | 136 +++ tests/test-org-drill-statistics-overview-counts.el | 181 +++ .../test-org-drill-statistics-pass-rate-by-day.el | 200 ++++ tests/test-org-drill-statistics-primitives.el | 139 +++ .../test-org-drill-statistics-quality-histogram.el | 100 ++ .../test-org-drill-statistics-render-attention.el | 141 +++ tests/test-org-drill-statistics-render-forecast.el | 131 ++ tests/test-org-drill-statistics-render-overview.el | 106 ++ tests/test-org-drill-statistics-render-trends.el | 129 ++ tests/test-org-drill-statistics-reviews-by-day.el | 111 ++ tests/test-org-drill-statistics-shell.el | 153 +++ tests/test-org-drill-statistics-sparkline.el | 84 ++ .../test-org-drill-statistics-weekly-aggregates.el | 184 +++ 16 files changed, 3387 insertions(+) create mode 100644 tests/test-org-drill-statistics-attention-data.el create mode 100644 tests/test-org-drill-statistics-distribution.el create mode 100644 tests/test-org-drill-statistics-forecast.el create mode 100644 tests/test-org-drill-statistics-overview-counts.el create mode 100644 tests/test-org-drill-statistics-pass-rate-by-day.el create mode 100644 tests/test-org-drill-statistics-primitives.el create mode 100644 tests/test-org-drill-statistics-quality-histogram.el create mode 100644 tests/test-org-drill-statistics-render-attention.el create mode 100644 tests/test-org-drill-statistics-render-forecast.el create mode 100644 tests/test-org-drill-statistics-render-overview.el create mode 100644 tests/test-org-drill-statistics-render-trends.el create mode 100644 tests/test-org-drill-statistics-reviews-by-day.el create mode 100644 tests/test-org-drill-statistics-shell.el create mode 100644 tests/test-org-drill-statistics-sparkline.el create mode 100644 tests/test-org-drill-statistics-weekly-aggregates.el diff --git a/org-drill.el b/org-drill.el index 1a03b1f..ac7e03b 100644 --- a/org-drill.el +++ b/org-drill.el @@ -51,6 +51,7 @@ ;;; Code: +(require 'calendar) (require 'cl-lib) (require 'eieio) (require 'org) @@ -4551,5 +4552,1249 @@ A diagnostic command for decks that mix the two systems." (+ (length org-drill-leitner-boxed-entries) (length org-drill-leitner-unboxed-entries)))))) +;;; Statistics dashboard: step-2 aggregation and rendering layer. +;; +;; Aggregators, section renderers, and the dashboard UI shell built on +;; the step-1 session-record/session-log data layer above. + +;;; Statistics dashboard: customization and shared primitives + +;; The `org-drill-statistics' defgroup already exists in org-drill.el +;; (around line 87) as a sibling of `org-drill-session'. These +;; defcustoms attach to it; do not redefine the group. + +(defcustom org-drill-statistics-trend-days 90 + "Number of days the statistics dashboard trend section spans. +Daily and weekly aggregates are computed over the most recent window +of this many days, ending today. Weekly aggregates additionally cap at +the last 12 weeks." + :type 'integer + :group 'org-drill-statistics) + +(defcustom org-drill-statistics-forecast-days 7 + "Number of days the statistics dashboard forecast section spans. +Cards are bucketed into this many upcoming days by their SCHEDULED +day, starting today." + :type 'integer + :group 'org-drill-statistics) + +(defcustom org-drill-statistics-attention-row-limit 10 + "Maximum rows shown per needs-attention table on the dashboard. +Tables that would exceed this length are truncated and gain a +\"+N more\" footer naming the number of hidden rows." + :type 'integer + :group 'org-drill-statistics) + +(defcustom org-drill-statistics-leech-quality-threshold 2.5 + "Average-quality ceiling below which a card counts as a leech candidate. +A card is flagged when its DRILL_FAILURE_COUNT is at least +`org-drill-leech-failure-threshold' and its DRILL_AVERAGE_QUALITY is +strictly less than this value." + :type 'number + :group 'org-drill-statistics) + +;;; Shared pure primitives for the aggregation helpers. +;; +;; These are small, side-effect-free building blocks reused by the +;; trend, forecast, distribution, and needs-attention aggregators. Day +;; numbers are absolute integer day counts (`time-to-days'), so they +;; can be compared and subtracted directly without timezone surprises. + +(defun org-drill-statistics--today-day () + "Return today's absolute day number as an integer. +This is `time-to-days' of the current time. It is factored out so +tests can redefine it to a fixed day without mocking the clock." + (time-to-days (current-time))) + +(defun org-drill-statistics--record-day (record) + "Return the integer day number of RECORD's start time. +RECORD is an `org-drill-session-record'; its start-time slot is a float +as produced by `float-time'. The result is an absolute day number, the +same scale as `org-drill-statistics--today-day'." + (time-to-days + (seconds-to-time (org-drill-session-record-start-time record)))) + +(defun org-drill-statistics--filter-log (log &optional algorithm) + "Return the records in LOG whose algorithm matches ALGORITHM. +LOG is a list of `org-drill-session-record'. When ALGORITHM is nil, +return LOG unchanged (all algorithms). Otherwise keep only records +whose algorithm slot is `eq' to ALGORITHM. The original list is not +modified." + (if (null algorithm) + log + (cl-remove-if-not + (lambda (record) + (eq (org-drill-session-record-algorithm record) algorithm)) + log))) + +(defun org-drill-statistics--log-since (log cutoff-float) + "Return the records in LOG started at or after CUTOFF-FLOAT. +LOG is a list of `org-drill-session-record'. CUTOFF-FLOAT is a float +in the same units as `float-time' (and the records' start-time slot). +A record is kept when its start-time is greater than or equal to +CUTOFF-FLOAT. The original list is not modified." + (cl-remove-if-not + (lambda (record) + (>= (org-drill-session-record-start-time record) cutoff-float)) + log)) + +(defcustom org-drill-statistics-distribution-bar-width 40 + "Maximum width, in block characters, of a distribution histogram bar. +The quality with the highest count fills this many blocks; every other +quality's bar is scaled proportionally against it. A larger value makes +the histogram wider on the dashboard." + :type 'integer + :group 'org-drill-statistics) + +(defun org-drill-statistics--render-distribution (histogram) + "Return the quality-distribution section as a string. +HISTOGRAM is a 6-element vector of integer counts for qualities 0..5, as +produced by `org-drill-statistics--quality-histogram': element I is the +number of times quality I was rated. + +The result begins with the section subheading \"** Quality +Distribution\" and contains one row per quality 0..5. Each row shows the +quality number, a horizontal bar of repeated block characters, the +absolute count, and that quality's percentage of the total ratings. The +longest bar is `org-drill-statistics-distribution-bar-width' blocks wide +and the others scale against the largest count, so the bars stay +proportional. A quality with a zero count renders an empty bar but is +still listed, so all six rows are always present. + +When the histogram is empty (every count zero, no ratings recorded), the +percentages are all 0 and a short note replaces the bars' meaning, but +the six rows are still emitted so the layout is stable. This function is +pure: it returns a string and performs no buffer or display side +effects." + (let* ((counts (append histogram nil)) + (total (apply #'+ counts)) + (max-count (apply #'max counts)) + (width (max 1 org-drill-statistics-distribution-bar-width)) + (block ?\x2588) + (lines nil)) + (dotimes (q 6) + (let* ((count (nth q counts)) + (percent (if (> total 0) + (round (* 100.0 (/ (float count) total))) + 0)) + (bar-len (if (> max-count 0) + (round (* (/ (float count) max-count) width)) + 0)) + (bar (make-string bar-len block)) + (padded (concat bar + (make-string (max 0 (- width (length bar))) + ?\s)))) + (push (format "%d %s %4d %3d%%" + q padded count percent) + lines))) + (concat "** Quality Distribution\n" + (if (> total 0) + (format "Total ratings: %d\n" total) + "No quality ratings recorded yet.\n") + (mapconcat #'identity (nreverse lines) "\n") + "\n"))) + +(defun org-drill-statistics--reviews-by-day (log &optional days) + "Return a vector of review COUNTS per day over the last DAYS. +LOG is a list of `org-drill-session-record'; order does not matter +here. DAYS defaults to `org-drill-statistics-trend-days'. A +non-positive DAYS is clamped to 1. + +The result has one slot per day, oldest to newest, covering the window +that ends today and spans DAYS days inclusive: slot 0 is the oldest day +in the window, the final slot is today. A day's count is the sum of +\(length qualities) across every record whose start day falls in the +window. Records that fall outside the window, in the past or the +future, are ignored. Empty days are zero-filled. A record with a nil +qualities slot contributes zero. + +Day numbers come from `org-drill-statistics--record-day' and +`org-drill-statistics--today-day', so the window aligns on absolute +calendar days and the helper stays testable by redefining those." + (let* ((days (max 1 (or days org-drill-statistics-trend-days))) + (today (org-drill-statistics--today-day)) + (start-day (- today (1- days))) + (counts (make-vector days 0))) + (dolist (record log counts) + (let* ((day (org-drill-statistics--record-day record)) + (idx (- day start-day))) + (when (and (>= idx 0) (< idx days)) + (let ((qualities (org-drill-session-record-qualities record))) + (aset counts idx + (+ (aref counts idx) + (if qualities (length qualities) 0))))))))) + +(defun org-drill-statistics--pass-rate-by-day (log &optional days) + "Return a vector of daily pass rates over the last DAYS, oldest first. +LOG is a list of `org-drill-session-record', newest first as stored in +`org-drill-session-log'. DAYS defaults to `org-drill-statistics-trend-days'. + +The result is a vector of length DAYS. Element 0 is the oldest day in +the window and the final element is today, so the vector reads left to +right in chronological order, matching sparkline rendering. + +Each element is an integer pass rate, 0 to 100, for that day, or nil +when no qualities were recorded that day. A day's pass rate is the +percentage of that day's qualities that are passes across every record +started that day. A quality is a pass when it is strictly greater than +`org-drill-failure-quality'. Records outside the window are ignored. + +The function is pure with respect to LOG: it reads only the record +slots and the failure-quality threshold. Today is taken from +`org-drill-statistics--today-day', which tests may redefine to a fixed +day." + (let* ((days (or days org-drill-statistics-trend-days)) + (days (max 1 days)) + (today (org-drill-statistics--today-day)) + (oldest (- today (1- days))) + (passes (make-vector days 0)) + (totals (make-vector days 0)) + (threshold org-drill-failure-quality)) + (dolist (record log) + (let* ((day (org-drill-statistics--record-day record)) + (idx (- day oldest))) + (when (and (>= idx 0) (< idx days)) + (let ((qualities (org-drill-session-record-qualities record))) + (when qualities + (dotimes (qi (length qualities)) + (let ((q (aref qualities qi))) + (aset totals idx (1+ (aref totals idx))) + (when (> q threshold) + (aset passes idx (1+ (aref passes idx))))))))))) + (let ((result (make-vector days nil))) + (dotimes (i days) + (let ((total (aref totals i))) + (when (> total 0) + (aset result i (round (* 100.0 (/ (float (aref passes i)) + total))))))) + result))) + +(defconst org-drill-statistics--sparkline-chars "▁▂▃▄▅▆▇█" + "Eight-level quadrant-block charset for sparklines, low to high. +Index 0 is the shortest block, index 7 the full block. Used by +`org-drill-statistics--sparkline' to map scaled values to glyphs.") + +(defun org-drill-statistics--sparkline (numbers &optional max) + "Render NUMBERS as a quadrant-block sparkline string. +NUMBERS is a sequence (list or vector) of non-negative numbers, with +nil permitted for a missing data point. Each non-nil value is scaled +against MAX and mapped to one of eight block glyphs in +`org-drill-statistics--sparkline-chars', low to high. Each nil value +renders as a single space, preserving column alignment. + +MAX is the value mapped to the tallest block. When MAX is nil it +defaults to the largest non-nil value in NUMBERS. A value at or above +MAX renders as the full block; intermediate values scale linearly. + +Edge cases handled without error: +- Empty NUMBERS returns the empty string. +- All-nil NUMBERS returns a string of spaces, one per entry. +- A MAX of zero (all values zero, or an explicit zero MAX) renders + every non-nil value as the lowest block, since no value exceeds the + ceiling and division by zero is avoided. + +Values are clamped to the inclusive 0..MAX range before scaling, so a +value above MAX still maps to the full block rather than overflowing +the charset." + (let* ((seq (append numbers nil)) + (effective-max + (or max + (let ((non-nil (delq nil (copy-sequence seq)))) + (if non-nil (apply #'max non-nil) 0)))) + (top (1- (length org-drill-statistics--sparkline-chars)))) + (mapconcat + (lambda (n) + (cond + ((null n) " ") + ((or (null effective-max) (<= effective-max 0)) + (substring org-drill-statistics--sparkline-chars 0 1)) + (t + (let* ((clamped (max 0 (min n effective-max))) + (index (round (* (/ (float clamped) effective-max) top)))) + (substring org-drill-statistics--sparkline-chars + index (1+ index)))))) + seq + ""))) + +;;; Weekly trend aggregation for the statistics dashboard. + +(defun org-drill-statistics--week-start-day (day) + "Return the absolute day number of the Monday starting DAY's week. +DAY is an absolute day number as produced by `time-to-days'. Weeks +start on Monday, matching ISO week conventions. The result is itself an +absolute day number and is `<=' DAY. Pure integer arithmetic, so it is +deterministic across timezones." + (- day (mod (- day 1) 7))) + +(defun org-drill-statistics--avg-duration-min (records) + "Return the mean session duration of RECORDS in minutes, as a float. +RECORDS is a list of `org-drill-session-record'. Each duration is +end-time minus start-time, divided by 60. Returns 0.0 when RECORDS is +empty." + (if (null records) + 0.0 + (/ (cl-reduce + (lambda (acc record) + (+ acc + (/ (- (org-drill-session-record-end-time record) + (org-drill-session-record-start-time record)) + 60.0))) + records + :initial-value 0.0) + (float (length records))))) + +(defun org-drill-statistics--weekly-aggregates (log &optional weeks) + "Return per-week aggregate statistics for the most recent WEEKS. +LOG is a list of `org-drill-session-record' in any order. WEEKS +defaults to 12 and bounds how many weeks the result spans, ending with +the week that contains today. WEEKS must be a positive integer. + +The result is a list of plists, oldest week first, one per week in the +window even when a week has no sessions. Each plist has these keys: + + :week-start absolute day number of that week's Monday + :reviews total quality ratings entered across the week + :pass-percent pooled pass percentage (0 when the week has none) + :avg-duration-min mean session duration in minutes, as a float + +Weeks start on Monday. REVIEWS counts every entry in each record's +qualities vector, so a week's reviews is the sum over its sessions. +PASS-PERCENT is recomputed from the week's pooled qualities via +`org-drill--compute-pass-percent', not averaged from the stored +per-session percentages, so multi-session weeks stay correctly weighted. +This function is pure: it reads no org entries and does not modify LOG." + (setq weeks (or weeks 12)) + (unless (and (integerp weeks) (>= weeks 1)) + (error "WEEKS must be a positive integer, got %s" weeks)) + (let* ((this-week (org-drill-statistics--week-start-day + (org-drill-statistics--today-day))) + (oldest (- this-week (* 7 (1- weeks)))) + (buckets (make-vector weeks nil))) + (dolist (record log) + (let* ((wk (org-drill-statistics--week-start-day + (org-drill-statistics--record-day record))) + (idx (/ (- wk oldest) 7))) + (when (and (>= idx 0) (< idx weeks) + (zerop (mod (- wk oldest) 7))) + (aset buckets idx (cons record (aref buckets idx)))))) + (let ((result nil)) + (dotimes (i weeks) + (let* ((idx (- weeks 1 i)) + (records (aref buckets idx)) + (week-start (+ oldest (* 7 idx))) + (qualities (apply #'vconcat + (mapcar #'org-drill-session-record-qualities + records)))) + (push (list :week-start week-start + :reviews (length qualities) + :pass-percent + (org-drill--compute-pass-percent qualities) + :avg-duration-min + (org-drill-statistics--avg-duration-min records)) + result))) + result))) + +(defun org-drill-statistics--quality-histogram (log) + "Return a 6-element vector of quality counts across every record in LOG. +LOG is a list of `org-drill-session-record'. Element I of the result is +the total number of times quality I was entered across all records' +qualities vectors, for I in 0..5. Qualities outside the 0..5 range are +ignored defensively so a malformed record cannot corrupt the histogram. +A record whose qualities slot is nil contributes nothing. The original +log and its records are not modified." + (let ((histogram (make-vector 6 0))) + (dolist (record log) + (let ((qualities (org-drill-session-record-qualities record))) + (when qualities + (mapc + (lambda (quality) + (when (and (integerp quality) (>= quality 0) (<= quality 5)) + (aset histogram quality (1+ (aref histogram quality))))) + (append qualities nil))))) + histogram)) + +;;; Statistics dashboard: card-population overview aggregator. + +(defun org-drill-statistics--overview-counts (&optional scope) + "Return a card-population overview plist for the drill entries in SCOPE. +SCOPE is a value understood by `org-drill-current-scope' (a symbol such +as `file', `directory', `agenda', or a list of files); nil means the +current value of `org-drill-scope'. The plist has four keys: + + :total every genuine drill card seen (any non-nil entry status). + :new cards never reviewed (status :new). + :mature cards with an established interval (status :young, :old, or + :overdue), counted together as the mature population. + :lapsed cards whose last review failed (status :failed). + +The mapping is driven by `org-drill-entry-status', which classifies the +entry at point into one of nil, :unscheduled, :future, :new, :failed, +:overdue, :young, or :old. Cards classified :unscheduled or :future are +real drill cards, so they count toward :total, but they are neither new, +mature, nor lapsed, so they are absent from those three buckets. Entries +whose status is nil (non-drill headings and skippable empty cards) are +ignored entirely and do not count toward :total. + +A fresh, non-cram `org-drill-session' is created for the classification +so the result reflects the cards' own scheduling state rather than any +in-progress drill session." + (let ((session (org-drill-session)) + (total 0) + (new 0) + (mature 0) + (lapsed 0)) + (org-drill-map-entries + (lambda () + (let ((status (car (org-drill-entry-status session)))) + (when status + (cl-incf total) + (cl-case status + (:new (cl-incf new)) + ((:young :old :overdue) (cl-incf mature)) + (:failed (cl-incf lapsed)))))) + scope) + (list :total total :new new :mature mature :lapsed lapsed))) + +;;; Statistics dashboard: needs-attention selectors (aggregation 7/8) +;; +;; These three selectors return lists of (HEADING . POS) cons cells for +;; the dashboard's needs-attention section: leech candidates, +;; long-overdue cards, and forgotten-new cards. POS is the integer +;; buffer position of the entry's heading (`point' at the heading), so +;; the renderer can build a follow link. +;; +;; The org traversal is isolated in a single collector, +;; `org-drill-statistics--collect-attention-data', which gathers one +;; plist per drill entry. Every predicate and sort then operates on +;; that plain data, so the classification and ordering logic is unit +;; testable with a `with-temp-buffer' fixture and without touching the +;; clock. Day-based fields are stored as integers relative to a +;; supplied "today" day number, again so tests stay deterministic. + +(cl-defstruct (org-drill-statistics--entry-attention-data + (:constructor org-drill-statistics--make-entry-attention-data) + (:copier nil)) + "Per-entry data used by the needs-attention selectors. +HEADING is the cleaned outline heading string. POS is the integer +buffer position of the heading. FAILURE-COUNT is DRILL_FAILURE_COUNT as +an integer (0 when absent). AVG-QUALITY is DRILL_AVERAGE_QUALITY as a +float, or nil when absent. DAYS-SINCE-REVIEW is the integer day count +since DRILL_LAST_REVIEWED, or nil when never reviewed. DAYS-SINCE-ADDED +is the integer day count since DATE_ADDED, or nil when absent. +TOTAL-REPEATS is DRILL_TOTAL_REPEATS as an integer (0 when absent)." + heading pos failure-count avg-quality + days-since-review days-since-added total-repeats) + +;; Short aliases for the long struct accessors, used by the sort +;; comparators below so the comparator lines stay readable. +(defalias 'org-drill-statistics--ad-avg + #'org-drill-statistics--entry-attention-data-avg-quality) +(defalias 'org-drill-statistics--ad-fails + #'org-drill-statistics--entry-attention-data-failure-count) +(defalias 'org-drill-statistics--ad-review + #'org-drill-statistics--entry-attention-data-days-since-review) +(defalias 'org-drill-statistics--ad-added + #'org-drill-statistics--entry-attention-data-days-since-added) + +(defun org-drill-statistics--collect-attention-data (&optional scope today-day) + "Collect `org-drill-statistics--entry-attention-data' for each drill entry. +SCOPE is passed through to `org-drill-map-entries' to bound the +traversal, defaulting to `org-drill-scope'. TODAY-DAY is the absolute +day number treated as today, defaulting to +`org-drill-statistics--today-day'; it is factored out so callers and +tests can pin the reference day. + +The point is on each drill entry's heading while its data is read, so +this must run inside an org buffer. Returns a list of structs, one per +drill entry, in document order." + (let ((today (or today-day (org-drill-statistics--today-day)))) + (org-drill-map-entries + (lambda () + (org-drill-statistics--entry-attention-data-at-point today)) + scope))) + +(defun org-drill-statistics--entry-attention-data-at-point (today-day) + "Read needs-attention data for the drill entry at point. +TODAY-DAY is the absolute day number treated as today. Returns an +`org-drill-statistics--entry-attention-data' struct. This reads the +DRILL_* and DATE_ADDED properties via `org-entry-get' and the heading +via `org-get-heading', so the point must be on a drill heading." + (let* ((pos (point)) + (heading (org-get-heading t t t t)) + (failure-raw (org-entry-get pos "DRILL_FAILURE_COUNT")) + (avg-raw (org-entry-get pos "DRILL_AVERAGE_QUALITY")) + (last-raw (org-entry-get pos "DRILL_LAST_REVIEWED")) + (added-raw (org-entry-get pos "DATE_ADDED")) + (repeats-raw (org-entry-get pos "DRILL_TOTAL_REPEATS"))) + (org-drill-statistics--make-entry-attention-data + :heading (or heading "") + :pos pos + :failure-count (if failure-raw (string-to-number failure-raw) 0) + :avg-quality (and avg-raw (string-to-number avg-raw)) + :days-since-review + (org-drill-statistics--days-since-org-timestamp last-raw today-day) + :days-since-added + (org-drill-statistics--days-since-org-timestamp added-raw today-day) + :total-repeats (if repeats-raw (string-to-number repeats-raw) 0)))) + +(defun org-drill-statistics--days-since-org-timestamp (timestamp today-day) + "Return integer days from org TIMESTAMP string to TODAY-DAY. +TIMESTAMP is an org timestamp string (active or inactive) or nil. +TODAY-DAY is an absolute day number as from `time-to-days'. Returns the +difference TODAY-DAY minus the timestamp's day, so a value reviewed +today yields 0 and an older review yields a positive count. Returns nil +when TIMESTAMP is nil or cannot be parsed." + (when (and timestamp (not (string-empty-p timestamp))) + (condition-case nil + (- today-day + (time-to-days + (apply #'encode-time (org-parse-time-string timestamp)))) + (error nil)))) + +;;; Pure predicates and the row cap. + +(defun org-drill-statistics--leech-candidate-p (data) + "Non-nil when DATA describes a leech candidate. +DATA is an `org-drill-statistics--entry-attention-data'. A card is a +leech candidate when its failure count is at least +`org-drill-leech-failure-threshold' and its average quality is +known and strictly below `org-drill-statistics-leech-quality-threshold'. +A card with no recorded average quality is not flagged, since the +quality criterion cannot be evaluated." + (let ((avg (org-drill-statistics--entry-attention-data-avg-quality data))) + (and (>= (org-drill-statistics--entry-attention-data-failure-count data) + org-drill-leech-failure-threshold) + avg + (< avg org-drill-statistics-leech-quality-threshold)))) + +(defun org-drill-statistics--long-overdue-p (data) + "Non-nil when DATA describes a long-overdue card. +DATA is an `org-drill-statistics--entry-attention-data'. A card is +long overdue when it has a recorded last-review date and that review is +more than `org-drill-lapse-threshold-days' days ago. A card that was +never reviewed has no overdue measure and is not flagged here." + (let ((days (org-drill-statistics--entry-attention-data-days-since-review + data))) + (and days (> days org-drill-lapse-threshold-days)))) + +(defun org-drill-statistics--forgotten-new-p (data) + "Non-nil when DATA describes a forgotten-new card. +DATA is an `org-drill-statistics--entry-attention-data'. A card is +forgotten-new when it was added at least 14 days ago and has never been +repeated, that is its total repeats are zero. A card with no recorded +add date is not flagged, since its age cannot be evaluated." + (let ((added (org-drill-statistics--entry-attention-data-days-since-added + data))) + (and added + (>= added 14) + (= (org-drill-statistics--entry-attention-data-total-repeats data) + 0)))) + +(defun org-drill-statistics--cap-rows (rows) + "Cap ROWS at `org-drill-statistics-attention-row-limit' entries. +ROWS is a list. When it is no longer than the limit, return it +unchanged. Otherwise return its first LIMIT elements; the renderer is +responsible for the trailing \"+N more\" footer using the original +length. ROWS is not modified." + (let ((limit org-drill-statistics-attention-row-limit)) + (if (<= (length rows) limit) + rows + (cl-subseq rows 0 limit)))) + +;;; The three public selectors. +;; +;; Each filters the collected per-entry data with its predicate, sorts +;; per the spec, maps to (HEADING . POS), and caps the row count. + +(defun org-drill-statistics--leech-candidates (&optional scope) + "Return capped leech candidates as a list of (HEADING . POS). +SCOPE bounds the traversal, defaulting to `org-drill-scope'. Candidates +satisfy `org-drill-statistics--leech-candidate-p' and are sorted worst +first by ascending average quality, breaking ties by descending failure +count. The list is capped at `org-drill-statistics-attention-row-limit' +rows; the full count is available to the caller via a fresh scan if a +\"+N more\" footer is needed." + (let* ((data (cl-remove-if-not + #'org-drill-statistics--leech-candidate-p + (org-drill-statistics--collect-attention-data scope))) + (sorted + (sort data + (lambda (a b) + (let ((qa (org-drill-statistics--ad-avg a)) + (qb (org-drill-statistics--ad-avg b))) + (if (= qa qb) + (> (org-drill-statistics--ad-fails a) + (org-drill-statistics--ad-fails b)) + (< qa qb))))))) + (org-drill-statistics--cap-rows + (mapcar (lambda (d) + (cons (org-drill-statistics--entry-attention-data-heading d) + (org-drill-statistics--entry-attention-data-pos d))) + sorted)))) + +(defun org-drill-statistics--long-overdue (&optional scope) + "Return capped long-overdue cards as a list of (HEADING . POS). +SCOPE bounds the traversal, defaulting to `org-drill-scope'. Cards +satisfy `org-drill-statistics--long-overdue-p' and are sorted most +overdue first, by descending days since last review. The list is capped +at `org-drill-statistics-attention-row-limit' rows." + (let* ((data (cl-remove-if-not + #'org-drill-statistics--long-overdue-p + (org-drill-statistics--collect-attention-data scope))) + (sorted + (sort data + (lambda (a b) + (> (org-drill-statistics--ad-review a) + (org-drill-statistics--ad-review b)))))) + (org-drill-statistics--cap-rows + (mapcar (lambda (d) + (cons (org-drill-statistics--entry-attention-data-heading d) + (org-drill-statistics--entry-attention-data-pos d))) + sorted)))) + +(defun org-drill-statistics--forgotten-new (&optional scope) + "Return capped forgotten-new cards as a list of (HEADING . POS). +SCOPE bounds the traversal, defaulting to `org-drill-scope'. Cards +satisfy `org-drill-statistics--forgotten-new-p' and are sorted oldest +first, by descending days since they were added. The list is capped at +`org-drill-statistics-attention-row-limit' rows." + (let* ((data (cl-remove-if-not + #'org-drill-statistics--forgotten-new-p + (org-drill-statistics--collect-attention-data scope))) + (sorted + (sort data + (lambda (a b) + (> (org-drill-statistics--ad-added a) + (org-drill-statistics--ad-added b)))))) + (org-drill-statistics--cap-rows + (mapcar (lambda (d) + (cons (org-drill-statistics--entry-attention-data-heading d) + (org-drill-statistics--entry-attention-data-pos d))) + sorted)))) + +;;; Forecast aggregator (helper 8/8). +;; +;; The forecast answers: of the scheduled cards in scope, how many come +;; due on each of the next DAYS days, starting today? The org-reading +;; part (collecting SCHEDULED day numbers from entries in scope) is kept +;; separate from the pure bucketing math so the math is unit-testable +;; without an org buffer. + +(defun org-drill-statistics--bucket-forecast-days + (scheduled-days today-day days) + "Bucket SCHEDULED-DAYS into a DAYS-long forecast vector. +SCHEDULED-DAYS is a list of absolute integer day numbers (the scale of +`time-to-days'), one per scheduled card. TODAY-DAY is today's absolute +day number. DAYS is the number of forecast buckets. + +Return a list of DAYS integers. Element I is the number of entries in +SCHEDULED-DAYS whose day equals TODAY-DAY plus I, so index 0 counts +cards due today and the last index counts cards due TODAY-DAY plus DAYS +minus one. Cards scheduled in the past or beyond the window are not +counted. When DAYS is zero or negative the result is the empty list." + (let ((buckets (if (> days 0) (make-vector days 0) (vector)))) + (when (> days 0) + (dolist (day scheduled-days) + (let ((offset (- day today-day))) + (when (and (>= offset 0) (< offset days)) + (aset buckets offset (1+ (aref buckets offset))))))) + (append buckets nil))) + +(defun org-drill-statistics--scheduled-days (&optional scope) + "Return the SCHEDULED day numbers of drill entries in SCOPE. +SCOPE accepts the same values as `org-drill-scope'; nil uses the +current value. Walk the drill entries in scope with +`org-drill-map-entries' and collect, for each entry that carries a +SCHEDULED time, its absolute integer day number (`time-to-days' of the +scheduled time). Entries without a SCHEDULED time are skipped. The +returned list is in entry-traversal order and may contain duplicate +days (several cards due the same day)." + (delq nil + (org-drill-map-entries + (lambda () + (let ((scheduled (org-get-scheduled-time (point)))) + (when scheduled + (time-to-days scheduled)))) + scope))) + +(defun org-drill-statistics--forecast (&optional scope days) + "Return the upcoming-due forecast for drill entries in SCOPE. +SCOPE accepts the same values as `org-drill-scope'; nil uses the +current value. DAYS is the number of forecast buckets and defaults to +`org-drill-statistics-forecast-days'. + +The result is a list of DAYS integers. Element I counts the cards in +scope whose SCHEDULED date falls on today plus I, so index 0 is due +today and the last index is due DAYS minus one days out. Cards +scheduled in the past or beyond the window are not counted, and cards +with no SCHEDULED time are ignored." + (let ((days (or days org-drill-statistics-forecast-days))) + (org-drill-statistics--bucket-forecast-days + (org-drill-statistics--scheduled-days scope) + (org-drill-statistics--today-day) + days))) + +;;; Statistics dashboard: needs-attention section renderer (render 4/5). +;; +;; `org-drill-statistics--render-attention' returns the section text as a +;; string so it is unit testable without a live dashboard buffer. It runs +;; a single org scan via `org-drill-statistics--collect-attention-data', +;; then filters, sorts, caps, and footers each of the three categories. +;; Doing one scan (rather than calling the three public selectors, which +;; each scan and cap) gives the pre-cap totals needed for the "+N more" +;; footers for free. + +(defun org-drill-statistics--card-link (heading pos) + "Return an org bracket link to a drill card heading. +HEADING is the card's outline heading string, used as the link +description. POS is the integer buffer position of the heading, carried +in the link path so the dashboard's RET handler can jump to the card. +The path has the form \"org-drill-card:POS\". Any closing bracket in +HEADING is replaced so a literal \"]]\" cannot terminate the link early. +An empty or nil HEADING falls back to a position-based description." + (let* ((desc (if (and heading (not (string-empty-p heading))) + heading + (format "card at %d" pos))) + (safe (replace-regexp-in-string "]" "}" desc))) + (format "[[org-drill-card:%d][%s]]" pos safe))) + +(defun org-drill-statistics--render-attention-table + (title rows total empty-note) + "Render one needs-attention subsection as an org string. +TITLE is the third-level heading text for the subsection. ROWS is a +list of (HEADING . POS) cons cells, already capped at +`org-drill-statistics-attention-row-limit' and already sorted. TOTAL is +the full count of matching cards before capping, used for the +\"+N more\" footer. EMPTY-NOTE is the line shown when ROWS is empty. + +The returned string ends with a trailing newline. When ROWS is +non-empty it contains a single-column org table of card links, followed +by a \"+N more\" footer line naming the hidden count when TOTAL exceeds +the number of rows shown." + (let ((shown (length rows))) + (concat + (format "*** %s\n" title) + (if (null rows) + (format "%s\n" empty-note) + (concat + "| Card |\n" + "|------|\n" + (mapconcat + (lambda (row) + (format "| %s |" + (org-drill-statistics--card-link (car row) (cdr row)))) + rows + "\n") + "\n" + (let ((hidden (- total shown))) + (if (> hidden 0) + (format "+%d more\n" hidden) + ""))))))) + +(defun org-drill-statistics--render-attention (&optional scope) + "Return the needs-attention dashboard section as an org string. +SCOPE bounds the drill traversal and accepts the same values as +`org-drill-scope'; nil uses the current value. This must run inside an +org buffer because it scans drill entries via +`org-drill-statistics--collect-attention-data'. + +The section opens with a \"** Needs attention\" heading and contains +three subsections, each an org table of card links: + + Leech candidates cards failing repeatedly with low average quality, + worst first. + Long overdue cards whose last review is well past the lapse + threshold, most overdue first. + Forgotten new cards added long ago and never repeated, oldest + first. + +Each table is capped at `org-drill-statistics-attention-row-limit' rows; +a category with more matches than the cap gains a \"+N more\" footer +naming the hidden count. A category with no matches shows a short note +instead of a table. This function returns a string and does not print, +switch buffers, or move point beyond the traversal itself. + +A single collection pass feeds all three categories, so the full +pre-cap totals are available for the footers without rescanning." + (let* ((data (org-drill-statistics--collect-attention-data scope)) + (leech-all (cl-remove-if-not + #'org-drill-statistics--leech-candidate-p data)) + (overdue-all (cl-remove-if-not + #'org-drill-statistics--long-overdue-p data)) + (new-all (cl-remove-if-not + #'org-drill-statistics--forgotten-new-p data)) + (leech-sorted + (sort (copy-sequence leech-all) + (lambda (a b) + (let ((qa (org-drill-statistics--ad-avg a)) + (qb (org-drill-statistics--ad-avg b))) + (if (= qa qb) + (> (org-drill-statistics--ad-fails a) + (org-drill-statistics--ad-fails b)) + (< qa qb)))))) + (overdue-sorted + (sort (copy-sequence overdue-all) + (lambda (a b) + (> (org-drill-statistics--ad-review a) + (org-drill-statistics--ad-review b))))) + (new-sorted + (sort (copy-sequence new-all) + (lambda (a b) + (> (org-drill-statistics--ad-added a) + (org-drill-statistics--ad-added b))))) + (to-rows + (lambda (structs) + (mapcar + (lambda (d) + (cons (org-drill-statistics--entry-attention-data-heading d) + (org-drill-statistics--entry-attention-data-pos d))) + (org-drill-statistics--cap-rows structs))))) + (concat + "** Needs attention\n" + (org-drill-statistics--render-attention-table + "Leech candidates" + (funcall to-rows leech-sorted) + (length leech-all) + "No leech candidates.") + (org-drill-statistics--render-attention-table + "Long overdue" + (funcall to-rows overdue-sorted) + (length overdue-all) + "No long-overdue cards.") + (org-drill-statistics--render-attention-table + "Forgotten new" + (funcall to-rows new-sorted) + (length new-all) + "No forgotten-new cards.")))) + +;;; Statistics dashboard: overview section renderer (render 1/5). +;; +;; Pure string builder. It reads card-population counts via +;; `org-drill-statistics--overview-counts' (which traverses the org +;; entries in scope) and the newest session record from LOG, then +;; returns the section text. It never prints, switches buffers, or +;; mutates state, so it is testable with a plain string assertion. + +(defun org-drill-statistics--format-last-session (record) + "Return the one-line \"Last session\" recap string for RECORD. +RECORD is an `org-drill-session-record', or nil when no session has +been logged. When nil, return a line stating there is no session yet. +Otherwise the line names the session date, its duration in minutes, the +number of cards reviewed (length of the qualities vector), and the +pass percentage. Pure: it reads only RECORD's slots." + (if (null record) + "Last session: none recorded yet." + (let* ((start (org-drill-session-record-start-time record)) + (end (org-drill-session-record-end-time record)) + (qualities (org-drill-session-record-qualities record)) + (reviewed (if qualities (length qualities) 0)) + (duration-min (max 0 (round (/ (- end start) 60.0)))) + (pass (org-drill-session-record-pass-percent record)) + (date (format-time-string "%Y-%m-%d" (seconds-to-time start)))) + (format + "Last session: %s, %d min, %d card%s reviewed, %d%% pass." + date duration-min reviewed (if (= reviewed 1) "" "s") pass)))) + +(defun org-drill-statistics--render-overview (&optional scope log) + "Return the Overview section of the statistics dashboard as a string. +SCOPE is passed to `org-drill-statistics--overview-counts' to bound the +card-population traversal; nil uses the current `org-drill-scope'. LOG +is a list of `org-drill-session-record' newest first, defaulting to +`org-drill-session-log'; its head supplies the \"Last session\" recap. + +The returned string is an org fragment: a \"** Overview\" subheading, a +4-column org table with a header row (Total cards, New, Mature, Lapsed) +and one data row from `org-drill-statistics--overview-counts', then a +blank line and the one-line last-session recap. This function is pure +with respect to its inputs apart from the org traversal that +`org-drill-statistics--overview-counts' performs over SCOPE; it does +not print, switch buffers, or modify any state." + (let* ((log (or log org-drill-session-log)) + (counts (org-drill-statistics--overview-counts scope)) + (total (plist-get counts :total)) + (new (plist-get counts :new)) + (mature (plist-get counts :mature)) + (lapsed (plist-get counts :lapsed)) + (recap (org-drill-statistics--format-last-session (car log)))) + (concat + "** Overview\n" + "| Total cards | New | Mature | Lapsed |\n" + "|-------------+-----+--------+--------|\n" + (format "| %d | %d | %d | %d |\n" total new mature lapsed) + "\n" + recap "\n"))) + +;;; Statistics dashboard: trends render helper (render 2/5). +;; +;; `org-drill-statistics--render-trends' returns the Trends section as a +;; string: a subheading, two sparkline lines (reviews per day and pass +;; rate per day over the trend window), then an org table of the last 12 +;; weekly aggregates. It is pure: it reads only LOG and the dashboard +;; defcustoms, calls the aggregation helpers, and returns a string. It +;; never prints, inserts, or switches buffers, so it stays unit testable. + +(defun org-drill-statistics--format-week-start (day) + "Format absolute DAY number as a YYYY-MM-DD date string. +DAY is an absolute day number on the `time-to-days' scale, as stored in +the :week-start slot of `org-drill-statistics--weekly-aggregates'. The +result is the Gregorian calendar date of that day, zero-padded. Pure +integer-to-string conversion via `calendar-gregorian-from-absolute', so +it is timezone independent and deterministic." + (let ((gregorian (calendar-gregorian-from-absolute day))) + (format "%04d-%02d-%02d" + (nth 2 gregorian) + (nth 0 gregorian) + (nth 1 gregorian)))) + +(defun org-drill-statistics--render-weekly-table (weekly) + "Render WEEKLY aggregates as an org-mode table string. +WEEKLY is a list of plists as returned by +`org-drill-statistics--weekly-aggregates', oldest week first. The table +has a header row, an org separator row, and one body row per week with +columns: Week (the Monday date), Reviews, Pass %, and Avg min (mean +session duration in minutes, one decimal place). The returned string +ends with a trailing newline. Pure string assembly: no buffer or org +table alignment is performed, so columns are single-space padded inside +the pipes and org realigns them when the buffer renders." + (let ((rows + (mapcar + (lambda (week) + (format "| %s | %d | %d | %.1f |" + (org-drill-statistics--format-week-start + (plist-get week :week-start)) + (plist-get week :reviews) + (plist-get week :pass-percent) + (plist-get week :avg-duration-min))) + weekly))) + (concat "| Week | Reviews | Pass % | Avg min |\n" + "|------+---------+--------+---------|\n" + (if rows + (concat (mapconcat #'identity rows "\n") "\n") + "")))) + +(defun org-drill-statistics--render-trends (log &optional algorithm) + "Return the Trends dashboard section for LOG as a string. +LOG is a list of `org-drill-session-record', newest first as stored in +`org-drill-session-log'. ALGORITHM, when non-nil, restricts the section +to records whose algorithm slot is `eq' to it, via +`org-drill-statistics--filter-log'; nil includes every algorithm. + +The section is a string containing, in order: + + - an \"* Trends\" org subheading, + - a reviews-per-day sparkline over the last + `org-drill-statistics-trend-days' days, labelled with the window, + - a pass-rate-per-day sparkline over the same window, + - an org table of the last 12 weekly aggregates (week-start date, + reviews, pass percentage, mean session duration in minutes). + +The sparklines come from `org-drill-statistics--sparkline' fed by +`org-drill-statistics--reviews-by-day' and +`org-drill-statistics--pass-rate-by-day'; the pass-rate sparkline is +scaled against a fixed ceiling of 100 so the glyph heights read as +absolute percentages rather than relative to the window's own peak. The +table comes from `org-drill-statistics--weekly-aggregates'. + +This function is pure: it reads only LOG and the dashboard defcustoms, +returns a string, and does not print, insert, or switch buffers." + (let* ((filtered (org-drill-statistics--filter-log log algorithm)) + (days org-drill-statistics-trend-days) + (reviews (org-drill-statistics--reviews-by-day filtered days)) + (pass-rates (org-drill-statistics--pass-rate-by-day filtered days)) + (weekly (org-drill-statistics--weekly-aggregates filtered 12))) + (concat + "* Trends\n" + (format "Reviews/day (last %d): %s\n" + days + (org-drill-statistics--sparkline reviews)) + (format "Pass rate/day (last %d): %s\n" + days + (org-drill-statistics--sparkline pass-rates 100)) + "\n" + (org-drill-statistics--render-weekly-table weekly)))) + +;;; Statistics dashboard: forecast section renderer (render 5/5). +;; +;; Pure string builder for the dashboard's Forecast section. It calls +;; `org-drill-statistics--forecast' for the per-day counts and lays them +;; out as a one-line org table: a header row labelling each upcoming day +;; (Today, +1, +2, ...) and a counts row beneath it. The function does +;; no printing and switches no buffers, so it is unit testable by +;; asserting on the returned string. + +(defun org-drill-statistics--render-forecast (&optional scope days) + "Return the Forecast dashboard section as an org-formatted string. +SCOPE accepts the same values as `org-drill-scope'; nil uses the current +value. DAYS is the number of forecast buckets and defaults to +`org-drill-statistics-forecast-days'. Reading SCOPE walks org entries, +so this must run inside an org buffer when SCOPE resolves to live cards. + +The returned string starts with a \"** Forecast\" subheading, then a +one-line org table. The table's header row labels each upcoming day: +the first column is \"Today\", and each later column is \"+N\" for N days +out. The counts row beneath holds the number of cards due on each day, +taken from `org-drill-statistics--forecast'. A trailing newline ends +the section so sections concatenate cleanly. + +When DAYS resolves to zero or fewer the forecast is empty; the section +then carries a short note in place of the table." + (let* ((counts (org-drill-statistics--forecast scope days)) + (n (length counts))) + (if (zerop n) + (concat "** Forecast\n" + "No forecast window configured.\n") + (let* ((labels (cons "Today" + (mapcar (lambda (i) (format "+%d" i)) + (number-sequence 1 (1- n))))) + (header (concat "| " (mapconcat #'identity labels " | ") " |")) + (values (concat "| " + (mapconcat (lambda (c) (format "%d" c)) + counts " | ") + " |"))) + (concat "** Forecast\n" + header "\n" + values "\n"))))) + +;;; Statistics dashboard: buffer-wide filter state and the UI shell. +;; +;; The dashboard is one read-only org-mode buffer assembled from a +;; filter header line plus the five `org-drill-statistics--render-*' +;; section strings. A single buffer-wide filter (scope, range, +;; algorithm) drives every section; the cycle commands rotate one filter +;; dimension and re-render in place. +;; +;; Integration seam with the render helpers: the renderers read the +;; three buffer-local filter variables below. +;; `org-drill-statistics--render-all' +;; binds the resolved log and scope/algorithm into those vars before +;; calling the renderers, so each renderer sees a consistent window. See +;; the integration notes for the exact contract each renderer is expected +;; to honor. + +(declare-function org-drill-statistics-export-csv "org-drill") +(declare-function org-drill-statistics--render-overview "org-drill") +(declare-function org-drill-statistics--render-trends "org-drill") +(declare-function org-drill-statistics--render-distribution "org-drill") +(declare-function org-drill-statistics--render-attention "org-drill") +(declare-function org-drill-statistics--render-forecast "org-drill") + +(defconst org-drill-statistics--buffer-name "*Org Drill Statistics*" + "Name of the read-only buffer holding the statistics dashboard.") + +(defvar org-drill-statistics-range-presets + '(("last 90d" . 90) + ("last 30d" . 30) + ("last 7d" . 7) + ("all time" . nil)) + "Range filter presets for the dashboard, in cycle order. +Each element is a cons (LABEL . DAYS). LABEL is the human string shown +in the header line. DAYS is the size of the trailing window in days, or +nil for the whole log. The first element is the default range and the +cycle wraps back to it after the last.") + +(defvar-local org-drill-statistics--scope nil + "Buffer-local active scope filter for the dashboard. +A value understood by `org-drill-current-scope', or nil to use the +current `org-drill-scope'. Set by `org-drill-statistics' and rotated by +`org-drill-statistics-cycle-scope'. Read by the render helpers to bound +their org traversal.") + +(defvar-local org-drill-statistics--range "last 90d" + "Buffer-local active range-filter label for the dashboard. +One of the LABEL strings in `org-drill-statistics-range-presets'. Set +by `org-drill-statistics' and rotated by +`org-drill-statistics-cycle-range'. The matching DAYS value bounds the +session log the trend and distribution sections aggregate over.") + +(defvar-local org-drill-statistics--algorithm nil + "Buffer-local active algorithm filter for the dashboard. +A drill algorithm symbol to restrict the session log to, or nil for all +algorithms. Set by `org-drill-statistics' and rotated by +`org-drill-statistics-cycle-algorithm'. Read by the render helpers via +the filtered log they are handed.") + +(defun org-drill-statistics--range-cutoff-float (label) + "Return the float-time cutoff for range LABEL, or nil for all time. +LABEL is a key in `org-drill-statistics-range-presets'. When its DAYS +value is non-nil, return the `float-time' of the instant DAYS days before +now, so records at or after the cutoff fall in the window. When DAYS is +nil, or LABEL is unknown, return nil meaning no lower bound." + (let ((days (cdr (assoc label org-drill-statistics-range-presets)))) + (when days + (- (float-time) (* days 86400.0))))) + +(defun org-drill-statistics--filtered-log (range-label algorithm) + "Return `org-drill-session-log' narrowed by RANGE-LABEL and ALGORITHM. +RANGE-LABEL is a key in `org-drill-statistics-range-presets'; its DAYS +value bounds the trailing window, and a nil DAYS keeps the whole log. +ALGORITHM is an algorithm symbol to keep, or nil for all algorithms. +The original log is not modified." + (let* ((by-algo (org-drill-statistics--filter-log + org-drill-session-log algorithm)) + (cutoff (org-drill-statistics--range-cutoff-float range-label))) + (if cutoff + (org-drill-statistics--log-since by-algo cutoff) + by-algo))) + +(defun org-drill-statistics--header-line (scope range algorithm) + "Return the dashboard filter header line for SCOPE, RANGE and ALGORITHM. +SCOPE is the active scope value, or nil for the current `org-drill-scope'. +RANGE is a range-preset label string. ALGORITHM is an algorithm symbol, +or nil for all algorithms. The result is a single line summarizing the +three active filters, matching the spec's header format." + (format "Scope: %s Range: %s Algorithm: %s" + (or scope org-drill-scope) + range + (or algorithm "all"))) + +(defun org-drill-statistics--render-all (scope range algorithm) + "Assemble the full dashboard body string for the active filters. +SCOPE, RANGE and ALGORITHM are the resolved filter values. This binds +the resolved filtered log and the scope/algorithm into the buffer-local +filter variables so each `org-drill-statistics--render-*' helper reads a +consistent window, then concatenates the header line and the five +section strings. The log and card scans run while these bindings are in +effect. Returns the assembled buffer contents as a string." + (let* ((org-drill-statistics--scope scope) + (org-drill-statistics--range range) + (org-drill-statistics--algorithm algorithm) + (log (org-drill-statistics--filtered-log range algorithm)) + (hist (org-drill-statistics--quality-histogram log))) + (concat + (org-drill-statistics--header-line scope range algorithm) + "\n\n" + (org-drill-statistics--render-overview scope log) + "\n" + ;; LOG is already algorithm-filtered, so pass nil to avoid + ;; filtering a second time. + (org-drill-statistics--render-trends log nil) + "\n" + (org-drill-statistics--render-distribution hist) + "\n" + (org-drill-statistics--render-attention scope) + "\n" + (org-drill-statistics--render-forecast scope)))) + +(defvar org-drill-statistics-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "q") #'quit-window) + (define-key map (kbd "g") #'org-drill-statistics-refresh) + (define-key map (kbd "e") #'org-drill-statistics-export-csv) + (define-key map (kbd "s") #'org-drill-statistics-cycle-scope) + (define-key map (kbd "r") #'org-drill-statistics-cycle-range) + (define-key map (kbd "a") #'org-drill-statistics-cycle-algorithm) + (define-key map (kbd "RET") #'org-open-at-point) + map) + "Keymap for `org-drill-statistics-mode'. +Bindings: q bury, g refresh, e export CSV, s cycle scope, r cycle range, +a cycle algorithm, RET follow the card link at point. These avoid the +read-only org-mode bindings the dashboard relies on for link following +and navigation.") + +(define-minor-mode org-drill-statistics-mode + "Minor mode active in the org-drill statistics dashboard buffer. +Installs `org-drill-statistics-mode-map' so q, g, e, s, r, a and RET +drive the dashboard. Enabled by `org-drill-statistics' after the buffer +is put in `org-mode'; not intended to be toggled by hand." + :lighter " OrgDrillStats" + :keymap org-drill-statistics-mode-map) + +(defun org-drill-statistics--render (buffer scope range algorithm) + "Render the dashboard for SCOPE, RANGE, ALGORITHM into BUFFER. +BUFFER is the target buffer. Its read-only state is lifted for the +write, the assembled body replaces the contents, point returns to the +top, and the buffer is left read-only. The three filter values are +stored buffer-locally so refresh and the cycle commands can read and +rotate them. Returns BUFFER." + (with-current-buffer buffer + (let ((inhibit-read-only t) + (body (org-drill-statistics--render-all scope range algorithm))) + (erase-buffer) + (insert body) + (goto-char (point-min))) + (setq org-drill-statistics--scope scope + org-drill-statistics--range range + org-drill-statistics--algorithm algorithm) + (setq buffer-read-only t) + buffer)) + +;;;###autoload +(defun org-drill-statistics () + "Open the org-drill statistics dashboard. +Builds the read-only org-mode buffer `*Org Drill Statistics*' from the +filter header and the five render sections, using the current +`org-drill-scope', the default range, and all algorithms, then switches +to it. Refresh and the s/r/a cycle commands re-render in place." + (interactive) + (let ((buffer (get-buffer-create org-drill-statistics--buffer-name)) + (scope org-drill-scope) + (range (caar org-drill-statistics-range-presets)) + (algorithm nil)) + (with-current-buffer buffer + (org-mode) + (org-drill-statistics-mode 1)) + (org-drill-statistics--render buffer scope range algorithm) + (switch-to-buffer buffer) + buffer)) + +(defun org-drill-statistics-refresh () + "Re-render the dashboard in place, preserving the active filters. +Reads the buffer-local scope, range, and algorithm filters and rebuilds +every section against the current log and card state. Bound to g." + (interactive) + (org-drill-statistics--render + (current-buffer) + org-drill-statistics--scope + org-drill-statistics--range + org-drill-statistics--algorithm)) + +(defun org-drill-statistics-cycle-scope () + "Cycle the dashboard scope filter and refresh. +Rotates through a small fixed set of common scopes, then re-renders. +Bound to s." + (interactive) + (let* ((scopes '(file directory agenda agenda-with-archives)) + (current org-drill-statistics--scope) + (tail (cdr (member current scopes))) + (next (or (car tail) (car scopes)))) + (setq org-drill-statistics--scope next) + (org-drill-statistics-refresh) + (message "Scope: %s" next))) + +(defun org-drill-statistics-cycle-range () + "Cycle the dashboard range filter and refresh. +Rotates through `org-drill-statistics-range-presets' in order, wrapping +after the last preset, then re-renders. Bound to r." + (interactive) + (let* ((labels (mapcar #'car org-drill-statistics-range-presets)) + (current org-drill-statistics--range) + (tail (cdr (member current labels))) + (next (or (car tail) (car labels)))) + (setq org-drill-statistics--range next) + (org-drill-statistics-refresh) + (message "Range: %s" next))) + +(defun org-drill-statistics-cycle-algorithm () + "Cycle the dashboard algorithm filter and refresh. +Rotates through every algorithm symbol seen in `org-drill-session-log' +plus an all-algorithms state (nil), then re-renders. When the log has +no records the filter stays at all-algorithms. Bound to a." + (interactive) + (let* ((algorithms + (delete-dups + (delq nil + (mapcar #'org-drill-session-record-algorithm + org-drill-session-log)))) + ;; nil (all) leads the cycle, then each known algorithm. + (states (cons nil algorithms)) + (current org-drill-statistics--algorithm) + (tail (cdr (member current states))) + (next (if (member current states) + (car tail) + nil))) + (setq org-drill-statistics--algorithm next) + (org-drill-statistics-refresh) + (message "Algorithm: %s" (or next "all")))) + (provide 'org-drill) ;;; org-drill.el ends here diff --git a/tests/test-org-drill-statistics-attention-data.el b/tests/test-org-drill-statistics-attention-data.el new file mode 100644 index 0000000..7c3d8c7 --- /dev/null +++ b/tests/test-org-drill-statistics-attention-data.el @@ -0,0 +1,263 @@ +;;; test-org-drill-statistics-attention-data.el --- Tests for attention-data statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard attention-data block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; ERT tests for the needs-attention selectors. +;; +;; The org-traversal collector and the public selectors are exercised +;; through a `with-temp-buffer' fixture with deterministic data. Day +;; offsets are computed relative to (current-time) so the fixture never +;; hardcodes a calendar date. The pure predicates and the row cap are +;; tested directly on structs without any buffer. + + +(defun test-org-drill-statistics--inactive-stamp (days-ago) + "Return an inactive org timestamp string DAYS-AGO before today. +Derived from (current-time) so the fixture stays date-independent." + (org-drill-time-to-inactive-org-timestamp + (time-subtract (current-time) (days-to-time days-ago)))) + +(defun test-org-drill-statistics--mkdata (&rest kw) + "Build an entry-attention-data struct from keyword args KW. +Defaults: failure 0, avg nil, review nil, added nil, repeats 0, pos 1." + (org-drill-statistics--make-entry-attention-data + :heading (or (plist-get kw :heading) "card") + :pos (or (plist-get kw :pos) 1) + :failure-count (or (plist-get kw :failure-count) 0) + :avg-quality (plist-get kw :avg-quality) + :days-since-review (plist-get kw :days-since-review) + :days-since-added (plist-get kw :days-since-added) + :total-repeats (or (plist-get kw :total-repeats) 0))) + +;;; ---- Normal cases: predicates ---- + +(ert-deftest test-org-drill-statistics-leech-predicate-flags-low-quality-failer () + "A card over the failure threshold with low avg quality is a leech." + (let ((org-drill-leech-failure-threshold 3) + (org-drill-statistics-leech-quality-threshold 2.5)) + (should (org-drill-statistics--leech-candidate-p + (test-org-drill-statistics--mkdata + :failure-count 4 :avg-quality 1.8))))) + +(ert-deftest test-org-drill-statistics-long-overdue-predicate-flags-stale-review () + "A review older than the lapse threshold is long overdue." + (let ((org-drill-lapse-threshold-days 30)) + (should (org-drill-statistics--long-overdue-p + (test-org-drill-statistics--mkdata :days-since-review 45))))) + +(ert-deftest test-org-drill-statistics-forgotten-new-predicate-flags-unrepeated-old () + "A card added 20 days ago with zero repeats is forgotten-new." + (should (org-drill-statistics--forgotten-new-p + (test-org-drill-statistics--mkdata + :days-since-added 20 :total-repeats 0)))) + +;;; ---- Boundary cases: predicates ---- + +(ert-deftest test-org-drill-statistics-leech-predicate-quality-at-threshold-excluded () + "Average quality exactly at the ceiling is not a leech (strict <)." + (let ((org-drill-leech-failure-threshold 3) + (org-drill-statistics-leech-quality-threshold 2.5)) + (should-not (org-drill-statistics--leech-candidate-p + (test-org-drill-statistics--mkdata + :failure-count 5 :avg-quality 2.5))))) + +(ert-deftest test-org-drill-statistics-leech-predicate-failures-at-threshold-included () + "Failure count equal to the threshold satisfies the >= test." + (let ((org-drill-leech-failure-threshold 3) + (org-drill-statistics-leech-quality-threshold 2.5)) + (should (org-drill-statistics--leech-candidate-p + (test-org-drill-statistics--mkdata + :failure-count 3 :avg-quality 2.0))))) + +(ert-deftest test-org-drill-statistics-long-overdue-predicate-equal-threshold-excluded () + "Exactly the lapse threshold is not yet over it (strict >)." + (let ((org-drill-lapse-threshold-days 30)) + (should-not (org-drill-statistics--long-overdue-p + (test-org-drill-statistics--mkdata :days-since-review 30))))) + +(ert-deftest test-org-drill-statistics-forgotten-new-predicate-exactly-14-days-included () + "Added exactly 14 days ago meets the >= 14 day floor." + (should (org-drill-statistics--forgotten-new-p + (test-org-drill-statistics--mkdata + :days-since-added 14 :total-repeats 0)))) + +(ert-deftest test-org-drill-statistics-forgotten-new-predicate-13-days-excluded () + "Added 13 days ago is below the 14-day floor." + (should-not (org-drill-statistics--forgotten-new-p + (test-org-drill-statistics--mkdata + :days-since-added 13 :total-repeats 0)))) + +;;; ---- Error / absent-data cases: predicates ---- + +(ert-deftest test-org-drill-statistics-leech-predicate-missing-quality-excluded () + "A card with no recorded average quality is not a leech." + (let ((org-drill-leech-failure-threshold 3) + (org-drill-statistics-leech-quality-threshold 2.5)) + (should-not (org-drill-statistics--leech-candidate-p + (test-org-drill-statistics--mkdata + :failure-count 9 :avg-quality nil))))) + +(ert-deftest test-org-drill-statistics-long-overdue-predicate-never-reviewed-excluded () + "A never-reviewed card (nil days) is not long overdue." + (let ((org-drill-lapse-threshold-days 30)) + (should-not (org-drill-statistics--long-overdue-p + (test-org-drill-statistics--mkdata :days-since-review nil))))) + +(ert-deftest test-org-drill-statistics-forgotten-new-predicate-missing-add-date-excluded () + "A card with no add date is not forgotten-new." + (should-not (org-drill-statistics--forgotten-new-p + (test-org-drill-statistics--mkdata + :days-since-added nil :total-repeats 0)))) + +(ert-deftest test-org-drill-statistics-forgotten-new-predicate-repeated-excluded () + "An old card that has been repeated is not forgotten-new." + (should-not (org-drill-statistics--forgotten-new-p + (test-org-drill-statistics--mkdata + :days-since-added 30 :total-repeats 2)))) + +;;; ---- Row cap ---- + +(ert-deftest test-org-drill-statistics-cap-rows-under-limit-unchanged () + "A list shorter than the limit is returned unchanged." + (let ((org-drill-statistics-attention-row-limit 10)) + (should (equal '(a b c) (org-drill-statistics--cap-rows '(a b c)))))) + +(ert-deftest test-org-drill-statistics-cap-rows-over-limit-truncated () + "A list longer than the limit is truncated to the limit length." + (let ((org-drill-statistics-attention-row-limit 3)) + (should (equal '(a b c) + (org-drill-statistics--cap-rows '(a b c d e)))))) + +(ert-deftest test-org-drill-statistics-cap-rows-empty-stays-empty () + "An empty list caps to empty." + (let ((org-drill-statistics-attention-row-limit 5)) + (should (null (org-drill-statistics--cap-rows '()))))) + +;;; ---- timestamp helper ---- + +(ert-deftest test-org-drill-statistics-days-since-timestamp-nil-returns-nil () + "A nil timestamp yields nil days." + (should (null (org-drill-statistics--days-since-org-timestamp nil 1000)))) + +(ert-deftest test-org-drill-statistics-days-since-timestamp-malformed-returns-nil () + "A malformed timestamp is caught and yields nil rather than erroring." + (should (null (org-drill-statistics--days-since-org-timestamp + "not-a-date" 1000)))) + +;;; ---- Integration via with-temp-buffer fixture ---- + +(defmacro test-org-drill-statistics--with-cards (&rest body) + "Run BODY in a temp org buffer holding drill cards. +The buffer holds one card per needs-attention category plus a clean +card. Standard thresholds are bound so the predicates have stable +inputs. Dates are relative to today." + `(let ((org-drill-leech-failure-threshold 3) + (org-drill-statistics-leech-quality-threshold 2.5) + (org-drill-lapse-threshold-days 30) + (org-drill-statistics-attention-row-limit 10) + (org-drill-question-tag "drill") + (org-drill-scope 'file) + (org-drill-match nil)) + (with-temp-buffer + (org-mode) + (insert + "* Leech card :drill:\n" + ":PROPERTIES:\n" + ":DRILL_FAILURE_COUNT: 5\n" + ":DRILL_AVERAGE_QUALITY: 1.2\n" + ":DRILL_LAST_REVIEWED: " (test-org-drill-statistics--inactive-stamp 2) "\n" + ":DRILL_TOTAL_REPEATS: 7\n" + ":END:\n" + "* Overdue card :drill:\n" + ":PROPERTIES:\n" + ":DRILL_LAST_REVIEWED: " (test-org-drill-statistics--inactive-stamp 60) "\n" + ":DRILL_TOTAL_REPEATS: 3\n" + ":END:\n" + "* Forgotten new card :drill:\n" + ":PROPERTIES:\n" + ":DATE_ADDED: " (test-org-drill-statistics--inactive-stamp 20) "\n" + ":END:\n" + "* Healthy card :drill:\n" + ":PROPERTIES:\n" + ":DRILL_FAILURE_COUNT: 0\n" + ":DRILL_AVERAGE_QUALITY: 4.8\n" + ":DRILL_LAST_REVIEWED: " (test-org-drill-statistics--inactive-stamp 1) "\n" + ":DATE_ADDED: " (test-org-drill-statistics--inactive-stamp 1) "\n" + ":DRILL_TOTAL_REPEATS: 12\n" + ":END:\n") + ,@body))) + +(ert-deftest test-org-drill-statistics-leech-candidates-selects-leech-only () + "Only the leech card is returned by the leech selector." + (test-org-drill-statistics--with-cards + (let ((result (org-drill-statistics--leech-candidates))) + (should (equal '("Leech card") (mapcar #'car result))) + (should (integerp (cdr (car result))))))) + +(ert-deftest test-org-drill-statistics-long-overdue-selects-overdue-only () + "Only the overdue card is returned by the overdue selector." + (test-org-drill-statistics--with-cards + (should (equal '("Overdue card") + (mapcar #'car (org-drill-statistics--long-overdue)))))) + +(ert-deftest test-org-drill-statistics-forgotten-new-selects-forgotten-only () + "Only the forgotten-new card is returned by that selector." + (test-org-drill-statistics--with-cards + (should (equal '("Forgotten new card") + (mapcar #'car (org-drill-statistics--forgotten-new)))))) + +(ert-deftest test-org-drill-statistics-long-overdue-sorted-most-overdue-first () + "The overdue list is ordered by descending staleness." + (let ((org-drill-lapse-threshold-days 10) + (org-drill-question-tag "drill") + (org-drill-scope 'file) + (org-drill-statistics-attention-row-limit 10) + (org-drill-match nil)) + (with-temp-buffer + (org-mode) + (insert + "* Mild :drill:\n:PROPERTIES:\n:DRILL_LAST_REVIEWED: " + (test-org-drill-statistics--inactive-stamp 15) "\n:END:\n" + "* Severe :drill:\n:PROPERTIES:\n:DRILL_LAST_REVIEWED: " + (test-org-drill-statistics--inactive-stamp 90) "\n:END:\n") + (should (equal '("Severe" "Mild") + (mapcar #'car (org-drill-statistics--long-overdue))))))) + +(ert-deftest test-org-drill-statistics-leech-candidates-empty-buffer-returns-nil () + "A buffer with no drill entries yields no leech candidates." + (let ((org-drill-question-tag "drill") + (org-drill-scope 'file) + (org-drill-statistics-attention-row-limit 10) + (org-drill-match nil)) + (with-temp-buffer + (org-mode) + (insert "* Just a heading\nNo drill tag here.\n") + (should (null (org-drill-statistics--leech-candidates)))))) + +(ert-deftest test-org-drill-statistics-leech-candidates-respects-row-limit () + "More leeches than the limit are truncated to the limit count." + (let ((org-drill-leech-failure-threshold 3) + (org-drill-statistics-leech-quality-threshold 2.5) + (org-drill-statistics-attention-row-limit 2) + (org-drill-question-tag "drill") + (org-drill-scope 'file) + (org-drill-match nil)) + (with-temp-buffer + (org-mode) + (dotimes (i 4) + (insert + (format "* Leech %d :drill:\n:PROPERTIES:\n:DRILL_FAILURE_COUNT: 4\n:DRILL_AVERAGE_QUALITY: %s\n:END:\n" + i (+ 1.0 (* i 0.1))))) + (should (= 2 (length (org-drill-statistics--leech-candidates))))))) + +(provide 'test-org-drill-statistics-attention-data) + +;;; test-org-drill-statistics-attention-data.el ends here diff --git a/tests/test-org-drill-statistics-distribution.el b/tests/test-org-drill-statistics-distribution.el new file mode 100644 index 0000000..f98d9aa --- /dev/null +++ b/tests/test-org-drill-statistics-distribution.el @@ -0,0 +1,84 @@ +;;; test-org-drill-statistics-distribution.el --- Tests for distribution statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard distribution block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +(ert-deftest test-org-drill-statistics-distribution-subheading () + "The rendered section opens with the Quality Distribution subheading." + (let ((out (org-drill-statistics--render-distribution [1 0 2 3 5 4]))) + (should (string-prefix-p "** Quality Distribution" out)))) + +(ert-deftest test-org-drill-statistics-distribution-all-six-rows () + "Every quality 0..5 gets a row even when its count is zero." + (let* ((out (org-drill-statistics--render-distribution [0 0 0 0 0 0])) + (lines (split-string out "\n" t))) + ;; subheading + note line + six quality rows. + (dotimes (q 6) + (should (string-match-p (format "^%d " q) out))))) + +(ert-deftest test-org-drill-statistics-distribution-counts-and-percent () + "Each row shows the absolute count and the percent of total." + ;; Total 10: quality 5 has 5 (50%), quality 0 has 1 (10%). + (let ((out (org-drill-statistics--render-distribution [1 1 1 1 1 5]))) + (should (string-match-p "^5 .* 5 50%$" out)) + (should (string-match-p "^0 .* 1 10%$" out)))) + +(ert-deftest test-org-drill-statistics-distribution-total-line () + "A non-empty histogram reports the total rating count." + (let ((out (org-drill-statistics--render-distribution [2 0 0 0 0 3]))) + (should (string-match-p "Total ratings: 5" out)))) + +(ert-deftest test-org-drill-statistics-distribution-empty-note () + "An all-zero histogram emits the empty note and 0%% percentages." + (let ((out (org-drill-statistics--render-distribution [0 0 0 0 0 0]))) + (should (string-match-p "No quality ratings recorded yet\\." out)) + (should (string-match-p "^3 .* 0 0%$" out)))) + +(ert-deftest test-org-drill-statistics-distribution-bar-scales-to-max () + "The largest count fills the full bar width; smaller counts scale down." + (let* ((org-drill-statistics-distribution-bar-width 10) + (out (org-drill-statistics--render-distribution [10 0 0 0 0 5])) + (block (char-to-string ?\x2588))) + ;; Quality 0 (count 10, the max) fills all 10 blocks. + (should (string-match-p + (concat "^0 " (regexp-quote (make-string 10 ?\x2588))) + out)) + ;; Quality 5 (count 5, half the max) fills 5 blocks. + (should (string-match-p + (concat "^5 " (regexp-quote (make-string 5 ?\x2588)) " ") + out)))) + +(ert-deftest test-org-drill-statistics-distribution-pure-no-buffer () + "Rendering returns a string and does not switch or create buffers." + (let ((before (buffer-list))) + (should (stringp (org-drill-statistics--render-distribution [1 2 3 4 5 6]))) + (should (equal before (buffer-list))))) + +(ert-deftest test-org-drill-statistics-distribution-from-histogram-helper () + "Renderer composes with the quality-histogram aggregator over a fixture log. +Components integrated: +- org-drill-statistics--quality-histogram (real) +- org-drill-statistics--render-distribution (real, entry point) +Validates the count for a known fixture flows through to the rendered row." + (let* ((rec (make-org-drill-session-record + :start-time (float-time) + :end-time (float-time) + :qualities [5 5 5 0])) + (hist (org-drill-statistics--quality-histogram (list rec))) + (out (org-drill-statistics--render-distribution hist))) + (should (string-match-p "Total ratings: 4" out)) + ;; Quality 5 appears three times (75%). + (should (string-match-p "^5 .* 3 75%$" out)) + ;; Quality 0 appears once (25%). + (should (string-match-p "^0 .* 1 25%$" out)))) + +(provide 'test-org-drill-statistics-distribution) + +;;; test-org-drill-statistics-distribution.el ends here diff --git a/tests/test-org-drill-statistics-forecast.el b/tests/test-org-drill-statistics-forecast.el new file mode 100644 index 0000000..cf6efae --- /dev/null +++ b/tests/test-org-drill-statistics-forecast.el @@ -0,0 +1,136 @@ +;;; test-org-drill-statistics-forecast.el --- Tests for forecast statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard forecast block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; Tests for org-drill-statistics--forecast and its pure bucketer. +;; +;; The bucketing math is exercised directly against +;; `org-drill-statistics--bucket-forecast-days' with synthetic day +;; numbers (no org buffer needed). The org-reading path is exercised +;; through a with-temp-buffer fixture whose SCHEDULED dates are derived +;; relative to (current-time), never hardcoded. + + +(defun test-org-drill-statistics--scheduled-offset-string (days-from-today) + "Return an active org SCHEDULED stamp DAYS-FROM-TODAY days out. +Derived from `current-time' so the fixture never hardcodes a date." + (format-time-string + "<%Y-%m-%d %a>" + (time-add (current-time) (days-to-time days-from-today)))) + +(defun test-org-drill-statistics--forecast-fixture (offsets) + "Insert one scheduled drill card per integer in OFFSETS. +Each card is tagged `drill' and scheduled that many days from today. +Returns nothing; call inside a `with-temp-buffer' after `org-mode'." + (let ((n 0)) + (dolist (off offsets) + (setq n (1+ n)) + (insert (format "* Card %d :drill:\nSCHEDULED: %s\n" + n + (test-org-drill-statistics--scheduled-offset-string off)))))) + +;; Normal cases -------------------------------------------------------- + +(ert-deftest test-org-drill-statistics-forecast-bucket-counts-by-offset () + "Bucketer tallies each day-offset into the matching index." + (let ((today 1000)) + ;; Two due today, one due tomorrow, one due in 3 days. + (should (equal (org-drill-statistics--bucket-forecast-days + (list 1000 1000 1001 1003) today 7) + '(2 1 0 1 0 0 0))))) + +(ert-deftest test-org-drill-statistics-forecast-bucket-empty-input () + "Bucketer returns an all-zero vector of the requested length." + (should (equal (org-drill-statistics--bucket-forecast-days nil 500 5) + '(0 0 0 0 0)))) + +(ert-deftest test-org-drill-statistics-forecast-reads-scheduled-entries () + "Forecast over a fixture counts cards by their SCHEDULED day." + (with-temp-buffer + (org-mode) + ;; today, today, tomorrow, day-after, plus a far-future card. + (test-org-drill-statistics--forecast-fixture '(0 0 1 2 30)) + (let ((org-drill-scope 'file) + (org-drill-question-tag "drill") + (org-drill-match nil)) + ;; Default window of 7: the day-30 card falls outside it. + ;; Offsets 0,0,1,2 bucket to today=2, +1=1, +2=1; +30 dropped. + (should (equal (org-drill-statistics--forecast 'file 7) + '(2 1 1 0 0 0 0)))))) + +;; Boundary cases ------------------------------------------------------ + +(ert-deftest test-org-drill-statistics-forecast-bucket-window-edges () + "Cards on the last in-window day count; the next day does not." + (let ((today 0)) + ;; offset 6 is the last bucket of a 7-day window; offset 7 is out. + (should (equal (org-drill-statistics--bucket-forecast-days + (list 6 7) today 7) + '(0 0 0 0 0 0 1))))) + +(ert-deftest test-org-drill-statistics-forecast-bucket-past-and-future-dropped () + "Days before today and beyond the window are not counted." + (let ((today 100)) + (should (equal (org-drill-statistics--bucket-forecast-days + (list 99 100 110) today 3) + '(1 0 0))))) + +(ert-deftest test-org-drill-statistics-forecast-bucket-single-day-window () + "A one-day window yields a single bucket counting today's cards." + ;; Two cards due today, one due tomorrow; a window of 1 keeps only the + ;; today bucket, so the tomorrow card is dropped. + (should (equal (org-drill-statistics--bucket-forecast-days + (list 50 50 51) 50 1) + '(2)))) + +(ert-deftest test-org-drill-statistics-forecast-skips-unscheduled-entries () + "Entries without a SCHEDULED time are ignored by the reader." + (with-temp-buffer + (org-mode) + (insert "* Scheduled card :drill:\nSCHEDULED: " + (test-org-drill-statistics--scheduled-offset-string 0) + "\n* No-schedule card :drill:\n") + (let ((org-drill-scope 'file) + (org-drill-question-tag "drill") + (org-drill-match nil)) + (should (equal (org-drill-statistics--scheduled-days 'file) + (list (org-drill-statistics--today-day)))) + (should (equal (org-drill-statistics--forecast 'file 3) + '(1 0 0)))))) + +;; Error / degenerate cases ------------------------------------------- + +(ert-deftest test-org-drill-statistics-forecast-bucket-zero-days () + "A zero-length window yields the empty list." + (should (equal (org-drill-statistics--bucket-forecast-days + (list 10 11) 10 0) + nil))) + +(ert-deftest test-org-drill-statistics-forecast-bucket-negative-days () + "A negative window length is treated as empty, not an error." + (should (equal (org-drill-statistics--bucket-forecast-days + (list 10 11) 10 -3) + nil))) + +(ert-deftest test-org-drill-statistics-forecast-empty-scope () + "A scope with no drill entries forecasts all zeros." + (with-temp-buffer + (org-mode) + (insert "* Not a card\nSome prose.\n") + (let ((org-drill-scope 'file) + (org-drill-question-tag "drill") + (org-drill-match nil)) + (should (equal (org-drill-statistics--forecast 'file 4) + '(0 0 0 0)))))) + +(provide 'test-org-drill-statistics-forecast) + +;;; test-org-drill-statistics-forecast.el ends here diff --git a/tests/test-org-drill-statistics-overview-counts.el b/tests/test-org-drill-statistics-overview-counts.el new file mode 100644 index 0000000..8153531 --- /dev/null +++ b/tests/test-org-drill-statistics-overview-counts.el @@ -0,0 +1,181 @@ +;;; test-org-drill-statistics-overview-counts.el --- Tests for overview-counts statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard overview-counts block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; test-org-drill-statistics-overview-counts.el --- overview-counts tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `org-drill-statistics--overview-counts': walk the drill +;; entries in a scope and bucket them into a (:total :new :mature +;; :lapsed) plist via `org-drill-entry-status'. + +;;; Code: + + +(defmacro with-fixed-now (&rest body) + "Run BODY with `current-time' pinned to 2026-05-05 12:00." + `(cl-letf (((symbol-function 'current-time) + (lambda () (encode-time 0 0 12 5 5 2026)))) + ,@body)) + +(defmacro with-overview-buffer (content &rest body) + "Insert CONTENT into a temp org buffer, then run BODY at point-min." + (declare (indent 1)) + `(with-temp-buffer + (let ((org-startup-folded nil)) + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;;; Normal cases + +(ert-deftest test-org-drill-statistics-overview-counts-mixed-population () + "A buffer with one new, one mature (young), and one lapsed card buckets +each correctly and totals three." + (with-overview-buffer + (concat + "* New card :drill:\nbody of a brand new card\n" + "* Young card :drill:\n" + "SCHEDULED: <2026-05-04 Mon>\n" + ":PROPERTIES:\n" + ":DRILL_LAST_QUALITY: 5\n:DRILL_LAST_INTERVAL: 3\n" + ":DRILL_TOTAL_REPEATS: 2\n:END:\nbody\n" + "* Lapsed card :drill:\n" + "SCHEDULED: <2026-04-30 Thu>\n" + ":PROPERTIES:\n" + ":DRILL_LAST_QUALITY: 1\n:DRILL_LAST_INTERVAL: 5\n" + ":DRILL_TOTAL_REPEATS: 3\n:END:\nbody\n") + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 3 (plist-get counts :total))) + (should (= 1 (plist-get counts :new))) + (should (= 1 (plist-get counts :mature))) + (should (= 1 (plist-get counts :lapsed))))))) + +(ert-deftest test-org-drill-statistics-overview-counts-overdue-counts-as-mature () + "An :overdue card lands in the mature bucket, not its own." + (with-overview-buffer + (concat + "* Very overdue :drill:\n" + "SCHEDULED: <2026-04-15 Wed>\n" + ":PROPERTIES:\n" + ":DRILL_LAST_QUALITY: 5\n:DRILL_LAST_INTERVAL: 5\n" + ":DRILL_TOTAL_REPEATS: 3\n:END:\nbody\n") + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 1 (plist-get counts :total))) + (should (= 0 (plist-get counts :new))) + (should (= 1 (plist-get counts :mature))) + (should (= 0 (plist-get counts :lapsed))))))) + +(ert-deftest test-org-drill-statistics-overview-counts-future-counts-in-total-only () + "A future-scheduled card counts toward :total but not new/mature/lapsed." + (with-overview-buffer + (concat + "* Future card :drill:\n" + "SCHEDULED: <2026-05-10 Sun>\n" + "body\n") + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 1 (plist-get counts :total))) + (should (= 0 (plist-get counts :new))) + (should (= 0 (plist-get counts :mature))) + (should (= 0 (plist-get counts :lapsed))))))) + +;;;; Boundary cases + +(ert-deftest test-org-drill-statistics-overview-counts-empty-buffer-all-zero () + "No headings at all yields zero across every bucket." + (with-overview-buffer "Just some prose, no headings.\n" + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 0 (plist-get counts :total))) + (should (= 0 (plist-get counts :new))) + (should (= 0 (plist-get counts :mature))) + (should (= 0 (plist-get counts :lapsed))))))) + +(ert-deftest test-org-drill-statistics-overview-counts-non-drill-headings-ignored () + "Plain headings without the drill tag never reach :total." + (with-overview-buffer + (concat + "* Plain heading one\nbody\n" + "* The only drill :drill:\nbody of a new card\n" + "* Plain heading two\nbody\n") + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 1 (plist-get counts :total))) + (should (= 1 (plist-get counts :new))))))) + +(ert-deftest test-org-drill-statistics-overview-counts-single-new-card () + "A single new card: total and new are one, the rest zero." + (with-overview-buffer "* Lonely :drill:\nbody of the only card\n" + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 1 (plist-get counts :total))) + (should (= 1 (plist-get counts :new))) + (should (= 0 (plist-get counts :mature))) + (should (= 0 (plist-get counts :lapsed))))))) + +(ert-deftest test-org-drill-statistics-overview-counts-empty-drill-card-not-counted () + "A drill-tagged heading with an empty body and a default card type has +status nil and is excluded from :total." + (with-overview-buffer + "* Empty drill :drill:\n:PROPERTIES:\n:ID: x\n:END:\n" + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (= 0 (plist-get counts :total))))))) + +;;;; Error / robustness cases + +(ert-deftest test-org-drill-statistics-overview-counts-returns-plist-shape () + "The return value always carries the four documented keys, even when +the buffer holds no cards." + (with-overview-buffer "no headings here\n" + (with-fixed-now + (let ((counts (org-drill-statistics--overview-counts 'file))) + (should (plist-member counts :total)) + (should (plist-member counts :new)) + (should (plist-member counts :mature)) + (should (plist-member counts :lapsed)) + (should (cl-every #'integerp + (list (plist-get counts :total) + (plist-get counts :new) + (plist-get counts :mature) + (plist-get counts :lapsed)))))))) + +(ert-deftest test-org-drill-statistics-overview-counts-totals-are-additive () + "New + mature + lapsed never exceeds :total, and the dormant remainder +(:total minus the three actionable buckets) is non-negative." + (with-overview-buffer + (concat + "* New :drill:\nbody one\n" + "* Young :drill:\n" + "SCHEDULED: <2026-05-04 Mon>\n" + ":PROPERTIES:\n" + ":DRILL_LAST_QUALITY: 5\n:DRILL_LAST_INTERVAL: 3\n" + ":DRILL_TOTAL_REPEATS: 2\n:END:\nbody\n" + "* Future :drill:\n" + "SCHEDULED: <2026-05-10 Sun>\n" + "body\n") + (with-fixed-now + (let* ((counts (org-drill-statistics--overview-counts 'file)) + (actionable (+ (plist-get counts :new) + (plist-get counts :mature) + (plist-get counts :lapsed)))) + (should (>= (plist-get counts :total) actionable)) + ;; one new + one young + one future dormant = total 3, actionable 2 + (should (= 3 (plist-get counts :total))) + (should (= 2 actionable)))))) + +(provide 'test-org-drill-statistics-overview-counts) + +;;; test-org-drill-statistics-overview-counts.el ends here diff --git a/tests/test-org-drill-statistics-pass-rate-by-day.el b/tests/test-org-drill-statistics-pass-rate-by-day.el new file mode 100644 index 0000000..38f7ae3 --- /dev/null +++ b/tests/test-org-drill-statistics-pass-rate-by-day.el @@ -0,0 +1,200 @@ +;;; test-org-drill-statistics-pass-rate-by-day.el --- Tests for pass-rate-by-day statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard pass-rate-by-day block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +(defun test-org-drill-statistics--fixed-today (day) + "Install a stub for `org-drill-statistics--today-day' returning DAY. +Returns nothing useful, used for its side effect inside a fixture." + (advice-add 'org-drill-statistics--today-day :override + (lambda () day) '((name . test-fixed-today)))) + +(defun test-org-drill-statistics--clear-today () + "Remove the fixed-today stub installed by the helper above." + (advice-remove 'org-drill-statistics--today-day 'test-fixed-today)) + +(defun test-org-drill-statistics--record-on-day (day qualities) + "Build a session record started on absolute DAY with QUALITIES vector. +DAY is an absolute day number as from `time-to-days'. QUALITIES is a +vector of integer qualities. The start-time is the float-time at noon +of that day, so day bucketing is unambiguous." + (let ((start (+ (float-time + (encode-time 0 0 0 1 1 2000)) + (* (- day (time-to-days + (encode-time 0 0 0 1 1 2000))) + 86400) + (* 12 3600)))) + (make-org-drill-session-record + :start-time start + :end-time start + :scope 'directory + :algorithm 'sm5 + :qualities qualities + :pass-percent 0 + :new-count 0 + :mature-count 0 + :failed-count 0 + :cram-mode nil))) + +;; Normal: a multi-day log produces per-day pass rates in chronological +;; order, with the failure-quality threshold deciding pass vs fail. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-basic () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + ;; today: qualities 5 5 1 0 -> 2 pass of 4 -> 50 + ;; yesterday: qualities 4 3 -> 2 pass of 2 -> 100 + (let* ((log (list + (test-org-drill-statistics--record-on-day + today [5 5 1 0]) + (test-org-drill-statistics--record-on-day + (1- today) [4 3]))) + (v (org-drill-statistics--pass-rate-by-day log 3))) + (should (= (length v) 3)) + (should (null (aref v 0))) ; two days ago, no data + (should (= (aref v 1) 100)) ; yesterday + (should (= (aref v 2) 50)))) ; today + (test-org-drill-statistics--clear-today)))) + +;; Normal: multiple records on the same day aggregate together. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-same-day-merge () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + ;; today across two records: [5 1] and [4 0 2] + ;; passes: 5,4 -> 2 ; total 5 -> 40 + (let* ((log (list + (test-org-drill-statistics--record-on-day + today [5 1]) + (test-org-drill-statistics--record-on-day + today [4 0 2]))) + (v (org-drill-statistics--pass-rate-by-day log 1))) + (should (= (length v) 1)) + (should (= (aref v 0) 40)))) + (test-org-drill-statistics--clear-today)))) + +;; Boundary: empty log yields an all-nil vector of the requested length. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-empty-log () + (let ((today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + (let ((v (org-drill-statistics--pass-rate-by-day nil 5))) + (should (= (length v) 5)) + (should (cl-every #'null (append v nil))))) + (test-org-drill-statistics--clear-today)))) + +;; Boundary: a record outside the window is ignored; one at the oldest +;; edge of the window is counted at index 0. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-window-edges () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + (let* ((days 3) + (oldest (- today (1- days))) ; today-2 + (log (list + ;; just outside the window (too old): ignored + (test-org-drill-statistics--record-on-day + (1- oldest) [5 5]) + ;; oldest day in the window: index 0 + (test-org-drill-statistics--record-on-day + oldest [5 0]))) + (v (org-drill-statistics--pass-rate-by-day log days))) + (should (= (length v) days)) + (should (= (aref v 0) 50)) ; oldest in-window day + (should (null (aref v 1))) + (should (null (aref v 2))))) + (test-org-drill-statistics--clear-today)))) + +;; Boundary: a record dated in the future relative to today is ignored. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-future-ignored () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + (let* ((log (list + (test-org-drill-statistics--record-on-day + (1+ today) [5 5 5]))) + (v (org-drill-statistics--pass-rate-by-day log 3))) + (should (cl-every #'null (append v nil))))) + (test-org-drill-statistics--clear-today)))) + +;; Boundary: threshold edge. A quality equal to the threshold is a fail; +;; one above it is a pass. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-threshold-edge () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + ;; qualities 2 (fail) and 3 (pass) -> 1 of 2 -> 50 + (let* ((log (list + (test-org-drill-statistics--record-on-day + today [2 3]))) + (v (org-drill-statistics--pass-rate-by-day log 1))) + (should (= (aref v 0) 50)))) + (test-org-drill-statistics--clear-today)))) + +;; Boundary: a record whose qualities vector is empty contributes no +;; total, leaving that day as no-data rather than a division by zero. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-empty-qualities () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + (let* ((log (list + (test-org-drill-statistics--record-on-day + today []))) + (v (org-drill-statistics--pass-rate-by-day log 1))) + (should (null (aref v 0))))) + (test-org-drill-statistics--clear-today)))) + +;; Boundary: DAYS defaults to `org-drill-statistics-trend-days' when +;; omitted, and a non-positive DAYS is clamped to a length-1 vector. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-days-arg () + (let ((org-drill-statistics-trend-days 12) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + (should (= (length + (org-drill-statistics--pass-rate-by-day nil)) + 12)) + (should (= (length + (org-drill-statistics--pass-rate-by-day nil 0)) + 1))) + (test-org-drill-statistics--clear-today)))) + +;; Error: a nil qualities slot is tolerated as no-data, not a crash. +(ert-deftest test-org-drill-statistics-pass-rate-by-day-nil-qualities () + (let ((org-drill-failure-quality 2) + (today 700000)) + (unwind-protect + (progn + (test-org-drill-statistics--fixed-today today) + (let* ((rec (test-org-drill-statistics--record-on-day + today [5 5])) + (_ (setf (org-drill-session-record-qualities rec) nil)) + (v (org-drill-statistics--pass-rate-by-day + (list rec) 1))) + (should (null (aref v 0))))) + (test-org-drill-statistics--clear-today)))) + +(provide 'test-org-drill-statistics-pass-rate-by-day) + +;;; test-org-drill-statistics-pass-rate-by-day.el ends here diff --git a/tests/test-org-drill-statistics-primitives.el b/tests/test-org-drill-statistics-primitives.el new file mode 100644 index 0000000..2022e0d --- /dev/null +++ b/tests/test-org-drill-statistics-primitives.el @@ -0,0 +1,139 @@ +;;; test-org-drill-statistics-primitives.el --- Tests for primitives statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard primitives block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; Tests for statistics primitives. Require 'org-drill and 'cl-lib. +;;; Fixtures are deterministic: start-time values are fixed floats, and +;;; day numbers are derived, never hardcoded against today's date. + + +(defun test-org-drill-statistics--make-record (start-time algorithm) + "Build a minimal `org-drill-session-record' for tests. +START-TIME is a float; ALGORITHM is a symbol. Other slots get inert +placeholder values sufficient for the primitive under test." + (make-org-drill-session-record + :start-time start-time + :end-time (+ start-time 60.0) + :scope 'directory + :algorithm algorithm + :qualities (vector 5 4 3) + :pass-percent 67 + :new-count 1 + :mature-count 1 + :failed-count 1 + :cram-mode nil)) + +;;; org-drill-statistics--today-day + +(ert-deftest test-org-drill-statistics-today-day-matches-time-to-days () + "`--today-day' equals `time-to-days' of the current time." + (should (= (org-drill-statistics--today-day) + (time-to-days (current-time))))) + +(ert-deftest test-org-drill-statistics-today-day-redefinable () + "`--today-day' can be redefined to a fixed day for deterministic tests." + (cl-letf (((symbol-function 'org-drill-statistics--today-day) + (lambda () 700000))) + (should (= (org-drill-statistics--today-day) 700000)))) + +;;; org-drill-statistics--record-day + +(ert-deftest test-org-drill-statistics-record-day-derives-from-start-time () + "`--record-day' returns the day number of the record's start time." + (let* ((now (float-time)) + (record (test-org-drill-statistics--make-record now 'sm5))) + (should (= (org-drill-statistics--record-day record) + (time-to-days (seconds-to-time now)))))) + +(ert-deftest test-org-drill-statistics-record-day-earlier-is-smaller () + "A record started a day earlier has a day number one less." + (let* ((now (float-time)) + (today (test-org-drill-statistics--make-record now 'sm5)) + (yesterday (test-org-drill-statistics--make-record + (- now 86400.0) 'sm5))) + (should (= (- (org-drill-statistics--record-day today) + (org-drill-statistics--record-day yesterday)) + 1)))) + +;;; org-drill-statistics--filter-log + +(ert-deftest test-org-drill-statistics-filter-log-nil-returns-all () + "Filtering with nil algorithm returns the log unchanged." + (let ((log (list (test-org-drill-statistics--make-record 100.0 'sm5) + (test-org-drill-statistics--make-record 200.0 'simple8)))) + (should (equal (org-drill-statistics--filter-log log nil) log)))) + +(ert-deftest test-org-drill-statistics-filter-log-keeps-matching () + "Filtering keeps only records whose algorithm matches." + (let* ((a (test-org-drill-statistics--make-record 100.0 'sm5)) + (b (test-org-drill-statistics--make-record 200.0 'simple8)) + (c (test-org-drill-statistics--make-record 300.0 'sm5)) + (log (list a b c)) + (result (org-drill-statistics--filter-log log 'sm5))) + (should (equal result (list a c))))) + +(ert-deftest test-org-drill-statistics-filter-log-no-match-returns-empty () + "Filtering on an absent algorithm returns an empty list." + (let ((log (list (test-org-drill-statistics--make-record 100.0 'sm5)))) + (should (null (org-drill-statistics--filter-log log 'simple8))))) + +(ert-deftest test-org-drill-statistics-filter-log-empty-log () + "Filtering an empty log returns an empty list for any algorithm." + (should (null (org-drill-statistics--filter-log nil 'sm5))) + (should (null (org-drill-statistics--filter-log nil nil)))) + +(ert-deftest test-org-drill-statistics-filter-log-does-not-mutate () + "Filtering leaves the input list intact." + (let* ((log (list (test-org-drill-statistics--make-record 100.0 'sm5) + (test-org-drill-statistics--make-record 200.0 'simple8))) + (copy (copy-sequence log))) + (org-drill-statistics--filter-log log 'sm5) + (should (equal log copy)))) + +;;; org-drill-statistics--log-since + +(ert-deftest test-org-drill-statistics-log-since-keeps-at-or-after-cutoff () + "Records at or after the cutoff are kept; earlier ones dropped." + (let* ((before (test-org-drill-statistics--make-record 100.0 'sm5)) + (at (test-org-drill-statistics--make-record 200.0 'sm5)) + (after (test-org-drill-statistics--make-record 300.0 'sm5)) + (log (list before at after)) + (result (org-drill-statistics--log-since log 200.0))) + (should (equal result (list at after))))) + +(ert-deftest test-org-drill-statistics-log-since-all-before-cutoff () + "When every record predates the cutoff, the result is empty." + (let ((log (list (test-org-drill-statistics--make-record 100.0 'sm5) + (test-org-drill-statistics--make-record 150.0 'sm5)))) + (should (null (org-drill-statistics--log-since log 200.0))))) + +(ert-deftest test-org-drill-statistics-log-since-all-after-cutoff () + "When every record is at or after the cutoff, all are kept." + (let* ((log (list (test-org-drill-statistics--make-record 300.0 'sm5) + (test-org-drill-statistics--make-record 400.0 'sm5))) + (result (org-drill-statistics--log-since log 200.0))) + (should (equal result log)))) + +(ert-deftest test-org-drill-statistics-log-since-empty-log () + "Filtering an empty log by cutoff returns an empty list." + (should (null (org-drill-statistics--log-since nil 200.0)))) + +(ert-deftest test-org-drill-statistics-log-since-does-not-mutate () + "Cutoff filtering leaves the input list intact." + (let* ((log (list (test-org-drill-statistics--make-record 100.0 'sm5) + (test-org-drill-statistics--make-record 300.0 'sm5))) + (copy (copy-sequence log))) + (org-drill-statistics--log-since log 200.0) + (should (equal log copy)))) + +(provide 'test-org-drill-statistics-primitives) + +;;; test-org-drill-statistics-primitives.el ends here diff --git a/tests/test-org-drill-statistics-quality-histogram.el b/tests/test-org-drill-statistics-quality-histogram.el new file mode 100644 index 0000000..7a66314 --- /dev/null +++ b/tests/test-org-drill-statistics-quality-histogram.el @@ -0,0 +1,100 @@ +;;; test-org-drill-statistics-quality-histogram.el --- Tests for quality-histogram statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard quality-histogram block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +(defun test-org-drill-statistics--make-record (qualities) + "Build a minimal `org-drill-session-record' carrying QUALITIES. +QUALITIES is a vector of ints. Other slots are filled with inert +defaults so the histogram tests stay focused on the qualities slot." + (make-org-drill-session-record + :start-time 0.0 + :end-time 0.0 + :scope nil + :algorithm 'sm5 + :qualities qualities + :pass-percent 0 + :new-count 0 + :mature-count 0 + :failed-count 0 + :cram-mode nil)) + +;; Normal cases. + +(ert-deftest test-org-drill-statistics-quality-histogram-single-record () + "A single record's qualities are tallied into the right buckets." + (let* ((record (test-org-drill-statistics--make-record [0 3 3 5 3])) + (result (org-drill-statistics--quality-histogram (list record)))) + (should (equal result [1 0 0 3 0 1])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-multiple-records () + "Counts sum across every record in the log." + (let* ((r1 (test-org-drill-statistics--make-record [0 1 2])) + (r2 (test-org-drill-statistics--make-record [3 4 5])) + (r3 (test-org-drill-statistics--make-record [0 5 5])) + (result (org-drill-statistics--quality-histogram (list r1 r2 r3)))) + (should (equal result [2 1 1 1 1 3])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-all-same-quality () + "A record with every entry the same quality concentrates in one bucket." + (let* ((record (test-org-drill-statistics--make-record [4 4 4 4])) + (result (org-drill-statistics--quality-histogram (list record)))) + (should (equal result [0 0 0 0 4 0])))) + +;; Boundary cases. + +(ert-deftest test-org-drill-statistics-quality-histogram-empty-log () + "An empty log yields an all-zero histogram, never nil." + (let ((result (org-drill-statistics--quality-histogram '()))) + (should (equal result [0 0 0 0 0 0])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-empty-qualities () + "A record with an empty qualities vector contributes nothing." + (let* ((record (test-org-drill-statistics--make-record [])) + (result (org-drill-statistics--quality-histogram (list record)))) + (should (equal result [0 0 0 0 0 0])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-nil-qualities () + "A record whose qualities slot is nil is skipped without error." + (let* ((r1 (test-org-drill-statistics--make-record nil)) + (r2 (test-org-drill-statistics--make-record [2 2])) + (result (org-drill-statistics--quality-histogram (list r1 r2)))) + (should (equal result [0 0 2 0 0 0])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-extreme-buckets () + "Quality 0 and quality 5, the range endpoints, both land correctly." + (let* ((record (test-org-drill-statistics--make-record [0 0 5 5 5])) + (result (org-drill-statistics--quality-histogram (list record)))) + (should (equal result [2 0 0 0 0 3])))) + +;; Error cases. + +(ert-deftest test-org-drill-statistics-quality-histogram-out-of-range-ignored () + "Qualities outside 0..5 are dropped, valid ones still counted." + (let* ((record (test-org-drill-statistics--make-record [-1 6 3 99 2])) + (result (org-drill-statistics--quality-histogram (list record)))) + (should (equal result [0 0 1 1 0 0])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-non-integer-ignored () + "Non-integer quality entries are ignored rather than signalling." + (let* ((record (test-org-drill-statistics--make-record [2 nil 2.5 3])) + (result (org-drill-statistics--quality-histogram (list record)))) + (should (equal result [0 0 1 1 0 0])))) + +(ert-deftest test-org-drill-statistics-quality-histogram-does-not-mutate-input () + "The qualities vectors are read, never written." + (let* ((qualities (vector 1 2 3)) + (record (test-org-drill-statistics--make-record qualities))) + (org-drill-statistics--quality-histogram (list record)) + (should (equal qualities [1 2 3])))) + +(provide 'test-org-drill-statistics-quality-histogram) + +;;; test-org-drill-statistics-quality-histogram.el ends here diff --git a/tests/test-org-drill-statistics-render-attention.el b/tests/test-org-drill-statistics-render-attention.el new file mode 100644 index 0000000..b3f2375 --- /dev/null +++ b/tests/test-org-drill-statistics-render-attention.el @@ -0,0 +1,141 @@ +;;; test-org-drill-statistics-render-attention.el --- Tests for render-attention statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard render-attention block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; tests/test-org-drill-statistics-render-attention.el -*- lexical-binding: t; -*- + +(defun test-org-drill-stats--attn-fixture () + "Insert a fixture buffer of drill cards and return today's day number. +Twelve leech candidates so the cap and footer are exercised, plus one +long-overdue card and one forgotten-new card. Dates derive from the +current time so the fixture never hardcodes today." + (let* ((today (org-drill-statistics--today-day)) + (old-review (org-drill-time-to-inactive-org-timestamp + (org-time-string-to-time + (format-time-string + "%Y-%m-%d" + (time-subtract (current-time) + (days-to-time 400)))))) + (old-added (format-time-string + "%Y-%m-%d" + (time-subtract (current-time) (days-to-time 30))))) + (insert "* Drill cards\n") + (dotimes (i 12) + (insert (format "** Leech %02d :drill:\n" i)) + (insert ":PROPERTIES:\n") + (insert (format ":DRILL_FAILURE_COUNT: %d\n" + (+ org-drill-leech-failure-threshold 2))) + (insert (format ":DRILL_AVERAGE_QUALITY: %s\n" + (number-to-string (+ 1.0 (* 0.1 i))))) + (insert ":END:\n")) + (insert "** Overdue card :drill:\n") + (insert ":PROPERTIES:\n") + (insert (format ":DRILL_LAST_REVIEWED: %s\n" old-review)) + (insert ":DRILL_FAILURE_COUNT: 0\n") + (insert ":END:\n") + (insert "** Forgotten card :drill:\n") + (insert ":PROPERTIES:\n") + (insert (format ":DATE_ADDED: %s\n" old-added)) + (insert ":DRILL_TOTAL_REPEATS: 0\n") + (insert ":END:\n") + (org-mode) + today)) + +(ert-deftest test-org-drill-statistics-attention-section-heading () + "The rendered section opens with the Needs attention heading." + (with-temp-buffer + (test-org-drill-stats--attn-fixture) + (let ((out (org-drill-statistics--render-attention 'file))) + (should (string-match-p "^\\*\\* Needs attention$" out)) + (should (string-match-p "^\\*\\*\\* Leech candidates$" out)) + (should (string-match-p "^\\*\\*\\* Long overdue$" out)) + (should (string-match-p "^\\*\\*\\* Forgotten new$" out))))) + +(ert-deftest test-org-drill-statistics-attention-leech-rows-as-links () + "Leech candidates render as org links carrying card headings." + (with-temp-buffer + (test-org-drill-stats--attn-fixture) + (let ((out (org-drill-statistics--render-attention 'file))) + (should (string-match-p "| Card |" out)) + (should (string-match-p "\\[\\[org-drill-card:[0-9]+\\]\\[Leech 00\\]\\]" + out))))) + +(ert-deftest test-org-drill-statistics-attention-cap-and-footer () + "Twelve leeches over a 10 cap show 10 rows and a +2 more footer." + (with-temp-buffer + (test-org-drill-stats--attn-fixture) + (let* ((org-drill-statistics-attention-row-limit 10) + (out (org-drill-statistics--render-attention 'file)) + (link-count + (cl-count ?\n + (mapconcat #'identity + (seq-filter + (lambda (l) (string-match-p "org-drill-card:" l)) + (split-string out "\n")) + "\n")))) + (should (string-match-p "+2 more" out)) + ;; 10 leech (capped) + 1 overdue + 1 forgotten = 12 link rows. + (should (= 12 (1+ link-count)))))) + +(ert-deftest test-org-drill-statistics-attention-leech-sort-worst-first () + "Leech rows are ordered by ascending average quality, worst first." + (with-temp-buffer + (test-org-drill-stats--attn-fixture) + (let* ((out (org-drill-statistics--render-attention 'file)) + (leech-00 (string-match "Leech 00" out)) + (leech-01 (string-match "Leech 01" out))) + (should leech-00) + (should leech-01) + ;; Leech 00 has avg 1.0, Leech 01 has 1.1, so 00 sorts first. + (should (< leech-00 leech-01))))) + +(ert-deftest test-org-drill-statistics-attention-empty-category-note () + "A category with no matches renders a note rather than a table." + (with-temp-buffer + (insert "* Cards\n** Healthy :drill:\n:PROPERTIES:\n") + (insert ":DRILL_FAILURE_COUNT: 0\n:DRILL_TOTAL_REPEATS: 5\n:END:\n") + (org-mode) + (let ((out (org-drill-statistics--render-attention 'file))) + (should (string-match-p "No leech candidates\\." out)) + (should (string-match-p "No long-overdue cards\\." out)) + (should (string-match-p "No forgotten-new cards\\." out))))) + +(ert-deftest test-org-drill-statistics-attention-no-footer-under-cap () + "With matches at or under the cap, no +N more footer appears." + (with-temp-buffer + (insert "* Cards\n") + (dotimes (i 3) + (insert (format "** Leech %d :drill:\n" i)) + (insert ":PROPERTIES:\n") + (insert (format ":DRILL_FAILURE_COUNT: %d\n" + (+ org-drill-leech-failure-threshold 1))) + (insert ":DRILL_AVERAGE_QUALITY: 1.0\n:END:\n")) + (org-mode) + (let* ((org-drill-statistics-attention-row-limit 10) + (out (org-drill-statistics--render-attention 'file))) + (should-not (string-match-p "more" out))))) + +(ert-deftest test-org-drill-statistics-card-link-sanitizes-brackets () + "Closing brackets in a heading cannot terminate the link early." + (let ((link (org-drill-statistics--card-link "a]] b" 42))) + (should (string-prefix-p "[[org-drill-card:42][" link)) + (should (string-suffix-p "]]" link)) + (should-not (string-match-p "a]] b" link)))) + +(ert-deftest test-org-drill-statistics-card-link-empty-heading-fallback () + "An empty heading falls back to a position-based description." + (let ((link (org-drill-statistics--card-link "" 99))) + (should (string-match-p "\\[\\[org-drill-card:99\\]\\[card at 99\\]\\]" + link)))) + +(provide 'test-org-drill-statistics-render-attention) + +;;; test-org-drill-statistics-render-attention.el ends here diff --git a/tests/test-org-drill-statistics-render-forecast.el b/tests/test-org-drill-statistics-render-forecast.el new file mode 100644 index 0000000..8001d68 --- /dev/null +++ b/tests/test-org-drill-statistics-render-forecast.el @@ -0,0 +1,131 @@ +;;; test-org-drill-statistics-render-forecast.el --- Tests for render-forecast statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard render-forecast block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +(defun test-org-drill-statistics--make-record + (start-day-offset &optional qualities) + "Build an `org-drill-session-record' START-DAY-OFFSET days from now. +QUALITIES defaults to a single passing quality. Helper for forecast +render tests, though the forecast itself reads org entries, not the log; +kept minimal and self-contained." + (let ((start (float-time + (time-add (current-time) + (days-to-time start-day-offset))))) + (make-org-drill-session-record + :start-time start + :end-time (+ start 60.0) + :scope 'file + :algorithm 'sm5 + :qualities (or qualities (vector 5)) + :pass-percent 100 + :new-count 0 + :mature-count 0 + :failed-count 0 + :cram-mode nil))) + +(ert-deftest test-org-drill-statistics-render-forecast-has-subheading () + "The rendered section starts with the Forecast subheading." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&rest _) '(0 0 0 0 0 0 0)))) + (let ((out (org-drill-statistics--render-forecast))) + (should (string-prefix-p "** Forecast\n" out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-header-labels () + "The header row labels Today and the +1..+6 offsets in order." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&rest _) '(0 0 0 0 0 0 0)))) + (let ((out (org-drill-statistics--render-forecast))) + (should (string-match-p + "| Today | \\+1 | \\+2 | \\+3 | \\+4 | \\+5 | \\+6 |" + out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-counts-row () + "The counts row reflects the forecast helper's per-day values." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&rest _) '(3 1 0 5 0 2 4)))) + (let ((out (org-drill-statistics--render-forecast))) + (should (string-match-p "| 3 | 1 | 0 | 5 | 0 | 2 | 4 |" out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-trailing-newline () + "The section ends with a newline so sections concatenate cleanly." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&rest _) '(0 0 0 0 0 0 0)))) + (let ((out (org-drill-statistics--render-forecast))) + (should (string-suffix-p "\n" out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-honors-days () + "A custom DAYS yields a header and row sized to the forecast length." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&optional _scope _days) '(2 7 1)))) + (let ((out (org-drill-statistics--render-forecast nil 3))) + (should (string-match-p "| Today | \\+1 | \\+2 |" out)) + (should (string-match-p "| 2 | 7 | 1 |" out)) + ;; No fourth column should appear. + (should-not (string-match-p "\\+3" out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-empty-window () + "A zero-length forecast renders a note instead of a table." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&rest _) '()))) + (let ((out (org-drill-statistics--render-forecast nil 0))) + (should (string-prefix-p "** Forecast\n" out)) + (should (string-match-p "No forecast window configured." out)) + (should-not (string-match-p "|" out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-single-day () + "A one-day forecast renders just the Today column." + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&rest _) '(9))) + (org-drill-statistics-forecast-days 1)) + (let ((out (org-drill-statistics--render-forecast))) + (should (string-match-p "| Today |" out)) + (should (string-match-p "| 9 |" out)) + (should-not (string-match-p "\\+1" out))))) + +(ert-deftest test-org-drill-statistics-render-forecast-default-days () + "With no DAYS argument the section spans the configured default." + (let ((org-drill-statistics-forecast-days 7)) + (cl-letf (((symbol-function 'org-drill-statistics--forecast) + (lambda (&optional _scope days) + ;; Echo the resolved day count as a flat list so the + ;; renderer's column count is observable. + (make-list (or days org-drill-statistics-forecast-days) + 0)))) + (let ((out (org-drill-statistics--render-forecast))) + (should (string-match-p "\\+6 |" out)) + (should-not (string-match-p "\\+7" out)))))) + +(ert-deftest test-org-drill-statistics-render-forecast-with-scope-buffer () + "End to end through the real forecast helper against a temp org buffer. +Two cards are scheduled today and one is scheduled three days out; the +rendered counts row must reflect that bucketing." + (let ((today (format-time-string "%Y-%m-%d" (current-time))) + (plus3 (format-time-string + "%Y-%m-%d" (time-add (current-time) (days-to-time 3))))) + (with-temp-buffer + ;; Cards carry the drill tag and put SCHEDULED right after the + ;; heading so the traversal sees them; scope is 'file (a buffer + ;; list would be read as a list of file paths and fail). + (insert (format "* Drill cards\n")) + (insert (format "** Card one :drill:\nSCHEDULED: <%s>\n:PROPERTIES:\n:DRILL_CARD_TYPE: simple\n:END:\nfront\n" today)) + (insert (format "** Card two :drill:\nSCHEDULED: <%s>\n:PROPERTIES:\n:DRILL_CARD_TYPE: simple\n:END:\nfront\n" today)) + (insert (format "** Card three :drill:\nSCHEDULED: <%s>\n:PROPERTIES:\n:DRILL_CARD_TYPE: simple\n:END:\nfront\n" plus3)) + (org-mode) + (let* ((org-drill-scope 'file) + (org-drill-question-tag "drill") + (org-drill-match nil) + (out (org-drill-statistics--render-forecast 'file 7))) + ;; Today column = 2, +3 column = 1, others 0. + (should (string-match-p "| 2 | 0 | 0 | 1 | 0 | 0 | 0 |" out)))))) + +(provide 'test-org-drill-statistics-render-forecast) + +;;; test-org-drill-statistics-render-forecast.el ends here diff --git a/tests/test-org-drill-statistics-render-overview.el b/tests/test-org-drill-statistics-render-overview.el new file mode 100644 index 0000000..05cb166 --- /dev/null +++ b/tests/test-org-drill-statistics-render-overview.el @@ -0,0 +1,106 @@ +;;; test-org-drill-statistics-render-overview.el --- Tests for render-overview statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard render-overview block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +(defun test-org-drill-statistics--overview-record (start end qualities pass) + "Build a session record fixture for overview renderer tests. +START and END are floats; QUALITIES a vector of ints; PASS an int." + (make-org-drill-session-record + :start-time start + :end-time end + :scope 'file + :algorithm 'sm5 + :qualities qualities + :pass-percent pass + :new-count 0 + :mature-count 0 + :failed-count 0 + :cram-mode nil)) + +(ert-deftest test-org-drill-statistics-overview-table-row () + "Overview renders the header and a data row from the scope counts." + (cl-letf (((symbol-function 'org-drill-statistics--overview-counts) + (lambda (&optional _scope) + (list :total 42 :new 7 :mature 30 :lapsed 5)))) + (let ((out (org-drill-statistics--render-overview nil nil))) + (should (string-match-p "\\*\\* Overview" out)) + (should (string-match-p + "| Total cards | New | Mature | Lapsed |" out)) + (should (string-match-p "| 42 | 7 | 30 | 5 |" out))))) + +(ert-deftest test-org-drill-statistics-overview-last-session-recap () + "The recap line reports date, duration, card count, and pass percent." + (cl-letf (((symbol-function 'org-drill-statistics--overview-counts) + (lambda (&optional _scope) + (list :total 1 :new 1 :mature 0 :lapsed 0)))) + ;; 2026-05-15 12:00:00 local, 15 minutes long, 3 cards, 67% pass. + (let* ((start (float-time (encode-time 0 0 12 15 5 2026))) + (end (+ start (* 15 60))) + (record (test-org-drill-statistics--overview-record + start end (vector 4 4 1) 67)) + (out (org-drill-statistics--render-overview nil (list record)))) + (should (string-match-p "Last session: 2026-05-15" out)) + (should (string-match-p "15 min" out)) + (should (string-match-p "3 cards reviewed" out)) + (should (string-match-p "67% pass" out))))) + +(ert-deftest test-org-drill-statistics-overview-singular-card () + "A one-card session uses the singular \"card\" in the recap." + (cl-letf (((symbol-function 'org-drill-statistics--overview-counts) + (lambda (&optional _scope) + (list :total 1 :new 0 :mature 1 :lapsed 0)))) + (let* ((start (float-time (encode-time 0 0 9 1 1 2026))) + (end (+ start 60.0)) + (record (test-org-drill-statistics--overview-record + start end (vector 5) 100)) + (out (org-drill-statistics--render-overview nil (list record)))) + (should (string-match-p "1 card reviewed" out)) + (should-not (string-match-p "1 cards reviewed" out))))) + +(ert-deftest test-org-drill-statistics-overview-empty-log () + "With no logged sessions the recap states none recorded." + (cl-letf (((symbol-function 'org-drill-statistics--overview-counts) + (lambda (&optional _scope) + (list :total 0 :new 0 :mature 0 :lapsed 0)))) + ;; Bind the persistent log to empty so a nil LOG arg resolves to an + ;; empty log rather than falling back to whatever sessions the + ;; running Emacs has persisted. + (let* ((org-drill-session-log nil) + (out (org-drill-statistics--render-overview nil nil))) + (should (string-match-p "Last session: none recorded yet" out)) + (should (string-match-p "| 0 | 0 | 0 | 0 |" out))))) + +(ert-deftest test-org-drill-statistics-overview-scope-traversal () + "Counts come from the org buffer in scope via the real aggregator. +Components integrated: +- org-drill-statistics--render-overview (entry point, real) +- org-drill-statistics--overview-counts (real, traverses the buffer) +- org-drill-entry-status / org-drill-session (real) +Validates the renderer threads SCOPE through to a live org traversal +rather than relying on a stub." + (with-temp-buffer + ;; The card must carry the drill question tag, otherwise + ;; `org-drill-map-entries' skips it and the population is zero. + (insert "* Cards\n" + "** Card one :drill:\n" + ":PROPERTIES:\n:DRILL_CARD_TYPE: simple\n:END:\n" + "Front\n") + (org-mode) + (let* ((org-drill-scope 'file) + (org-drill-question-tag "drill") + (org-drill-match nil) + (out (org-drill-statistics--render-overview 'file nil))) + ;; One genuine drill card, never reviewed, so total and new are 1. + (should (string-match-p "| 1 | 1 | 0 | 0 |" out))))) + +(provide 'test-org-drill-statistics-render-overview) + +;;; test-org-drill-statistics-render-overview.el ends here diff --git a/tests/test-org-drill-statistics-render-trends.el b/tests/test-org-drill-statistics-render-trends.el new file mode 100644 index 0000000..bf50b83 --- /dev/null +++ b/tests/test-org-drill-statistics-render-trends.el @@ -0,0 +1,129 @@ +;;; test-org-drill-statistics-render-trends.el --- Tests for render-trends statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard render-trends block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; Tests for the Trends render helper (render 2/5). + + +(defun org-drill-statistics-test--record (start-day-offset qualities + &optional duration-min) + "Build an `org-drill-session-record' for trends tests. +START-DAY-OFFSET is an integer day offset from today (0 is today, -7 is +a week ago). QUALITIES is a list of int qualities, stored as a vector. +DURATION-MIN defaults to 10 minutes. The record's start-time and +end-time floats land on the requested day; only the day component is +load bearing for these tests." + (let* ((duration (or duration-min 10)) + (today-secs (float-time (current-time))) + (start (+ today-secs (* start-day-offset 86400.0))) + (end (+ start (* duration 60.0)))) + (make-org-drill-session-record + :start-time start + :end-time end + :scope 'file + :algorithm 'sm5 + :qualities (vconcat qualities) + :pass-percent (org-drill--compute-pass-percent (vconcat qualities)) + :new-count 0 + :mature-count (length qualities) + :failed-count 0 + :cram-mode nil))) + +(ert-deftest test-org-drill-statistics-render-trends-has-subheading () + "The rendered section opens with the \"* Trends\" org subheading." + (let ((out (org-drill-statistics--render-trends nil))) + (should (string-prefix-p "* Trends\n" out)))) + +(ert-deftest test-org-drill-statistics-render-trends-empty-log () + "An empty log still renders both sparkline lines and a table header. +The sparklines are all-space (no data) and the table has only its header +and separator rows." + (let ((out (org-drill-statistics--render-trends nil))) + (should (string-match-p "Reviews/day (last 90):" out)) + (should (string-match-p "Pass rate/day (last 90):" out)) + (should (string-match-p "| Week | Reviews | Pass % | Avg min |" out)) + (should (string-match-p "|------" out)))) + +(ert-deftest test-org-drill-statistics-render-trends-sparkline-glyph () + "A record today puts a non-space block glyph in the reviews sparkline. +The final sparkline column (today) must be a quadrant block, not the +space rendered for empty days." + (let* ((log (list (org-drill-statistics-test--record 0 '(5 4 3)))) + (out (org-drill-statistics--render-trends log)) + (line (car (seq-filter + (lambda (l) (string-prefix-p "Reviews/day" l)) + (split-string out "\n"))))) + ;; The sparkline glyph for the busiest day is the full block, since + ;; today is the only day with data so it scales to the ceiling. + (should (string-match-p "█" line)))) + +(ert-deftest test-org-drill-statistics-render-trends-weekly-row () + "A this-week session produces a body row with its counts. +The row carries the Monday date of this week, the review count, the +pass percentage, and a one-decimal average duration." + (let* ((today (time-to-days (current-time))) + (week-start (org-drill-statistics--week-start-day today)) + (expected-date (org-drill-statistics--format-week-start week-start)) + ;; Three qualities, two passes (> failure-quality default 2). + (log (list (org-drill-statistics-test--record 0 '(5 4 1) 20))) + (out (org-drill-statistics--render-trends log))) + ;; Pass percent: 2 of 3 -> 67. Avg duration: 20.0 minutes. + (should (string-match-p + (regexp-quote (format "| %s | 3 | 67 | 20.0 |" expected-date)) + out)))) + +(ert-deftest test-org-drill-statistics-render-trends-twelve-week-rows () + "The table body has exactly 12 week rows, one per week in the window." + (let* ((out (org-drill-statistics--render-trends nil)) + (lines (split-string out "\n" t)) + (body (seq-filter + (lambda (l) + (and (string-prefix-p "| " l) + (not (string-match-p "Week" l)))) + lines))) + (should (= (length body) 12)))) + +(ert-deftest test-org-drill-statistics-render-trends-algorithm-filter () + "Passing an algorithm filters records out of the aggregates. +A record under `sm5' is excluded when the section filters for `sm2', +leaving an empty (all-zero) this-week row." + (let* ((today (time-to-days (current-time))) + (week-start (org-drill-statistics--week-start-day today)) + (date (org-drill-statistics--format-week-start week-start)) + (log (list (org-drill-statistics-test--record 0 '(5 4 3) 15))) + (out (org-drill-statistics--render-trends log 'sm2))) + ;; sm5 record is filtered out, so this week's row is zeroed. + (should (string-match-p + (regexp-quote (format "| %s | 0 | 0 | 0.0 |" date)) + out)) + ;; And the unfiltered render keeps it. + (let ((unfiltered (org-drill-statistics--render-trends log))) + (should (string-match-p + (regexp-quote (format "| %s | 3 |" date)) + unfiltered))))) + +(ert-deftest test-org-drill-statistics-render-trends-pass-rate-absolute-scale () + "The pass-rate sparkline scales against 100, not the window peak. +A day with a 50 percent pass rate must render a mid-height glyph, not +the full block it would reach if scaled to its own maximum." + (let* ((log (list (org-drill-statistics-test--record 0 '(5 1)))) + (out (org-drill-statistics--render-trends log)) + (line (car (seq-filter + (lambda (l) (string-prefix-p "Pass rate/day" l)) + (split-string out "\n"))))) + ;; 1 pass of 2 -> 50 percent. Scaled to 100 over an 8-glyph charset, + ;; round(50/100 * 7) = 4 -> the 5th glyph, not the full block. + (should-not (string-match-p "█" line)) + (should (string-match-p "▅" line)))) + +(provide 'test-org-drill-statistics-render-trends) + +;;; test-org-drill-statistics-render-trends.el ends here diff --git a/tests/test-org-drill-statistics-reviews-by-day.el b/tests/test-org-drill-statistics-reviews-by-day.el new file mode 100644 index 0000000..94b5aa2 --- /dev/null +++ b/tests/test-org-drill-statistics-reviews-by-day.el @@ -0,0 +1,111 @@ +;;; test-org-drill-statistics-reviews-by-day.el --- Tests for reviews-by-day statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard reviews-by-day block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;; Shared fixture: build a session record whose start day is a fixed +;; offset from today, so `org-drill-statistics--record-day' maps it +;; back to the intended absolute day without depending on a literal +;; date. The start-time is noon local time on that calendar day, which +;; keeps `time-to-days' off any DST or midnight boundary. + +(defun org-drill-statistics-test--record-at (day-offset n-qualities) + "Build a session record starting DAY-OFFSET days before today. +The start-time is noon local time on that calendar day, so +`org-drill-statistics--record-day' maps it back to the intended day. +N-QUALITIES sets the length of the qualities vector, the review count +the record contributes; 0 yields an empty vector." + (let* ((target-day (- (org-drill-statistics--today-day) day-offset)) + (greg (calendar-gregorian-from-absolute target-day)) + (ts (encode-time 0 0 12 (nth 1 greg) (nth 0 greg) (nth 2 greg)))) + (make-org-drill-session-record + :start-time (float-time ts) + :qualities (make-vector n-qualities 3)))) + +;; Normal cases + +(ert-deftest test-org-drill-statistics-reviews-by-day-normal-counts-per-day () + "Reviews land in the correct oldest-to-newest slots by start day." + (let ((v (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 0 2) + (org-drill-statistics-test--record-at 1 3) + (org-drill-statistics-test--record-at 6 1)) + 7))) + (should (= (length v) 7)) + (should (= (aref v 6) 2)) + (should (= (aref v 5) 3)) + (should (= (aref v 0) 1)) + (should (= (apply #'+ (append v nil)) 6)))) + +(ert-deftest test-org-drill-statistics-reviews-by-day-normal-same-day-accumulates () + "Multiple records on the same day sum their quality counts." + (let ((v (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 0 2) + (org-drill-statistics-test--record-at 0 3)) + 3))) + (should (= (aref v 2) 5)))) + +(ert-deftest test-org-drill-statistics-reviews-by-day-normal-default-days () + "Omitting DAYS uses `org-drill-statistics-trend-days' for the length." + (let ((org-drill-statistics-trend-days 30)) + (should (= (length (org-drill-statistics--reviews-by-day nil)) 30)))) + +;; Boundary cases + +(ert-deftest test-org-drill-statistics-reviews-by-day-boundary-empty-log () + "An empty log yields an all-zero vector of the requested length." + (let ((v (org-drill-statistics--reviews-by-day nil 5))) + (should (= (length v) 5)) + (should (= (apply #'+ (append v nil)) 0)))) + +(ert-deftest test-org-drill-statistics-reviews-by-day-boundary-single-day () + "DAYS of 1 yields a one-slot vector holding today's count." + (let ((v (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 0 4)) 1))) + (should (= (length v) 1)) + (should (= (aref v 0) 4)))) + +(ert-deftest test-org-drill-statistics-reviews-by-day-boundary-edges-of-window () + "The oldest in-window day fills slot 0; one day older is dropped." + (let ((v (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 6 2) + (org-drill-statistics-test--record-at 7 9)) + 7))) + (should (= (aref v 0) 2)) + (should (= (apply #'+ (append v nil)) 2)))) + +(ert-deftest test-org-drill-statistics-reviews-by-day-boundary-empty-qualities () + "A record with an empty qualities vector contributes zero." + (let ((v (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 0 0)) 3))) + (should (= (apply #'+ (append v nil)) 0)))) + +;; Error cases + +(ert-deftest test-org-drill-statistics-reviews-by-day-error-future-record-ignored () + "A record dated in the future falls outside the window and is ignored." + (let ((v (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at -3 5)) 7))) + (should (= (apply #'+ (append v nil)) 0)))) + +(ert-deftest test-org-drill-statistics-reviews-by-day-error-nonpositive-days-clamped () + "DAYS of 0 or negative is clamped to a single today slot." + (let ((v0 (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 0 2)) 0)) + (vn (org-drill-statistics--reviews-by-day + (list (org-drill-statistics-test--record-at 0 3)) -5))) + (should (= (length v0) 1)) + (should (= (aref v0 0) 2)) + (should (= (length vn) 1)) + (should (= (aref vn 0) 3)))) + +(provide 'test-org-drill-statistics-reviews-by-day) + +;;; test-org-drill-statistics-reviews-by-day.el ends here diff --git a/tests/test-org-drill-statistics-shell.el b/tests/test-org-drill-statistics-shell.el new file mode 100644 index 0000000..a4492d5 --- /dev/null +++ b/tests/test-org-drill-statistics-shell.el @@ -0,0 +1,153 @@ +;;; test-org-drill-statistics-shell.el --- Tests for shell statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard shell block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; Tests for the statistics dashboard shell (step 2). + + +(defun org-drill-statistics-test--record (start-offset-days algorithm qualities) + "Build a session record START-OFFSET-DAYS before now. +ALGORITHM is the algorithm symbol. QUALITIES is a vector of int. The +session lasts ten minutes. Offsets are relative to `current-time' so the +fixture never hardcodes a date." + (let* ((start (- (float-time) (* start-offset-days 86400.0))) + (end (+ start 600.0))) + (make-org-drill-session-record + :start-time start + :end-time end + :scope 'file + :algorithm algorithm + :qualities qualities + :pass-percent 50 + :new-count 1 + :mature-count 2 + :failed-count 0 + :cram-mode nil))) + +(ert-deftest test-org-drill-statistics-shell-range-cutoff-known-label () + "A range preset with a day count yields a cutoff that many days back." + (let ((now (float-time))) + (let ((cutoff (org-drill-statistics--range-cutoff-float "last 7d"))) + (should cutoff) + ;; Cutoff is roughly seven days before now, within a generous slop. + (should (< (abs (- cutoff (- now (* 7 86400.0)))) 5.0))))) + +(ert-deftest test-org-drill-statistics-shell-range-cutoff-all-time-nil () + "The all-time preset (nil days) yields no cutoff." + (should (null (org-drill-statistics--range-cutoff-float "all time"))) + (should (null (org-drill-statistics--range-cutoff-float "no such label")))) + +(ert-deftest test-org-drill-statistics-shell-filtered-log-by-algorithm () + "Filtering the log by algorithm keeps only matching records." + (let ((org-drill-session-log + (list (org-drill-statistics-test--record 1 'simple8 [4 5]) + (org-drill-statistics-test--record 2 'sm5 [3 2])))) + (let ((only-sm5 (org-drill-statistics--filtered-log "all time" 'sm5))) + (should (= 1 (length only-sm5))) + (should (eq 'sm5 (org-drill-session-record-algorithm + (car only-sm5))))) + (should (= 2 (length (org-drill-statistics--filtered-log + "all time" nil)))))) + +(ert-deftest test-org-drill-statistics-shell-filtered-log-by-range () + "An old record falls outside a short range window." + (let ((org-drill-session-log + (list (org-drill-statistics-test--record 1 'simple8 [4]) + (org-drill-statistics-test--record 40 'simple8 [3])))) + (should (= 1 (length (org-drill-statistics--filtered-log + "last 7d" nil)))) + (should (= 2 (length (org-drill-statistics--filtered-log + "last 90d" nil)))))) + +(ert-deftest test-org-drill-statistics-shell-header-line-format () + "The header line names all three active filters." + (let ((line (org-drill-statistics--header-line 'file "last 90d" 'simple8))) + (should (string-match-p "Scope: file" line)) + (should (string-match-p "Range: last 90d" line)) + (should (string-match-p "Algorithm: simple8" line))) + ;; nil scope falls back to org-drill-scope, nil algorithm reads "all". + (let* ((org-drill-scope 'directory) + (line (org-drill-statistics--header-line nil "last 7d" nil))) + (should (string-match-p "Scope: directory" line)) + (should (string-match-p "Algorithm: all" line)))) + +(ert-deftest test-org-drill-statistics-shell-cycle-range-wraps () + "Cycling range advances through presets and wraps to the first." + (with-temp-buffer + (let ((org-drill-statistics-range-presets + '(("last 90d" . 90) ("last 30d" . 30) ("all time" . nil))) + ;; Stub the in-place re-render so the cycle command stays pure + ;; with respect to buffer contents and the renderers. + (org-drill-session-log nil)) + (cl-letf (((symbol-function 'org-drill-statistics-refresh) + (lambda () nil))) + (setq org-drill-statistics--range "last 90d") + (org-drill-statistics-cycle-range) + (should (equal "last 30d" org-drill-statistics--range)) + (org-drill-statistics-cycle-range) + (should (equal "all time" org-drill-statistics--range)) + (org-drill-statistics-cycle-range) + (should (equal "last 90d" org-drill-statistics--range)))))) + +(ert-deftest test-org-drill-statistics-shell-cycle-algorithm-from-log () + "Cycling algorithm walks nil then each algorithm seen in the log." + (with-temp-buffer + (let ((org-drill-session-log + (list (org-drill-statistics-test--record 1 'simple8 [4]) + (org-drill-statistics-test--record 2 'sm5 [3])))) + (cl-letf (((symbol-function 'org-drill-statistics-refresh) + (lambda () nil))) + (setq org-drill-statistics--algorithm nil) + (org-drill-statistics-cycle-algorithm) + (should (memq org-drill-statistics--algorithm '(simple8 sm5))) + (org-drill-statistics-cycle-algorithm) + (should (memq org-drill-statistics--algorithm '(simple8 sm5))) + ;; Third cycle wraps back to all-algorithms (nil). + (org-drill-statistics-cycle-algorithm) + (should (null org-drill-statistics--algorithm)))))) + +(ert-deftest test-org-drill-statistics-shell-integration-assembles-sections () + "The assembled dashboard body contains every section's output. +Components integrated: +- org-drill-statistics--render-all (entry point, real) +- the five org-drill-statistics--render-* helpers (real) +- org-drill-session-log fixture (real, let-bound) +The card-scanning helpers are exercised against an empty current buffer, +so the card population is zero, but every section header must still +appear in the assembled string." + (with-temp-buffer + (org-mode) + (let ((org-drill-session-log + (list (org-drill-statistics-test--record 1 'simple8 [4 5 2]) + (org-drill-statistics-test--record 3 'simple8 [3 4]) + (org-drill-statistics-test--record 8 'sm5 [5 5 1])))) + ;; Use 'file scope: the buffer has no headline, and 'tree errors + ;; when point is before the first headline. 'file scans the + ;; whole (empty) buffer and yields a zero card population. + (let ((body (org-drill-statistics--render-all + 'file (caar org-drill-statistics-range-presets) nil))) + (should (stringp body)) + ;; The header line is always present. + (should (string-match-p "Scope:" body)) + (should (string-match-p "Range:" body)) + (should (string-match-p "Algorithm:" body)) + ;; Each render section contributes recognizable text. The exact + ;; header wording lives in the render helpers; assert on the + ;; section keywords the spec fixes rather than full prose. + (should (string-match-p "[Oo]verview" body)) + (should (string-match-p "[Tt]rend" body)) + (should (string-match-p "[Dd]istribution" body)) + (should (string-match-p "[Aa]ttention" body)) + (should (string-match-p "[Ff]orecast" body)))))) + +(provide 'test-org-drill-statistics-shell) + +;;; test-org-drill-statistics-shell.el ends here diff --git a/tests/test-org-drill-statistics-sparkline.el b/tests/test-org-drill-statistics-sparkline.el new file mode 100644 index 0000000..ae1f5c0 --- /dev/null +++ b/tests/test-org-drill-statistics-sparkline.el @@ -0,0 +1,84 @@ +;;; test-org-drill-statistics-sparkline.el --- Tests for sparkline statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard sparkline block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +(ert-deftest test-org-drill-statistics-sparkline-empty () + "An empty sequence renders as the empty string." + (should (equal (org-drill-statistics--sparkline '()) "")) + (should (equal (org-drill-statistics--sparkline []) ""))) + +(ert-deftest test-org-drill-statistics-sparkline-single-value () + "A single positive value renders as the full block. +With a one-element sequence and no explicit MAX, the value equals the +derived max and maps to the tallest glyph." + (should (equal (org-drill-statistics--sparkline '(5)) "█"))) + +(ert-deftest test-org-drill-statistics-sparkline-single-zero () + "A single zero value renders as the lowest block, not an error. +The derived max is zero, so the all-zero branch applies." + (should (equal (org-drill-statistics--sparkline '(0)) "▁"))) + +(ert-deftest test-org-drill-statistics-sparkline-all-equal () + "All-equal positive values all render as the full block. +Each value equals the derived max, so every glyph is the tallest." + (should (equal (org-drill-statistics--sparkline '(3 3 3 3)) "████"))) + +(ert-deftest test-org-drill-statistics-sparkline-all-zero () + "All-zero values render as the lowest block, one per entry. +Max is zero, so the division-by-zero guard returns the lowest glyph for +every value instead of erroring." + (should (equal (org-drill-statistics--sparkline '(0 0 0)) "▁▁▁"))) + +(ert-deftest test-org-drill-statistics-sparkline-known-ramp () + "A 0..7 ramp against MAX 7 maps to each glyph in order. +With value I and MAX 7, the index is (round (* (/ I 7.0) 7)) = I, so the +ramp walks the charset from lowest to highest exactly once." + (should (equal (org-drill-statistics--sparkline '(0 1 2 3 4 5 6 7) 7) + "▁▂▃▄▅▆▇█"))) + +(ert-deftest test-org-drill-statistics-sparkline-nil-entries () + "Nil entries render as spaces and do not affect the derived max. +The values 1 and 2 against derived max 2 scale to indices 4 (1/2*7 +rounds to 4) and 7." + (should (equal (org-drill-statistics--sparkline '(nil 1 nil 2 nil)) + " ▅ █ "))) + +(ert-deftest test-org-drill-statistics-sparkline-all-nil () + "An all-nil sequence renders as one space per entry." + (should (equal (org-drill-statistics--sparkline '(nil nil nil)) " "))) + +(ert-deftest test-org-drill-statistics-sparkline-explicit-max () + "An explicit MAX scales values against it, not the sequence max. +With MAX 10, value 10 is the full block, 0 is the lowest, and 5 scales +to 5/10*7 = 3.5 which rounds to index 4." + (should (equal (org-drill-statistics--sparkline '(0 5 10) 10) "▁▅█"))) + +(ert-deftest test-org-drill-statistics-sparkline-explicit-zero-max () + "An explicit MAX of zero renders every value as the lowest block. +The guard treats a zero ceiling like the all-zero case rather than +dividing by zero." + (should (equal (org-drill-statistics--sparkline '(0 1 2) 0) "▁▁▁"))) + +(ert-deftest test-org-drill-statistics-sparkline-value-above-max () + "A value exceeding MAX clamps to the full block instead of overflowing. +Without the clamp the computed index would exceed the charset length. +The 5 scales to 5/10*7 = 3.5 which rounds to index 4." + (should (equal (org-drill-statistics--sparkline '(20) 10) "█")) + (should (equal (org-drill-statistics--sparkline '(5 20) 10) "▅█"))) + +(ert-deftest test-org-drill-statistics-sparkline-vector-input () + "A vector argument is accepted and rendered like a list. +The helper coerces any sequence, so callers may pass either." + (should (equal (org-drill-statistics--sparkline [0 7] 7) "▁█"))) + +(provide 'test-org-drill-statistics-sparkline) + +;;; test-org-drill-statistics-sparkline.el ends here diff --git a/tests/test-org-drill-statistics-weekly-aggregates.el b/tests/test-org-drill-statistics-weekly-aggregates.el new file mode 100644 index 0000000..446ba54 --- /dev/null +++ b/tests/test-org-drill-statistics-weekly-aggregates.el @@ -0,0 +1,184 @@ +;;; test-org-drill-statistics-weekly-aggregates.el --- Tests for weekly-aggregates statistics -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for the org-drill statistics dashboard weekly-aggregates block. + +;;; Code: + +(require 'ert) +(require 'org-drill) +(require 'cl-lib) +(require 'org) + +;;; Tests for org-drill-statistics--weekly-aggregates. +;; +;; All tests redefine `org-drill-statistics--today-day' to a fixed +;; absolute day so the window is deterministic and never anchored to the +;; real clock. The chosen day, 739767, is Sunday 2026-05-31; its +;; Monday-based week start is 739761. Fixtures build records at noon of +;; a chosen absolute day, which round-trips cleanly through the +;; `time-to-days' path that `org-drill-statistics--record-day' uses. + +(defun test-org-drill-statistics-weekly--abs-to-float (abs hour) + "Return a float-time for HOUR (local) on absolute day ABS." + (let ((g (calendar-gregorian-from-absolute abs))) + (float-time + (encode-time (list 0 0 hour + (calendar-extract-day g) + (calendar-extract-month g) + (calendar-extract-year g) + nil -1 nil))))) + +(defun test-org-drill-statistics-weekly--rec (abs qualities &optional dur-min) + "Build a record starting at noon on ABS, lasting DUR-MIN minutes. +QUALITIES is a sequence of integers; DUR-MIN defaults to 10." + (let ((start (test-org-drill-statistics-weekly--abs-to-float abs 12))) + (make-org-drill-session-record + :start-time start + :end-time (+ start (* 60 (or dur-min 10))) + :qualities (vconcat qualities) + :algorithm 'sm5))) + +(defmacro test-org-drill-statistics-weekly--with-today (abs &rest body) + "Run BODY with `org-drill-statistics--today-day' fixed to ABS." + (declare (indent 1)) + `(cl-letf (((symbol-function 'org-drill-statistics--today-day) + (lambda () ,abs))) + ,@body)) + +(defconst test-org-drill-statistics-weekly--today 739767 + "Fixed today for tests: Sunday 2026-05-31, absolute day number.") +(defconst test-org-drill-statistics-weekly--this-mon 739761 + "Monday starting the week of `test-org-drill-statistics-weekly--today'.") + +;;; ---- Normal cases ---- + +(ert-deftest test-org-drill-statistics-weekly-default-span () + "Default WEEKS is 12, oldest-first, with each week 7 days apart." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let ((agg (org-drill-statistics--weekly-aggregates nil))) + (should (= 12 (length agg))) + (should (= (- test-org-drill-statistics-weekly--this-mon (* 7 11)) + (plist-get (car agg) :week-start))) + (should (= test-org-drill-statistics-weekly--this-mon + (plist-get (car (last agg)) :week-start))) + (cl-loop for (a b) on agg while b + do (should (= 7 (- (plist-get b :week-start) + (plist-get a :week-start)))))))) + +(ert-deftest test-org-drill-statistics-weekly-pooled-pass-percent () + "Reviews sum pooled qualities; pass-percent is pooled, not averaged." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + ;; Two sessions this week: pooled (5 4 1 2) -> 2 pass of 4 -> 50. + (let* ((log (list (test-org-drill-statistics-weekly--rec + test-org-drill-statistics-weekly--today '(5 4) 10) + (test-org-drill-statistics-weekly--rec + (1+ test-org-drill-statistics-weekly--this-mon) + '(1 2) 30))) + (agg (org-drill-statistics--weekly-aggregates log)) + (this (car (last agg)))) + (should (= test-org-drill-statistics-weekly--this-mon + (plist-get this :week-start))) + (should (= 4 (plist-get this :reviews))) + (should (= 50 (plist-get this :pass-percent))) + (should (= 20.0 (plist-get this :avg-duration-min)))))) + +(ert-deftest test-org-drill-statistics-weekly-records-spread-weeks () + "Records land in their own Monday-based week buckets." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let* ((mon test-org-drill-statistics-weekly--this-mon) + (log (list (test-org-drill-statistics-weekly--rec + test-org-drill-statistics-weekly--today '(5)) + (test-org-drill-statistics-weekly--rec + (- mon 7) '(0 0)) + (test-org-drill-statistics-weekly--rec + (- mon 14) '(4)))) + (agg (org-drill-statistics--weekly-aggregates log 12)) + (by-start (mapcar (lambda (p) (cons (plist-get p :week-start) + (plist-get p :reviews))) + agg))) + (should (= 1 (cdr (assoc mon by-start)))) + (should (= 2 (cdr (assoc (- mon 7) by-start)))) + (should (= 1 (cdr (assoc (- mon 14) by-start))))))) + +;;; ---- Boundary cases ---- + +(ert-deftest test-org-drill-statistics-weekly-empty-log () + "An empty log yields WEEKS all-zero plists." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let ((agg (org-drill-statistics--weekly-aggregates nil 3))) + (should (= 3 (length agg))) + (dolist (p agg) + (should (= 0 (plist-get p :reviews))) + (should (= 0 (plist-get p :pass-percent))) + (should (= 0.0 (plist-get p :avg-duration-min))))))) + +(ert-deftest test-org-drill-statistics-weekly-single-week () + "WEEKS = 1 keeps only the current week's records." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let* ((log (list (test-org-drill-statistics-weekly--rec + test-org-drill-statistics-weekly--today '(5 5)) + (test-org-drill-statistics-weekly--rec + (- test-org-drill-statistics-weekly--this-mon 7) '(0)))) + (agg (org-drill-statistics--weekly-aggregates log 1))) + (should (= 1 (length agg))) + (should (= test-org-drill-statistics-weekly--this-mon + (plist-get (car agg) :week-start))) + (should (= 2 (plist-get (car agg) :reviews))) + (should (= 100 (plist-get (car agg) :pass-percent)))))) + +(ert-deftest test-org-drill-statistics-weekly-out-of-window-dropped () + "Records older than the window are not bucketed." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let* ((log (list (test-org-drill-statistics-weekly--rec + (- test-org-drill-statistics-weekly--this-mon (* 7 5)) + '(5)))) + (agg (org-drill-statistics--weekly-aggregates log 3))) + (should (cl-every (lambda (p) (= 0 (plist-get p :reviews))) agg))))) + +(ert-deftest test-org-drill-statistics-weekly-week-boundary-monday () + "A Monday session counts in its week; the Sunday before is the prior week." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let* ((mon test-org-drill-statistics-weekly--this-mon) + (log (list (test-org-drill-statistics-weekly--rec mon '(5)) + (test-org-drill-statistics-weekly--rec (1- mon) '(4)))) + (agg (org-drill-statistics--weekly-aggregates log 2)) + (prior (car agg)) + (this (cadr agg))) + (should (= (- mon 7) (plist-get prior :week-start))) + (should (= 1 (plist-get prior :reviews))) + (should (= mon (plist-get this :week-start))) + (should (= 1 (plist-get this :reviews)))))) + +;;; ---- Error cases ---- + +(ert-deftest test-org-drill-statistics-weekly-non-positive-weeks-errors () + "WEEKS below 1 signals an error." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (should-error (org-drill-statistics--weekly-aggregates nil 0)) + (should-error (org-drill-statistics--weekly-aggregates nil -3)))) + +(ert-deftest test-org-drill-statistics-weekly-empty-qualities-record () + "A record with no qualities adds 0 reviews but still counts toward the +week's average duration." + (test-org-drill-statistics-weekly--with-today + test-org-drill-statistics-weekly--today + (let* ((log (list (test-org-drill-statistics-weekly--rec + test-org-drill-statistics-weekly--today [] 10))) + (agg (org-drill-statistics--weekly-aggregates log 1)) + (this (car agg))) + (should (= 0 (plist-get this :reviews))) + (should (= 0 (plist-get this :pass-percent))) + (should (= 10.0 (plist-get this :avg-duration-min)))))) + +(provide 'test-org-drill-statistics-weekly-aggregates) + +;;; test-org-drill-statistics-weekly-aggregates.el ends here -- cgit v1.2.3