[OCaml] High Intensity Training Online
feat implement evaluate, classify, guide, prescribe
evaluate/beats compare only the two most recent samples (evidence is oldest-first, so the tail of List.rev). classify/guide implement the rep-band rule: add reps while under the band's top, add load and reset to its bottom once at or past it. Judgment call, flagging per your standing instruction: Add_load raises the load by a fixed 2.5 kg (load_increment_kg), since HD doctrine prescribes no universal increment and a percentage compounds oddly at low loads. This is a named constant, one place to change if you want a different default or a percentage-based scheme instead. prescribe's empty-evidence case defaults to Add_reps at Weight.zero — untested, since there is no sample to build a meaningful default from; worth revisiting once app-layer callers exist to see what they actually need for a first-ever prescription. Extended test_progression.ml (predated classify/guide/prescribe/volume) rather than replacing it, since its evaluate/beats coverage still holds. 45 tests total.
Changed files
lib/core/progression.ml
@@ -1,30 +1,95 @@
1
Removed:
(* Minimal stubs only; implementation deferred until after the review gate. *)
2
Removed:
3
1
type t = Progressing | Stalled
4
2
5
Removed:
let equal _ _ = failwith "TODO"
6
Removed:
let pp _ _ = failwith "TODO"
3
Added:
let equal a b = a = b
7
4
5
Added:
let pp fmt = function
6
Added:
| Progressing -> Format.pp_print_string fmt "Progressing"
7
Added:
| Stalled -> Format.pp_print_string fmt "Stalled"
8
Added:
8
9
type sample = Set.Working.performance
9
10
type error = Insufficient_data
10
11
11
Removed:
let evaluate ~history:_ = failwith "TODO"
12
Removed:
let beats ~previous:_ ~current:_ = failwith "TODO"
12
Added:
let beats ~previous ~current =
13
Added:
let cmp =
14
Added:
Units.Weight.compare current.Set.Working.load previous.Set.Working.load
15
Added:
in
16
Added:
cmp > 0
17
Added:
|| cmp = 0
18
Added:
&& Units.Reps.to_int current.Set.Working.reps
19
Added:
> Units.Reps.to_int previous.Set.Working.reps
13
20
21
Added:
let evaluate ~history =
22
Added:
match List.rev history with
23
Added:
| current :: previous :: _ ->
24
Added:
Ok (if beats ~previous ~current then Progressing else Stalled)
25
Added:
| _ -> Error Insufficient_data
26
Added:
14
27
type band = Below_range | In_range | Above_range
15
28
16
Removed:
let classify ~target_reps:_ _ = failwith "TODO"
29
Added:
let classify ~target_reps sample =
30
Added:
let reps = Units.Reps.to_int sample.Set.Working.reps in
31
Added:
let lo = Units.Reps.to_int (Units.Rep_range.min target_reps) in
32
Added:
let hi = Units.Reps.to_int (Units.Rep_range.max target_reps) in
33
Added:
if reps < lo then Below_range else if reps > hi then Above_range else In_range
17
34
18
35
type target =
19
36
| Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
20
37
| Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
21
38
22
Removed:
type guidance = { band : band; next : target } [@@warning "-69"]
39
Added:
(* No universal load increment is prescribed by HD doctrine; 2.5 kg is the
40
Added:
smallest plate increment available in most gyms. *)
41
Added:
let load_increment_kg = 2.5
23
42
24
Removed:
let guide ~target_reps:_ _ = failwith "TODO"
43
Added:
let next_target ~target_reps (sample : sample) =
44
Added:
let hi = Units.Rep_range.max target_reps in
45
Added:
if Units.Reps.to_int sample.reps < Units.Reps.to_int hi then
46
Added:
let min_reps =
47
Added:
match Units.Reps.of_int (Units.Reps.to_int sample.reps + 1) with
48
Added:
| Ok r -> r
49
Added:
| Error _ -> hi
50
Added:
in
51
Added:
Add_reps { load = sample.load; min_reps }
52
Added:
else
53
Added:
let min_load =
54
Added:
match
55
Added:
Units.Weight.of_kg (Units.Weight.to_kg sample.load +. load_increment_kg)
56
Added:
with
57
Added:
| Ok w -> w
58
Added:
| Error _ -> sample.load
59
Added:
in
60
Added:
Add_load { min_load; reps = Units.Rep_range.min target_reps }
25
61
62
Added:
type guidance = { band : band; next : target }
63
Added:
64
Added:
let guide ~target_reps sample =
65
Added:
{
66
Added:
band = classify ~target_reps sample;
67
Added:
next = next_target ~target_reps sample;
68
Added:
}
69
Added:
26
70
type 'a prescribed = { value : 'a; evidence : sample list; status : t }
27
Removed:
[@@warning "-69"]
28
71
29
Removed:
let prescribe ~target_reps:_ ~evidence:_ = failwith "TODO"
30
Removed:
let volume _ = failwith "TODO"
72
Added:
let prescribe ~target_reps ~evidence =
73
Added:
let status =
74
Added:
match evaluate ~history:evidence with
75
Added:
| Ok s -> s
76
Added:
| Error Insufficient_data -> Progressing
77
Added:
in
78
Added:
let value =
79
Added:
match List.rev evidence with
80
Added:
| latest :: _ -> next_target ~target_reps latest
81
Added:
| [] ->
82
Added:
Add_reps
83
Added:
{
84
Added:
load = Units.Weight.zero;
85
Added:
min_reps = Units.Rep_range.min target_reps;
86
Added:
}
87
Added:
in
88
Added:
{ value; evidence; status }
89
Added:
90
Added:
let volume samples =
91
Added:
List.fold_left
92
Added:
(fun acc (s : sample) ->
93
Added:
acc
94
Added:
+. (Units.Weight.to_kg s.load *. float_of_int (Units.Reps.to_int s.reps)))
95
Added:
0.0 samples
test/test_hito.ml
@@ -4,4 +4,5 @@
4
4
let () =
5
5
Alcotest.run "hito"
6
6
(Test_units.suite @ Test_exercise.suite @ Test_set.suite
7
Removed:
@ Test_set_group.suite @ Test_prescription.suite @ Test_routine.suite)
7
Added:
@ Test_set_group.suite @ Test_prescription.suite @ Test_routine.suite
8
Added:
@ Test_progression.suite)
test/test_progression.ml
@@ -46,3 +46,121 @@
46
46
]
47
47
48
48
let suite = [ ("progression.evaluate", progression_tests) ]
49
Added:
50
Added:
let band_tests =
51
Added:
let target_reps =
52
Added:
Units.Rep_range.make
53
Added:
~min:(ok (Units.Reps.of_int 6))
54
Added:
~max:(ok (Units.Reps.of_int 8))
55
Added:
|> ok
56
Added:
in
57
Added:
[
58
Added:
( "below the band is Below_range",
59
Added:
`Quick,
60
Added:
fun () ->
61
Added:
Alcotest.(check bool)
62
Added:
"below" true
63
Added:
(Progression.classify ~target_reps (sample 80.0 4)
64
Added:
= Progression.Below_range) );
65
Added:
( "within the band is In_range",
66
Added:
`Quick,
67
Added:
fun () ->
68
Added:
Alcotest.(check bool)
69
Added:
"in range" true
70
Added:
(Progression.classify ~target_reps (sample 80.0 7)
71
Added:
= Progression.In_range) );
72
Added:
( "above the band is Above_range",
73
Added:
`Quick,
74
Added:
fun () ->
75
Added:
Alcotest.(check bool)
76
Added:
"above" true
77
Added:
(Progression.classify ~target_reps (sample 80.0 9)
78
Added:
= Progression.Above_range) );
79
Added:
]
80
Added:
81
Added:
let guide_tests =
82
Added:
let target_reps =
83
Added:
Units.Rep_range.make
84
Added:
~min:(ok (Units.Reps.of_int 6))
85
Added:
~max:(ok (Units.Reps.of_int 8))
86
Added:
|> ok
87
Added:
in
88
Added:
[
89
Added:
( "under the band top: next target adds a rep at the same load",
90
Added:
`Quick,
91
Added:
fun () ->
92
Added:
let g = Progression.guide ~target_reps (sample 80.0 6) in
93
Added:
match g.next with
94
Added:
| Progression.Add_reps { load; min_reps } ->
95
Added:
Alcotest.(check (float 0.0001))
96
Added:
"same load" 80.0 (Units.Weight.to_kg load);
97
Added:
Alcotest.(check int) "one more rep" 7 (Units.Reps.to_int min_reps)
98
Added:
| Add_load _ -> Alcotest.fail "expected Add_reps" );
99
Added:
( "at the band top: next target adds load and resets to the bottom",
100
Added:
`Quick,
101
Added:
fun () ->
102
Added:
let g = Progression.guide ~target_reps (sample 80.0 8) in
103
Added:
match g.next with
104
Added:
| Progression.Add_load { min_load; reps } ->
105
Added:
Alcotest.(check bool)
106
Added:
"load increased" true
107
Added:
(Units.Weight.to_kg min_load > 80.0);
108
Added:
Alcotest.(check int)
109
Added:
"resets to band bottom" 6 (Units.Reps.to_int reps)
110
Added:
| Add_reps _ -> Alcotest.fail "expected Add_load" );
111
Added:
( "past the band: next target adds load too",
112
Added:
`Quick,
113
Added:
fun () ->
114
Added:
let g = Progression.guide ~target_reps (sample 80.0 9) in
115
Added:
match g.next with
116
Added:
| Progression.Add_load _ -> ()
117
Added:
| Add_reps _ -> Alcotest.fail "expected Add_load" );
118
Added:
]
119
Added:
120
Added:
let prescribe_tests =
121
Added:
let target_reps =
122
Added:
Units.Rep_range.make
123
Added:
~min:(ok (Units.Reps.of_int 6))
124
Added:
~max:(ok (Units.Reps.of_int 8))
125
Added:
|> ok
126
Added:
in
127
Added:
[
128
Added:
( "prescribe carries the evidence it was derived from",
129
Added:
`Quick,
130
Added:
fun () ->
131
Added:
let evidence = [ sample 80.0 6; sample 82.5 6 ] in
132
Added:
let p = Progression.prescribe ~target_reps ~evidence in
133
Added:
Alcotest.(check int)
134
Added:
"evidence retained" 2
135
Added:
(List.length p.Progression.evidence) );
136
Added:
( "prescribe's status matches evaluate",
137
Added:
`Quick,
138
Added:
fun () ->
139
Added:
let evidence = [ sample 80.0 6; sample 82.5 6 ] in
140
Added:
let p = Progression.prescribe ~target_reps ~evidence in
141
Added:
Alcotest.(check bool)
142
Added:
"progressing" true
143
Added:
(p.Progression.status = Progression.Progressing) );
144
Added:
]
145
Added:
146
Added:
let volume_tests =
147
Added:
[
148
Added:
( "volume sums load times reps",
149
Added:
`Quick,
150
Added:
fun () ->
151
Added:
let v = Progression.volume [ sample 80.0 6; sample 20.0 12 ] in
152
Added:
Alcotest.(check (float 0.0001)) "volume" 720.0 v );
153
Added:
( "empty history has zero volume",
154
Added:
`Quick,
155
Added:
fun () ->
156
Added:
Alcotest.(check (float 0.0001)) "zero" 0.0 (Progression.volume []) );
157
Added:
]
158
Added:
159
Added:
let suite =
160
Added:
suite
161
Added:
@ [
162
Added:
("progression.band", band_tests);
163
Added:
("progression.guide", guide_tests);
164
Added:
("progression.prescribe", prescribe_tests);
165
Added:
("progression.volume", volume_tests);
166
Added:
]