blob: 3a03a5352d14a2e051b8b0383b9523aac5932a70 (
plain)
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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
(in-package #:hito)
;;; --- Heavy Duty I Program Definition ---
;;;
;;; The program is encoded as pure data: a list of workout days, each containing
;;; ordered exercise entries with superset groupings, set counts, and rep ranges.
;;; This is the single source of truth for what Mentzer prescribed.
(defparameter *hd1-program*
'((:day 1
:name "Chest & Back"
:exercises
((:superset
((:name "Pec Deck" :sets 1 :rep-low 6 :rep-high 10)
(:name "Incline Barbell Press" :sets 1 :rep-low 6 :rep-high 10)))
(:superset
((:name "Straight-Arm Pulldowns" :sets 1 :rep-low 6 :rep-high 10)
(:name "Close-Grip Palms-Up Pulldowns" :sets 1 :rep-low 6 :rep-high 10)))
(:straight
((:name "Bent-Over Barbell Rows" :sets 2 :rep-low 6 :rep-high 10)))))
(:day 2
:name "Legs"
:exercises
((:superset
((:name "Leg Extensions" :sets 1 :rep-low 6 :rep-high 10)
(:name "Leg Press" :sets 1 :rep-low 6 :rep-high 10)))
(:straight
((:name "Squats" :sets 1 :rep-low 6 :rep-high 10)))
(:straight
((:name "Leg Curls" :sets 2 :rep-low 6 :rep-high 10)))
(:straight
((:name "Standing Calf Raises" :sets 2 :rep-low 6 :rep-high 10)))
(:straight
((:name "Toe Presses" :sets 1 :rep-low 6 :rep-high 10)))))
(:day 3
:name "Shoulders"
:exercises
((:superset
((:name "Lateral Raises" :sets 1 :rep-low 6 :rep-high 10)
(:name "Overhead Press" :sets 1 :rep-low 6 :rep-high 10)))
(:straight
((:name "Bent-Over Lateral Raises" :sets 2 :rep-low 6 :rep-high 10)))))
(:day 4
:name "Arms"
:exercises
((:straight
((:name "Barbell Curls" :sets 2 :rep-low 6 :rep-high 10)))
(:superset
((:name "Triceps Pushdowns" :sets 1 :rep-low 6 :rep-high 10)
(:name "Dips" :sets 1 :rep-low 6 :rep-high 10))))))
"Heavy Duty I: the complete 4-day split as Mentzer prescribed it.
Each workout day contains exercise groups — either :superset (pre-exhaust)
or :straight (standalone). Each exercise specifies sets and rep range.")
;;; --- Starting Weight Defaults by Experience Level ---
;;;
;;; Conservative starting points. The progression engine will correct these
;;; within 2-3 sessions. Better to start light and progress than to start
;;; heavy and stall.
(defparameter *starting-weights*
'(;; (exercise-name beginner intermediate advanced) — all in kg
("Pec Deck" 20 35 55)
("Incline Barbell Press" 40 60 85)
("Straight-Arm Pulldowns" 15 22 32)
("Close-Grip Palms-Up Pulldowns" 27 45 65)
("Bent-Over Barbell Rows" 35 60 85)
("Leg Extensions" 20 32 45)
("Leg Press" 60 115 180)
("Squats" 40 70 100)
("Leg Curls" 20 32 45)
("Standing Calf Raises" 35 70 100)
("Toe Presses" 45 90 135)
("Lateral Raises" 7 11 16)
("Overhead Press" 25 42 60)
("Bent-Over Lateral Raises" 5 9 14)
("Barbell Curls" 18 30 40)
("Triceps Pushdowns" 14 22 32)
("Dips" 0 0 10))
"Starting weights by exercise and experience level.
Dips default to 0 (bodyweight) for beginner/intermediate.")
(defun get-starting-weight (exercise-name level)
"Return the starting weight for an exercise at the given level.
LEVEL is one of :beginner, :intermediate, :advanced."
(let ((entry (assoc exercise-name *starting-weights* :test #'string=)))
(when entry
(case level
(:beginner (second entry))
(:intermediate (third entry))
(:advanced (fourth entry))
(otherwise (second entry))))))
;;; --- Program Query Functions ---
(defun get-workout-day (day-number)
"Return the program definition for a given day (1-4)."
(find day-number *hd1-program* :key (lambda (d) (getf d :day))))
(defun get-workout-day-name (day-number)
"Return the human-readable name for a workout day."
(let ((day (get-workout-day day-number)))
(when day (getf day :name))))
(defun get-day-exercises (day-number)
"Return the exercise group list for a given day."
(let ((day (get-workout-day day-number)))
(when day (getf day :exercises))))
;;; --- Exercise Resolution ---
(defun find-active-exercise-for-slot (canonical-name)
"Find the currently active exercise for a program slot.
If the user has substituted the canonical exercise, return the substitute.
Otherwise return the canonical exercise itself."
(let ((canonical (find-exercise-by-name canonical-name)))
(when canonical
;; Check if there's an active substitution pointing to this exercise
(let ((substitute (first (mito:select-dao 'exercise
(sxql:where (:= :substitution-for
(mito:object-id canonical)))))))
(or substitute canonical)))))
;;; --- Prescription Generation ---
(defstruct exercise-prescription
"A single exercise prescription within a session."
exercise-id
exercise-name
set-count
rep-low
rep-high
target-weight
group-type ; :superset or :straight
group-position) ; position within superset (0-indexed), nil for straight
(defun get-last-weight-for-exercise (exercise-id workout-day)
"Find the most recent actual weight used for this exercise in a completed session
of the same workout day. Returns nil if no history."
(let* ((sessions (mito:select-dao 'training-session
(sxql:where (:and (:= :workout-day workout-day)
(:= :completed-p 1)))
(sxql:order-by (:desc :session-date))
(sxql:limit 1)))
(last-session (first sessions)))
(when last-session
(let ((records (mito:select-dao 'set-record
(sxql:where (:and (:= :session-id (mito:object-id last-session))
(:= :exercise-id exercise-id))))))
;; Return the actual weight from the last set of this exercise
(when records
(let ((last-record (first (sort (copy-list records) #'>
:key (lambda (r) (set-record-set-number r))))))
(set-record-actual-weight last-record)))))))
(defun get-prescribed-weight-for-exercise (exercise-id workout-day)
"Get the next prescribed weight for an exercise.
First checks progression table (computed by progression engine),
then falls back to last actual weight, then to nil (needs user input)."
;; For now, just use last actual weight. Progression engine (Task 4)
;; will enhance this.
(get-last-weight-for-exercise exercise-id workout-day))
(defun prescribe-session (workout-day)
"Generate a full session prescription for the given workout day.
Returns a list of exercise-prescription structs ordered as the program dictates."
(let ((day-def (get-workout-day workout-day))
(prescriptions '()))
(unless day-def
(error "Invalid workout day: ~D (must be 1-4)" workout-day))
(dolist (group (getf day-def :exercises))
(let* ((group-type (first group))
(exercises (second group))
(position 0))
(dolist (ex-def exercises)
(let* ((canonical-name (getf ex-def :name))
(active-exercise (find-active-exercise-for-slot canonical-name))
(exercise-id (when active-exercise (mito:object-id active-exercise)))
(exercise-name (if active-exercise
(exercise-name active-exercise)
canonical-name))
(target-weight (when exercise-id
(get-prescribed-weight-for-exercise
exercise-id workout-day))))
(push (make-exercise-prescription
:exercise-id exercise-id
:exercise-name exercise-name
:set-count (getf ex-def :sets)
:rep-low (getf ex-def :rep-low)
:rep-high (getf ex-def :rep-high)
:target-weight target-weight
:group-type group-type
:group-position (when (eq group-type :superset) position))
prescriptions)
(incf position)))))
(nreverse prescriptions)))
(defun format-prescription (prescription)
"Format a single exercise-prescription for display."
(let ((weight (exercise-prescription-target-weight prescription)))
(format nil "~A: ~@[~A kg × ~]~D-~D reps × ~D set~:P"
(exercise-prescription-exercise-name prescription)
(when weight (round weight))
(exercise-prescription-rep-low prescription)
(exercise-prescription-rep-high prescription)
(exercise-prescription-set-count prescription))))
(defun format-session-prescription (workout-day)
"Format an entire session prescription as a readable string."
(let ((day-def (get-workout-day workout-day))
(prescriptions (prescribe-session workout-day))
(groups (get-day-exercises workout-day)))
(with-output-to-string (out)
(format out "~%=== Day ~D: ~A ===~%~%"
workout-day (getf day-def :name))
;; Walk the groups directly and print prescriptions in order
(let ((presc-idx 0))
(loop for group in groups
for group-idx from 0
for group-type = (first group)
for group-exercises = (second group)
do (when (> group-idx 0) (format out "~%"))
(if (eq group-type :superset)
(format out "[Pre-Exhaust Superset]~%")
(format out "[Straight Set]~%"))
(loop for i below (length group-exercises)
do (format out " ~A~%"
(format-prescription (nth presc-idx prescriptions)))
(incf presc-idx)))))))
|