;; SPDX-FileCopyrightText: 2026 Andrew Oberstar <andrew@ajoberstar.org>
;; SPDX-License-Identifier: AGPL-3.0-only

(in-package #:org.ajoberstar.quixote.stats)

;;; Ring Buffer

(defclass ring-buffer ()
  ((array :initarg :array :type array)
   (start-index :initform 0 :type integer)
   (count :initform 0 :type integer :reader ring-count)))

(defmethod print-object ((obj ring-buffer) stream)
  (print-unreadable-object (obj stream :type t)
    (print-object (ring-elements obj) stream)))

(defun make-ring-buffer (capacity)
  (declare (type integer capacity))
  (make-instance 'ring-buffer :array (make-array capacity)))

(defun ring-push (item ring)
  (declare (type ring-buffer ring))
  (with-slots (array start-index count) ring
    (if (eq count (length array))
        (progn
          (setf (aref array start-index) item)
          (setf start-index (mod (1+ start-index) (length array)))
          ring)
        (progn
          (setf (aref array (+ start-index count)) item)
          (incf count)
          ring))))

(defun ring-pop (ring)
  (declare (type ring-buffer ring))
  (with-slots (array start-index count) ring
    (if (< 0 count)
        (let ((value (aref array start-index)))
          (setf start-index (mod (1+ start-index) (length array)))
          (decf count)
          (values value ring))
        (values nil ring))))

(defun ring-elements (ring)
  (declare (type ring-buffer ring))
  (with-slots (array start-index count) ring
    (loop for index = start-index then (mod (1+ index) (length array))
          for size from 0
          until (<= count size)
          collect (aref array index))))

;;; Helpers

(defun daily-pages (sessions)
  (loop with result = (make-hash-table :test #'equal)
        for session in sessions
        for date-str = (dates:write-iso-date nil (model:session-at session))
        for current = (gethash date-str result 0)
        do (setf (gethash date-str result)
                 (+ current (model:session-pages session)))
        finally (return result)))

(defun oldest (sessions)
  (reduce (lambda (a b)
            (if (dates:date< a b) a b))
          (mapcar #'model:session-at
                  sessions)
          :initial-value dates:maximum-date))

(defun newest (sessions)
  (reduce (lambda (a b)
            (if (dates:date> a b) a b))
          (mapcar #'model:session-at
                  sessions)
          :initial-value dates:minimum-date))

(defun percentile (list &optional (percentile (/ 1 2)))
  (let* ((index (floor (* (1- (length list))
                          percentile)))
         (sorted (sort list #'<)))
    (nth index sorted)))

;;; Analysis

(defun analysis (date buffer)
  (declare (type dates:date date))
  (declare (type ring-buffer buffer))
  (let* ((elements (ring-elements buffer))
         (active (remove-if-not (lambda (x) (< 0 x)) elements)))
    (list :date date
          :avg (float (/ (reduce #'+ elements)
                         (ring-count buffer)))
          :active-avg (if (< 0 (length active))
                          (float (/ (reduce #'+ active)
                                    (length active)))
                          0)
          :median (percentile elements 0.5)
          :perc75 (percentile elements 0.75)
          :perc90 (percentile elements 0.9)
          :active-pct (float (/ (length active)
                                (ring-count buffer))))))

(defun rolling (days sessions)
  (loop with today = (dates:today)
        with buffer = (make-ring-buffer days)
        with day-pages = (daily-pages sessions)
        for date = (oldest sessions) then (dates:date-1+ date)
        until (dates:date> date today)
        do (ring-push (gethash (dates:write-iso-date nil date) day-pages 0) buffer)
        collect (analysis date buffer)))

;;; Page Counts

(defun periods (period-fun days sessions start)
  (loop with today = (dates:today)
        with start = (or start (funcall period-fun (oldest sessions)))
        for date = start then (funcall period-fun (dates:date+ date days))
        while (dates:date<= date today)
        collect date))

(defun period-pages (period-fun days sessions &optional start)
  (let* ((periods (periods period-fun days sessions start))
         (period-data (loop for period in periods
                            for filtered = (remove-if-not (lambda (session)
                                                            (dates:date= period
                                                                         (funcall period-fun (model:session-at session))))
                                                          sessions)
                            collect (reduce #'+ (mapcar #'model:session-pages
                                                        filtered)))))
    (list :labels (mapcar (lambda (date) (dates:write-iso-date nil date)) periods)
          :dataset period-data)))

(defun year-pages (sessions)
  (period-pages #'dates:date-start-of-year
                366
                sessions))


(defun quarter-pages (start sessions)
  (period-pages #'dates:date-start-of-quarter
                93
                sessions
                start))

(defun week-pages (start sessions)
  (period-pages (lambda (date)
                  (dates:date-prev date :monday))
                7
                sessions
                start))

;;; Pace

(defun map-pace (days dates sessions)
  (loop for start = (dates:date- (first dates) 1)
        for date in dates
        for base = (let ((ideal-base (dates:date- date days)))
                     (if (dates:date< start ideal-base)
                         ideal-base
                         start))
        for filtered = (remove-if-not (lambda (session)
                                        (and (dates:date< base (model:session-at session))
                                             (dates:date<= (model:session-at session) date)))
                                      sessions)
        for period = (- (dates:date-ordinal date)
                        (dates:date-ordinal base))
        collect (/ (reduce #'+ (mapcar #'model:session-pages filtered))
                   period)))

(defun map-ema (periods list)
  (loop with alpha = (/ 2.0 (1+ periods))
        with prev = nil
        for current in list
        for ema = (if prev
                      (+ (* alpha current)
                         (* (- 1.0 alpha) prev))
                      current)
        do (setf prev ema)
        collect ema))

(defun pace (sessions)
  (let* ((pace-dates (let ((oldest (oldest sessions)))
                       (loop for date = (dates:date-prev oldest :monday) then (dates:date+ date 7)
                             until (dates:date> date (dates:today))
                             collect date)))
         (pace-labels (mapcar (lambda (date) (dates:write-iso-date nil date))
                              pace-dates))
         (month (map-ema 4 (map-pace (* 7 4) pace-dates sessions)))
         (quarter (map-ema 13 (map-pace (* 7 13) pace-dates sessions)))
         (year (map-ema 52 (map-pace (* 7 52) pace-dates sessions))))
    (list :labels pace-labels :month-dataset month :quarter-dataset quarter :year-dataset year)))

;;; Progress

(defun progress (sessions)
  (let* ((progress-dates (let ((oldest (oldest sessions))
                               (newest (newest sessions)))
                           (loop for date = oldest then (dates:date-1+ date)
                                 until (dates:date> date newest)
                                 collect date)))
         (progress-labels (mapcar (lambda (date) (dates:write-iso-date nil date))
                                  progress-dates))
         (progress-data (loop with total = 0
                              for date in progress-dates
                              for date-sessions = (remove-if-not (lambda (session)
                                                                   (dates:date= date (model:session-at session)))
                                                                 sessions)
                              do (incf total (reduce #'+ (mapcar #'model:session-pages date-sessions)))
                              collect total)))
    (list :labels progress-labels :dataset progress-data)))

;;; Activity

(defun week-activity (sessions)
  (when sessions
    (let* ((by-date (daily-pages sessions))
           (weeks (loop for week = (dates:date-prev (oldest sessions) :monday) then (dates:date-next week :monday)
                        while (dates:date<= week (dates:today))
                        collect (let ((days 0)
                                      (pages 0))
                                  (loop for date = week then (dates:date-1+ date)
                                        until (and (eq :monday (dates:date-dow date))
                                                   (not (dates:date= date week)))
                                        do (let ((day-pages (gethash (dates:write-iso-date nil date) by-date 0)))
                                             (incf pages day-pages)
                                             (if (< 0 day-pages)
                                                 (incf days))))
                                  (list :week week :days days :pages pages))))
           (week-active-days (remove-if-not (lambda (days) (< 0 days))
                                            (mapcar (lambda (week) (getf week :days))
                                                    weeks)))
           (week-active-pages (remove-if-not (lambda (pages) (< 0 pages))
                                             (mapcar (lambda (week) (getf week :pages))
                                                     weeks)))
           (active-days-p25 (percentile week-active-days 0.25))
           (active-days-p50 (percentile week-active-days 0.50))
           (active-days-p75 (percentile week-active-days 0.75))

           (active-pages-p25 (percentile week-active-pages 0.25))
           (active-pages-p50 (percentile week-active-pages 0.50))
           (active-pages-p75 (percentile week-active-pages 0.75)))

      (labels ((tier (week)
                 (let ((days (getf week :days))
                       (pages (getf week :pages)))
                   (cond
                     ((= 0 pages)
                      "tier-f")
                     ((and (<= active-days-p75 days)
                           (<= active-pages-p75 pages))
                      "tier-a")
                     ((and (<= active-days-p50 days)
                           (<= active-pages-p50 pages))
                      "tier-b")
                     ((and (<= active-days-p25 days)
                           (<= active-pages-p25 pages))
                      "tier-c")
                     (t
                      "tier-d")))))
        (loop for week in weeks
              do (setf (getf week :tier) (tier week))
              collect week)))))
