1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
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)))))
|
