[OCaml] High Intensity Training Online
feat implement Prescription with HD1's delivery shapes and rep window
A prescription is one prescribed stimulus: how a single drive to failure is delivered, plus the rep window that calibrates its load. Delivery has exactly two shapes, Single and Pre_exhaust. There is no antagonist superset: every superset in HD1's Ideal Routine is an isolation carried into a compound, and Mentzer's own term is "isolation-compound superset". Pre_exhaust construction is validated through Exercise.may_pre_exhaust, so an incoherent pairing cannot be prescribed. rep_limits encodes HD1's stimulus window of 6-12 and lives here, in the module that employs it, rather than in a constants module: fewer than six reps does not tax the reserves, and beyond twelve the set ends in cardiorespiratory insufficiency before the muscle fails. A prescribed range must lie within it, which permits per-exercise variation while making 3-rep and 20-rep prescriptions unrepresentable. The field is named rep_range, not target_reps: HD1 is explicit that a set never ends because a rep count was reached, so reps are an outcome and the window only calibrates load. 41 Alcotests.
Changed files
lib/core/prescription.ml
@@ -1,9 +1,86 @@
1
Removed:
(* Blank slate: stub only. Interface (prescription.mli) is the design surface. *)
1
Added:
type delivery =
2
Added:
| Single of Exercise.t
3
Added:
| Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }
2
4
3
Removed:
type t = unit
5
Added:
type t = {
6
Added:
delivery : delivery;
7
Added:
rep_range : Units.Rep_range.t;
8
Added:
allowed_substitutes : Exercise.t list;
9
Added:
}
4
10
5
Removed:
let make ~exercise:_ ~target_reps:_ ~allowed_substitutes:_ = failwith "TODO"
6
Removed:
let exercise _ = failwith "TODO"
7
Removed:
let target_reps _ = failwith "TODO"
8
Removed:
let allowed_substitutes _ = failwith "TODO"
9
Removed:
let pp _ _ = failwith "TODO"
11
Added:
type error =
12
Added:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
13
Added:
| Reps_outside_limits
14
Added:
| Substitute_not_permitted of Exercise.id
15
Added:
16
Added:
(* 6 and 12 are statically valid, so these cannot fail. *)
17
Added:
let reps_exn n =
18
Added:
match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
19
Added:
20
Added:
let rep_limits =
21
Added:
match Units.Rep_range.make ~min:(reps_exn 6) ~max:(reps_exn 12) with
22
Added:
| Ok r -> r
23
Added:
| Error _ -> assert false
24
Added:
25
Added:
let pp_error ppf = function
26
Added:
| Not_a_pre_exhaust { isolation; compound } ->
27
Added:
Format.fprintf ppf "%s cannot pre-exhaust for %s"
28
Added:
(isolation :> string)
29
Added:
(compound :> string)
30
Added:
| Reps_outside_limits ->
31
Added:
Format.fprintf ppf "rep window must lie within %a" Units.Rep_range.pp
32
Added:
rep_limits
33
Added:
| Substitute_not_permitted id ->
34
Added:
Format.fprintf ppf "%s is not a permitted substitute" (id :> string)
35
Added:
36
Added:
let delivery t = t.delivery
37
Added:
let rep_range t = t.rep_range
38
Added:
let allowed_substitutes t = t.allowed_substitutes
39
Added:
40
Added:
let delivery_exercises = function
41
Added:
| Single e -> [ e ]
42
Added:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
43
Added:
44
Added:
let exercises t = delivery_exercises t.delivery
45
Added:
46
Added:
let within_limits range =
47
Added:
Units.Rep_range.contains rep_limits (Units.Rep_range.min range)
48
Added:
&& Units.Rep_range.contains rep_limits (Units.Rep_range.max range)
49
Added:
50
Added:
let make ~delivery ~rep_range ~allowed_substitutes =
51
Added:
let movements = delivery_exercises delivery in
52
Added:
let unpermitted =
53
Added:
List.find_opt
54
Added:
(fun candidate ->
55
Added:
not
56
Added:
(List.exists
57
Added:
(fun original -> Exercise.may_substitute ~original ~candidate)
58
Added:
movements))
59
Added:
allowed_substitutes
60
Added:
in
61
Added:
match (delivery, within_limits rep_range, unpermitted) with
62
Added:
| Pre_exhaust { isolation; compound }, _, _
63
Added:
when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
64
Added:
Error
65
Added:
(Not_a_pre_exhaust
66
Added:
{
67
Added:
isolation = Exercise.id isolation;
68
Added:
compound = Exercise.id compound;
69
Added:
})
70
Added:
| _, false, _ -> Error Reps_outside_limits
71
Added:
| _, _, Some candidate ->
72
Added:
Error (Substitute_not_permitted (Exercise.id candidate))
73
Added:
| _ -> Ok { delivery; rep_range; allowed_substitutes }
74
Added:
75
Added:
let permits t movement =
76
Added:
List.exists (Exercise.equal movement) (exercises t)
77
Added:
|| List.exists (Exercise.equal movement) t.allowed_substitutes
78
Added:
79
Added:
let pp_delivery ppf = function
80
Added:
| Single e -> Exercise.pp ppf e
81
Added:
| Pre_exhaust { isolation; compound } ->
82
Added:
Format.fprintf ppf "%a into %a" Exercise.pp isolation Exercise.pp compound
83
Added:
84
Added:
let pp ppf t =
85
Added:
Format.fprintf ppf "%a for %a reps" pp_delivery t.delivery Units.Rep_range.pp
86
Added:
t.rep_range
lib/core/prescription.mli
@@ -1,21 +1,57 @@
1
Removed:
(** One exercise's plan: the movement, the target rep band, and which
2
Removed:
substitutes are permitted. Heavy Duty prescribes a single working set, so
3
Removed:
that is implicit and not configurable.
1
Added:
(** One prescribed stimulus: how a single drive to failure is to be delivered,
2
Added:
and the rep window that calibrates its load.
4
3
5
Removed:
Purely a plan — it knows nothing of what was performed. Judging performance
6
Removed:
against a prescription is {!Progression}'s job. *)
4
Added:
Heavy Duty prescribes one working set, so that is implicit and not
5
Added:
configurable. Purely a plan — it knows nothing of what was performed.
6
Added:
Judging performance against a prescription is {!Progression}'s job. *)
7
7
8
8
type t
9
9
10
Added:
(** How the stimulus is delivered. HD1 knows only these two shapes: a single
11
Added:
movement, or an isolation carried straight into a compound. There is no
12
Added:
antagonist superset — "superset" in HD1 always means pre-exhaustion. *)
13
Added:
type delivery =
14
Added:
| Single of Exercise.t
15
Added:
| Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }
16
Added:
(** Performed with no pause: even a three-second delay lets the target
17
Added:
recover and restores the weak link. *)
18
Added:
19
Added:
type error =
20
Added:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
21
Added:
(** The pair cannot pre-exhaust; see {!Exercise.may_pre_exhaust}. *)
22
Added:
| Reps_outside_limits (** The rep window escapes {!rep_limits}. *)
23
Added:
| Substitute_not_permitted of Exercise.id
24
Added:
(** A substitute is on no delivery movement's catalog whitelist. *)
25
Added:
26
Added:
val pp_error : Format.formatter -> error -> unit
27
Added:
28
Added:
val rep_limits : Units.Rep_range.t
29
Added:
(** HD1's stimulus window, 6-12: fewer than six does not tax the reserves
30
Added:
sufficiently, and beyond twelve the set ends in cardiorespiratory
31
Added:
insufficiency before the muscle reaches failure. A prescribed range must lie
32
Added:
within it. *)
33
Added:
10
34
val make :
11
Removed:
exercise:Exercise.t ->
12
Removed:
target_reps:Units.Rep_range.t ->
35
Added:
delivery:delivery ->
36
Added:
rep_range:Units.Rep_range.t ->
13
37
allowed_substitutes:Exercise.t list ->
14
Removed:
(t, Exercise.error) result
15
Removed:
(** Substitutes must be on the exercise's catalog whitelist, so a prescription
16
Removed:
may only narrow the curated set. *)
38
Added:
(t, error) result
39
Added:
(** Each substitute must be permitted for one of the delivery's movements, so a
40
Added:
prescription may only narrow the curated set. *)
17
41
18
Removed:
val exercise : t -> Exercise.t
19
Removed:
val target_reps : t -> Units.Rep_range.t
42
Added:
val delivery : t -> delivery
43
Added:
44
Added:
val rep_range : t -> Units.Rep_range.t
45
Added:
(** Calibrates load selection only. Reps are an outcome: a set ends at failure,
46
Added:
never because a number was reached. *)
47
Added:
20
48
val allowed_substitutes : t -> Exercise.t list
49
Added:
50
Added:
val exercises : t -> Exercise.t list
51
Added:
(** The delivery's movements, in performance order. *)
52
Added:
53
Added:
val permits : t -> Exercise.t -> bool
54
Added:
(** Whether the movement may be logged against this prescription — one of its
55
Added:
own, or an allowed substitute. *)
56
Added:
21
57
val pp : Format.formatter -> t -> unit
test/dune
@@ -3,5 +3,5 @@
3
3
4
4
(test
5
5
(name test_hito)
6
Removed:
(modules test_hito test_units test_muscle test_exercise)
6
Added:
(modules test_hito test_units test_muscle test_exercise test_prescription)
7
7
(libraries hito.core alcotest))
test/test_hito.ml
@@ -3,4 +3,5 @@
3
3
4
4
let () =
5
5
Alcotest.run "hito"
6
Removed:
(Test_units.suite @ Test_muscle.suite @ Test_exercise.suite)
6
Added:
(Test_units.suite @ Test_muscle.suite @ Test_exercise.suite
7
Added:
@ Test_prescription.suite)
test/test_prescription.ml
@@ -1,78 +1,163 @@
1
Removed:
(** Unit tests for {!Prescription}, authored against prescription.mli.
1
Added:
(** Unit tests for {!Prescription}, authored against the prescription.mli
2
Added:
contract. *)
2
3
3
Removed:
Under test: a prescription may only narrow the exercise's catalog whitelist,
4
Removed:
never widen it. *)
5
Removed:
6
4
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
7
5
8
Removed:
let by_name n =
9
Removed:
match
10
Removed:
List.find_opt (fun ex -> String.equal (Exercise.name ex) n) Exercise.catalog
11
Removed:
with
12
Removed:
| Some ex -> ex
13
Removed:
| None -> Alcotest.failf "no exercise named %s" n
6
Added:
let get id =
7
Added:
match Exercise.find id with
8
Added:
| Some e -> e
9
Added:
| None -> Alcotest.failf "catalog is missing %S" id
14
10
15
Removed:
let target_reps () =
16
Removed:
ok
17
Removed:
(Units.Rep_range.make
18
Removed:
~min:(ok (Units.Reps.of_int 6))
19
Removed:
~max:(ok (Units.Reps.of_int 8)))
11
Added:
let range lo hi =
12
Added:
let reps n = ok (Units.Reps.of_int n) in
13
Added:
ok (Units.Rep_range.make ~min:(reps lo) ~max:(reps hi))
20
14
21
Removed:
let bench = by_name "Barbell Bench Press"
22
Removed:
and dumbbell_bench = by_name "Dumbbell Bench Press"
23
Removed:
and squat = by_name "Back Squat"
15
Added:
let six_to_ten = range 6 10
24
16
25
Removed:
let make_tests =
17
Added:
let single id =
18
Added:
Prescription.make
19
Added:
~delivery:(Prescription.Single (get id))
20
Added:
~rep_range:six_to_ten ~allowed_substitutes:[]
21
Added:
22
Added:
let delivery_tests =
26
23
[
27
Removed:
( "catalog substitute is accepted",
24
Added:
( "a single movement is prescribable",
28
25
`Quick,
29
26
fun () ->
30
Removed:
Alcotest.(check bool)
31
Removed:
"accepted" true
32
Removed:
(Result.is_ok
33
Removed:
(Prescription.make ~exercise:bench ~target_reps:(target_reps ())
34
Removed:
~allowed_substitutes:[ dumbbell_bench ])) );
35
Removed:
( "non-whitelisted exercise is rejected",
27
Added:
let p = ok (single "curls") in
28
Added:
match Prescription.delivery p with
29
Added:
| Prescription.Single e ->
30
Added:
Alcotest.(check string) "curls" "Curls" (Exercise.name e)
31
Added:
| Prescription.Pre_exhaust _ -> Alcotest.fail "expected Single" );
32
Added:
( "HD1's pec pre-exhaust is prescribable",
36
33
`Quick,
37
34
fun () ->
38
Removed:
Alcotest.(check bool)
39
Removed:
"rejected" true
40
Removed:
(Result.is_error
41
Removed:
(Prescription.make ~exercise:bench ~target_reps:(target_reps ())
42
Removed:
~allowed_substitutes:[ squat ])) );
43
Removed:
( "empty substitutes is always accepted",
35
Added:
let p =
36
Added:
ok
37
Added:
(Prescription.make
38
Added:
~delivery:
39
Added:
(Prescription.Pre_exhaust
40
Added:
{
41
Added:
isolation = get "dumbbell-flyes";
42
Added:
compound = get "incline-press";
43
Added:
})
44
Added:
~rep_range:six_to_ten ~allowed_substitutes:[])
45
Added:
in
46
Added:
Alcotest.(check int)
47
Added:
"two movements, isolation first" 2
48
Added:
(List.length (Prescription.exercises p));
49
Added:
Alcotest.(check string)
50
Added:
"isolation leads" "Dumbbell Flyes"
51
Added:
(Exercise.name (List.hd (Prescription.exercises p))) );
52
Added:
( "an invalid pairing is refused",
44
53
`Quick,
45
54
fun () ->
46
Removed:
Alcotest.(check bool)
47
Removed:
"accepted" true
48
Removed:
(Result.is_ok
49
Removed:
(Prescription.make ~exercise:bench ~target_reps:(target_reps ())
50
Removed:
~allowed_substitutes:[])) );
55
Added:
match
56
Added:
Prescription.make
57
Added:
~delivery:
58
Added:
(Prescription.Pre_exhaust
59
Added:
{ isolation = get "dumbbell-flyes"; compound = get "squats" })
60
Added:
~rep_range:six_to_ten ~allowed_substitutes:[]
61
Added:
with
62
Added:
| Ok _ -> Alcotest.fail "expected Error"
63
Added:
| Error (Prescription.Not_a_pre_exhaust _) -> ()
64
Added:
| Error _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
51
65
]
52
66
53
Removed:
let accessor_tests =
67
Added:
let rep_window_tests =
54
68
[
55
Removed:
( "accessors round-trip",
69
Added:
( "rep_limits is HD1's 6-12 stimulus window",
56
70
`Quick,
57
71
fun () ->
58
Removed:
let reps = target_reps () in
72
Added:
Alcotest.(check int)
73
Added:
"min 6" 6
74
Added:
(Units.Reps.to_int (Units.Rep_range.min Prescription.rep_limits));
75
Added:
Alcotest.(check int)
76
Added:
"max 12" 12
77
Added:
(Units.Reps.to_int (Units.Rep_range.max Prescription.rep_limits)) );
78
Added:
( "a window inside the limits is accepted",
79
Added:
`Quick,
80
Added:
fun () ->
81
Added:
List.iter
82
Added:
(fun (lo, hi) ->
83
Added:
Alcotest.(check bool)
84
Added:
(Printf.sprintf "%d-%d accepted" lo hi)
85
Added:
true
86
Added:
(Result.is_ok
87
Added:
(Prescription.make
88
Added:
~delivery:(Prescription.Single (get "curls"))
89
Added:
~rep_range:(range lo hi) ~allowed_substitutes:[])))
90
Added:
[ (6, 10); (6, 12); (8, 12); (8, 8) ] );
91
Added:
( "a window escaping the limits is refused",
92
Added:
`Quick,
93
Added:
fun () ->
94
Added:
List.iter
95
Added:
(fun (lo, hi) ->
96
Added:
match
97
Added:
Prescription.make
98
Added:
~delivery:(Prescription.Single (get "curls"))
99
Added:
~rep_range:(range lo hi) ~allowed_substitutes:[]
100
Added:
with
101
Added:
| Error Prescription.Reps_outside_limits -> ()
102
Added:
| Error _ -> Alcotest.fail "expected Reps_outside_limits"
103
Added:
| Ok _ -> Alcotest.failf "%d-%d should be refused" lo hi)
104
Added:
[ (3, 5); (1, 3); (15, 20); (6, 20) ] );
105
Added:
]
106
Added:
107
Added:
let substitute_tests =
108
Added:
[
109
Added:
( "a whitelisted alternative may be allowed",
110
Added:
`Quick,
111
Added:
fun () ->
59
112
let p =
60
113
ok
61
Removed:
(Prescription.make ~exercise:bench ~target_reps:reps
62
Removed:
~allowed_substitutes:[ dumbbell_bench ])
114
Added:
(Prescription.make
115
Added:
~delivery:(Prescription.Single (get "dumbbell-flyes"))
116
Added:
~rep_range:six_to_ten
117
Added:
~allowed_substitutes:[ get "pec-deck" ])
63
118
in
64
119
Alcotest.(check bool)
65
Removed:
"exercise" true
66
Removed:
(Exercise.equal (Prescription.exercise p) bench);
120
Added:
"pec deck permitted" true
121
Added:
(Prescription.permits p (get "pec-deck"));
67
122
Alcotest.(check bool)
68
Removed:
"target_reps" true
69
Removed:
(Units.Rep_range.equal (Prescription.target_reps p) reps);
70
Removed:
Alcotest.(check int)
71
Removed:
"substitutes" 1
72
Removed:
(List.length (Prescription.allowed_substitutes p)) );
123
Added:
"flyes permitted" true
124
Added:
(Prescription.permits p (get "dumbbell-flyes"));
125
Added:
Alcotest.(check bool)
126
Added:
"squats not permitted" false
127
Added:
(Prescription.permits p (get "squats")) );
128
Added:
( "a substitute off the catalog whitelist is refused",
129
Added:
`Quick,
130
Added:
fun () ->
131
Added:
match
132
Added:
Prescription.make
133
Added:
~delivery:(Prescription.Single (get "dumbbell-flyes"))
134
Added:
~rep_range:six_to_ten
135
Added:
~allowed_substitutes:[ get "squats" ]
136
Added:
with
137
Added:
| Error (Prescription.Substitute_not_permitted id) ->
138
Added:
Alcotest.(check string) "squats" "squats" (id :> string)
139
Added:
| Error _ -> Alcotest.fail "expected Substitute_not_permitted"
140
Added:
| Ok _ -> Alcotest.fail "expected Error" );
141
Added:
( "a substitute for either half of a pre-exhaust is allowed",
142
Added:
`Quick,
143
Added:
fun () ->
144
Added:
Alcotest.(check bool)
145
Added:
"pec deck substitutes the isolation" true
146
Added:
(Result.is_ok
147
Added:
(Prescription.make
148
Added:
~delivery:
149
Added:
(Prescription.Pre_exhaust
150
Added:
{
151
Added:
isolation = get "dumbbell-flyes";
152
Added:
compound = get "incline-press";
153
Added:
})
154
Added:
~rep_range:six_to_ten
155
Added:
~allowed_substitutes:[ get "cable-crossovers" ])) );
73
156
]
74
157
75
158
let suite =
76
159
[
77
Removed:
("prescription.make", make_tests); ("prescription.accessors", accessor_tests);
160
Added:
("prescription.delivery", delivery_tests);
161
Added:
("prescription.rep_window", rep_window_tests);
162
Added:
("prescription.substitutes", substitute_tests);
78
163
]