1 files changed, 157 insertions, 0 deletions
diff --git a/src/progression.lisp b/src/progression.lisp
new file mode 100644
index 0000000..94e980b
--- /dev/null
+++ b/src/progression.lisp
@@ -0,0 +1,157 @@
+(in-package #:hito)
+
+;;; --- Progression Engine ---
+;;;
+;;; Mentzer's progression logic is unambiguous:
+;;;   - Hit the top of the rep range → increase weight next session.
+;;;   - Within range → maintain weight, keep pushing.
+;;;   - Below the range → the weight is too heavy, or recovery is incomplete.
+;;;     The answer is NOT to reduce weight. The answer is more rest.
+;;;
+;;; "If you haven't recovered, you haven't grown. And if you haven't grown,
+;;;  more training is the last thing you need."
+
+;;; --- Weight Increment Configuration ---
+
+(defparameter *weight-increments*
+  '(("chest"     . 5)
+    ("back"      . 5)
+    ("legs"      . 5)
+    ("shoulders" . 2.5)
+    ("arms"      . 2.5))
+  "Weight increment in kg per muscle group when progression is triggered.
+Larger muscle groups tolerate larger jumps.")
+
+(defun weight-increment-for (muscle-group)
+  "Return the weight increment for a given muscle group."
+  (or (cdr (assoc muscle-group *weight-increments* :test #'string-equal))
+      2.5))
+
+;;; --- Set Evaluation ---
+
+(defun evaluate-set (set-record)
+  "Evaluate a single set's result against its prescription.
+Returns one of:
+  :increase — top of range reached, weight goes up next time
+  :maintain — within range, keep current weight
+  :stall    — below range, recovery issue flagged"
+  (let ((actual-reps (set-record-actual-reps set-record))
+        (rep-high (set-record-prescribed-rep-high set-record))
+        (rep-low (set-record-prescribed-rep-low set-record)))
+    (cond
+      ((null actual-reps) :maintain) ; incomplete data, don't change
+      ((>= actual-reps rep-high) :increase)
+      ((>= actual-reps rep-low) :maintain)
+      (t :stall))))
+
+;;; --- Weight Computation ---
+
+(defun compute-next-weight (current-weight progression-result muscle-group)
+  "Compute the next session's weight based on progression result.
+  :increase → add increment for muscle group
+  :maintain → same weight
+  :stall    → same weight (recovery system handles the response)"
+  (case progression-result
+    (:increase (+ current-weight (weight-increment-for muscle-group)))
+    (:maintain current-weight)
+    (:stall    current-weight)
+    (otherwise current-weight)))
+
+;;; --- Session Progression Processing ---
+
+(defstruct progression-result
+  "Result of progression evaluation for one exercise."
+  exercise-id
+  exercise-name
+  muscle-group
+  old-weight
+  new-weight
+  status        ; :increase, :maintain, or :stall
+  actual-reps
+  rep-range-high)
+
+(defun get-exercise-muscle-group (exercise-id)
+  "Look up the muscle group for an exercise by ID."
+  (let ((exercise (mito:find-dao 'exercise :id exercise-id)))
+    (when exercise
+      (exercise-muscle-group exercise))))
+
+(defun process-session-progression (session)
+  "Process all set records from a completed session and compute progression.
+Returns a list of progression-result structs (one per exercise).
+For exercises with multiple sets, uses the LAST set to determine progression
+(Mentzer: the final set to failure is what counts)."
+  (let* ((session-id (mito:object-id session))
+         (records (mito:select-dao 'set-record
+                    (sxql:where (:= :session-id session-id))
+                    (sxql:order-by (:asc :exercise-id) (:asc :set-number))))
+         ;; Group records by exercise, keep last set per exercise
+         (exercise-last-sets (make-hash-table))
+         (results '()))
+    ;; Find the last (highest set-number) record for each exercise
+    (dolist (rec records)
+      (let ((eid (set-record-exercise-id rec)))
+        (let ((existing (gethash eid exercise-last-sets)))
+          (when (or (null existing)
+                    (> (set-record-set-number rec)
+                       (set-record-set-number existing)))
+            (setf (gethash eid exercise-last-sets) rec)))))
+    ;; Evaluate progression for each exercise
+    (maphash
+     (lambda (exercise-id last-set)
+       (let* ((status (evaluate-set last-set))
+              (muscle-group (get-exercise-muscle-group exercise-id))
+              (current-weight (or (set-record-actual-weight last-set)
+                                  (set-record-prescribed-weight last-set)))
+              (new-weight (compute-next-weight current-weight status muscle-group))
+              (exercise (mito:find-dao 'exercise :id exercise-id)))
+         (push (make-progression-result
+                :exercise-id exercise-id
+                :exercise-name (when exercise (exercise-name exercise))
+                :muscle-group muscle-group
+                :old-weight current-weight
+                :new-weight new-weight
+                :status status
+                :actual-reps (set-record-actual-reps last-set)
+                :rep-range-high (set-record-prescribed-rep-high last-set))
+               results)))
+     exercise-last-sets)
+    ;; Return sorted by exercise-id for consistency
+    (sort results #'< :key #'progression-result-exercise-id)))
+
+;;; --- Progression Formatting ---
+
+(defun format-progression-result (result)
+  "Format a single progression result in Mentzer's voice."
+  (case (progression-result-status result)
+    (:increase
+     (format nil "~A: ~A reps achieved. The resistance will increase to ~A kg."
+             (progression-result-exercise-name result)
+             (progression-result-actual-reps result)
+             (round (progression-result-new-weight result))))
+    (:maintain
+     (format nil "~A: ~A reps. Maintain ~A kg. Continue to push for ~A."
+             (progression-result-exercise-name result)
+             (progression-result-actual-reps result)
+             (round (progression-result-old-weight result))
+             (progression-result-rep-range-high result)))
+    (:stall
+     (format nil "~A: ~A reps — below the prescribed range. This is not a weight problem. This is a recovery problem."
+             (progression-result-exercise-name result)
+             (progression-result-actual-reps result)))
+    (otherwise "")))
+
+(defun format-session-progression (results)
+  "Format all progression results from a session."
+  (with-output-to-string (out)
+    (format out "~%=== Progression Analysis ===~%~%")
+    (dolist (r results)
+      (format out "  ~A~%" (format-progression-result r)))
+    ;; Summary
+    (let ((increases (count :increase results :key #'progression-result-status))
+          (stalls (count :stall results :key #'progression-result-status)))
+      (format out "~%")
+      (when (plusp increases)
+        (format out "  Weight increased on ~D exercise~:P.~%" increases))
+      (when (plusp stalls)
+        (format out "  ~D stall~:P detected. Extended recovery is indicated.~%" stalls)))))