[OCaml] High Intensity Training Online
feat Enforce the three-sets-per-muscle ceiling
HD1 caps volume at the plan: "one set per exercise, and at the most, three sets per muscle, is all that is required." Nothing prevented authoring a fourth set on a muscle, so an illegal plan was representable. Make it unrepresentable — Workout.make now raises Excess_sets_per_muscle when a muscle would receive more than the ceiling. Count each delivery exercise toward its primary muscle; substitutes are alternatives, not added volume. Expose Exercise.Muscle (the bodyparts the Routine trains) and primary_muscle to support the count, and expose sets_per_muscle_ceiling. The invariant lives on the authored plan, per the rule that invariants belong on plans, not on observed history. The Ideal Routine remains legal: Day 2 lats reach exactly three (pullover superset plus rows), every other muscle fewer.
Changed files
lib/core/exercise.ml
@@ -15,6 +15,23 @@
15
15
| Abdominals
16
16
17
17
let equal = ( = )
18
Added:
19
Added:
let pp ppf m =
20
Added:
Format.pp_print_string ppf
21
Added:
(match m with
22
Added:
| Pecs -> "pecs"
23
Added:
| Delts -> "delts"
24
Added:
| Triceps -> "triceps"
25
Added:
| Biceps -> "biceps"
26
Added:
| Forearms -> "forearms"
27
Added:
| Lats -> "lats"
28
Added:
| Traps -> "traps"
29
Added:
| Erectors -> "erectors"
30
Added:
| Quadriceps -> "quadriceps"
31
Added:
| Hamstrings -> "hamstrings"
32
Added:
| Glutes -> "glutes"
33
Added:
| Calves -> "calves"
34
Added:
| Abdominals -> "abdominals")
18
35
end
19
36
20
37
type equipment =
@@ -79,6 +96,11 @@
79
96
let key t = t.key
80
97
let id t = t.id
81
98
let name t = t.name
99
Added:
100
Added:
(* The muscle a set is prescribed to train, counted toward the per-muscle
101
Added:
ceiling. Catalog entries always carry a non-empty muscle list: an isolation
102
Added:
names one muscle, a compound names its primary first. *)
103
Added:
let primary_muscle t = List.hd t.muscles
82
104
let equal a b = key_equal a.key b.key
83
105
let pp ppf t = Format.pp_print_string ppf t.name
84
106
lib/core/exercise.mli
@@ -43,6 +43,28 @@
43
43
| Straight_arm
44
44
| Preacher
45
45
46
Added:
(** The bodyparts HD1's Routine trains. A set counts toward the per-muscle
47
Added:
ceiling through the exercise's primary muscle. *)
48
Added:
module Muscle : sig
49
Added:
type t =
50
Added:
| Pecs
51
Added:
| Delts
52
Added:
| Triceps
53
Added:
| Biceps
54
Added:
| Forearms
55
Added:
| Lats
56
Added:
| Traps
57
Added:
| Erectors
58
Added:
| Quadriceps
59
Added:
| Hamstrings
60
Added:
| Glutes
61
Added:
| Calves
62
Added:
| Abdominals
63
Added:
64
Added:
val equal : t -> t -> bool
65
Added:
val pp : Format.formatter -> t -> unit
66
Added:
end
67
Added:
46
68
type key = { equipment : equipment; movement : movement; variation : variation }
47
69
(** The catalog identity: equipment × movement × variation. *)
48
70
@@ -61,6 +83,11 @@
61
83
val key : t -> key
62
84
val id : t -> id
63
85
val name : t -> string
86
Added:
87
Added:
val primary_muscle : t -> Muscle.t
88
Added:
(** The muscle the exercise is prescribed to train, counted toward the
89
Added:
per-muscle ceiling. *)
90
Added:
64
91
val equal : t -> t -> bool
65
92
val pp : Format.formatter -> t -> unit
66
93
lib/core/prescription.ml
@@ -97,15 +97,50 @@
97
97
end
98
98
99
99
module Workout = struct
100
Removed:
type error = Empty_workout
100
Added:
type error =
101
Added:
| Empty_workout
102
Added:
| Excess_sets_per_muscle of { muscle : Exercise.Muscle.t; sets : int }
103
Added:
101
104
type t = { name : string; stimuli : Stimulus.t list }
102
105
103
106
exception Invalid of error
104
107
108
Added:
(* HD1, The Science of Bodybuilding: "one set per exercise, and at the most,
109
Added:
three sets per muscle, is all that is required." *)
110
Added:
let sets_per_muscle_ceiling = 3
111
Added:
112
Added:
let pp_error ppf = function
113
Added:
| Empty_workout ->
114
Added:
Format.pp_print_string ppf "a workout must prescribe at least one set"
115
Added:
| Excess_sets_per_muscle { muscle; sets } ->
116
Added:
Format.fprintf ppf "%a receives %d sets, over the ceiling of %d"
117
Added:
Exercise.Muscle.pp muscle sets sets_per_muscle_ceiling
118
Added:
119
Added:
(* Each delivery exercise counts one set toward its primary muscle;
120
Added:
substitutes are alternatives, not added volume. Returns the first muscle
121
Added:
over the ceiling, if any. *)
122
Added:
let over_ceiling stimuli =
123
Added:
let primaries =
124
Added:
List.concat_map Stimulus.exercises stimuli
125
Added:
|> List.map Exercise.primary_muscle
126
Added:
in
127
Added:
let sets muscle =
128
Added:
List.length (List.filter (Exercise.Muscle.equal muscle) primaries)
129
Added:
in
130
Added:
List.find_map
131
Added:
(fun muscle ->
132
Added:
let n = sets muscle in
133
Added:
if n > sets_per_muscle_ceiling then Some (muscle, n) else None)
134
Added:
primaries
135
Added:
105
136
let make ~name ~stimuli =
106
137
match stimuli with
107
138
| [] -> raise (Invalid Empty_workout)
108
Removed:
| _ -> { name; stimuli }
139
Added:
| _ -> (
140
Added:
match over_ceiling stimuli with
141
Added:
| Some (muscle, sets) ->
142
Added:
raise (Invalid (Excess_sets_per_muscle { muscle; sets }))
143
Added:
| None -> { name; stimuli })
109
144
110
145
let name t = t.name
111
146
let stimuli t = t.stimuli
lib/core/prescription.mli
@@ -56,12 +56,26 @@
56
56
(** Ordered prescribed stimuli. *)
57
57
module Workout : sig
58
58
type t
59
Removed:
type error = Empty_workout
60
59
60
Added:
type error =
61
Added:
| Empty_workout
62
Added:
| Excess_sets_per_muscle of { muscle : Exercise.Muscle.t; sets : int }
63
Added:
(** More than {!sets_per_muscle_ceiling} sets fall on one muscle. *)
64
Added:
61
65
exception Invalid of error
62
66
67
Added:
val pp_error : Format.formatter -> error -> unit
68
Added:
69
Added:
val sets_per_muscle_ceiling : int
70
Added:
(** Three. HD1: "one set per exercise, and at the most, three sets per
71
Added:
muscle." Volume beyond the minimum is harmful, so the plan enforces the
72
Added:
ceiling rather than trusting the author to respect it. *)
73
Added:
63
74
val make : name:string -> stimuli:Stimulus.t list -> t
64
Removed:
(** Raises [Invalid Empty_workout] for an empty workout. *)
75
Added:
(** Raises [Invalid Empty_workout] for an empty workout, and
76
Added:
[Invalid (Excess_sets_per_muscle _)] when a muscle would receive more than
77
Added:
{!sets_per_muscle_ceiling} sets. Each delivery exercise counts one set
78
Added:
toward its primary muscle; substitutes do not add volume. *)
65
79
66
80
val name : t -> string
67
81
val stimuli : t -> Stimulus.t list