summaryrefslogtreecommitdiff
path: root/src/progression.lisp
diff options
context:
space:
mode:
authorMarius Peter <dev@marius-peter.com>2026-07-18 23:23:35 +0200
committerMarius Peter <dev@marius-peter.com>2026-07-18 23:23:35 +0200
commit753e25e99ddf57be78ff27ad89cb7e1bbc99d041 (patch)
tree43db69ec341520f2923f2f13d0cd8846a9acac35 /src/progression.lisp
Initial commit: HITO MVP
Heavy Duty I prescriptive training system encoding Mentzer's methodology. - 4-day split program (Chest & Back, Legs, Shoulders, Arms) - Prescription engine with pre-exhaust superset structure - Strict progression logic (+5kg large / +2.5kg small muscles) - Recovery gating with stall-based extension and override - Onboarding via experience level (Novice/Intermediate/Advanced) - Session logging with full progression analysis - Exercise substitution (33 alternatives for 17 canonical movements) - Objectivist aesthetic: black/gold, serif, rectilinear Stack: Hunchentoot, Mito/SQLite, Djula, SBCL
Diffstat (limited to 'src/progression.lisp')
-rw-r--r--src/progression.lisp157
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)))))
Copyright 2019--2026 Marius PETER