[OCaml] High Intensity Training Online
feat implement Routine with HD1's Ideal Routine preset
A routine is the sequence of prescribed workouts cycled through over time. workout_after advances by identity and wraps, so rotation follows from what was last performed rather than from a count of workouts done. Rest is not one flat interval. HD1 prescribes training every other day and then two full days off at the conclusion of each three-day cycle, so recovery_after returns 48h mid-cycle and 72h once the cycle completes. Both intervals are exposed rather than buried, on the same principle as Prescription.rep_limits: a sourced rule should be visible and testable. The Ideal Routine preset follows HD1's own listing, and its supersets are all genuine isolation-into-compound pre-exhausts: flyes into incline press and french press into dips on Day 1, pullovers into close-grip pulldowns on Day 2, leg extensions into leg press on Day 3. An earlier version of this preset invented a back/biceps antagonist superset for Day 2; HD1 has no such thing. Substitutions come from its own "or" lists. consolidation_routine is dropped: it is HD2 material and this rebuild takes only what HD1 states. 64 Alcotests. The suite exercises the preset, so a malformed preset fails loudly rather than silently.
Changed files
lib/core/dune
@@ -5,5 +5,12 @@
5
5
(library
6
6
(name hito_core)
7
7
(public_name hito.core)
8
Removed:
(modules units muscle exercise recovery prescription workout_prescription)
8
Added:
(modules
9
Added:
units
10
Added:
muscle
11
Added:
exercise
12
Added:
recovery
13
Added:
prescription
14
Added:
workout_prescription
15
Added:
routine)
9
16
(wrapped false))
lib/core/routine.ml
@@ -1,16 +1,105 @@
1
Removed:
(* Blank slate: stub only. Interface (routine.mli) is the design surface. *)
2
Removed:
3
Removed:
type t = unit
4
1
type error = Empty_routine
2
Added:
type t = { name : string; workouts : Workout_prescription.t list }
5
3
6
Removed:
let make ~name:_ ~workouts:_ = failwith "TODO"
7
Removed:
let name _ = failwith "TODO"
8
Removed:
let workouts _ = failwith "TODO"
9
Removed:
let workout_after _ _ = failwith "TODO"
10
Removed:
let recovery_base _ = failwith "TODO"
11
Removed:
let pp _ _ = failwith "TODO"
4
Added:
let make ~name ~workouts =
5
Added:
match workouts with [] -> Error Empty_routine | _ -> Ok { name; workouts }
12
6
13
Removed:
(* Presets are values of type [t = unit]; kept as unit placeholders so the
14
Removed:
module loads without evaluating a [failwith]. *)
15
Removed:
let ideal_routine = ()
16
Removed:
let consolidation_routine = ()
7
Added:
let name t = t.name
8
Added:
let workouts t = t.workouts
9
Added:
let pp ppf t = Format.pp_print_string ppf t.name
10
Added:
11
Added:
let workout_after t performed =
12
Added:
let rec next = function
13
Added:
| [] | [ _ ] -> List.hd t.workouts
14
Added:
| w :: (following :: _ as rest) ->
15
Added:
if Workout_prescription.equal w performed then following else next rest
16
Added:
in
17
Added:
next t.workouts
18
Added:
19
Added:
let training_interval = Recovery.hours 48
20
Added:
let cycle_rest = Recovery.hours 72
21
Added:
22
Added:
let recovery_after t performed =
23
Added:
match List.rev t.workouts with
24
Added:
| last :: _ when Workout_prescription.equal last performed -> cycle_rest
25
Added:
| _ -> training_interval
26
Added:
27
Added:
(* {1 The Ideal Routine} *)
28
Added:
29
Added:
let preset_exn pp = function
30
Added:
| Ok v -> v
31
Added:
| Error e -> invalid_arg (Format.asprintf "Routine preset: %a" pp e)
32
Added:
33
Added:
let movement id =
34
Added:
match Exercise.find id with
35
Added:
| Some e -> e
36
Added:
| None -> invalid_arg (Format.sprintf "Routine preset: no exercise %S" id)
37
Added:
38
Added:
(* HD1's guideline window for every listed exercise. *)
39
Added:
let six_to_ten =
40
Added:
let reps n =
41
Added:
match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
42
Added:
in
43
Added:
match Units.Rep_range.make ~min:(reps 6) ~max:(reps 10) with
44
Added:
| Ok r -> r
45
Added:
| Error _ -> assert false
46
Added:
47
Added:
let prescribe ?(substitutes = []) delivery =
48
Added:
preset_exn Prescription.pp_error
49
Added:
(Prescription.make ~delivery ~rep_range:six_to_ten
50
Added:
~allowed_substitutes:(List.map movement substitutes))
51
Added:
52
Added:
let single ?substitutes id =
53
Added:
prescribe ?substitutes (Prescription.Single (movement id))
54
Added:
55
Added:
let pre_exhaust ?substitutes ~isolation ~compound () =
56
Added:
prescribe ?substitutes
57
Added:
(Prescription.Pre_exhaust
58
Added:
{ isolation = movement isolation; compound = movement compound })
59
Added:
60
Added:
let workout ~id ~name prescriptions =
61
Added:
preset_exn
62
Added:
(fun ppf Workout_prescription.Empty_workout ->
63
Added:
Format.pp_print_string ppf "empty workout")
64
Added:
(Workout_prescription.make ~id ~name ~prescriptions)
65
Added:
66
Added:
let ideal_day_one =
67
Added:
workout ~id:"ideal-day-1" ~name:"Day 1"
68
Added:
[
69
Added:
pre_exhaust
70
Added:
~substitutes:[ "cable-crossovers"; "pec-deck" ]
71
Added:
~isolation:"dumbbell-flyes" ~compound:"incline-press" ();
72
Added:
single "laterals";
73
Added:
single ~substitutes:[ "reverse-pec-deck" ] "bent-over-laterals";
74
Added:
pre_exhaust
75
Added:
~substitutes:[ "pressdowns"; "triceps-machine" ]
76
Added:
~isolation:"lying-french-press" ~compound:"dips" ();
77
Added:
]
78
Added:
79
Added:
let ideal_day_two =
80
Added:
workout ~id:"ideal-day-2" ~name:"Day 2"
81
Added:
[
82
Added:
pre_exhaust
83
Added:
~substitutes:[ "straight-arm-pulldowns" ]
84
Added:
~isolation:"pullovers" ~compound:"close-grip-pulldowns" ();
85
Added:
single "bent-over-rows";
86
Added:
single "shrugs";
87
Added:
single ~substitutes:[ "deadlifts" ] "hyperextensions";
88
Added:
single ~substitutes:[ "preacher-curls" ] "curls";
89
Added:
]
90
Added:
91
Added:
let ideal_day_three =
92
Added:
workout ~id:"ideal-day-3" ~name:"Day 3"
93
Added:
[
94
Added:
pre_exhaust ~substitutes:[ "squats" ] ~isolation:"leg-extensions"
95
Added:
~compound:"leg-presses" ();
96
Added:
single "leg-curls";
97
Added:
single "calf-raises";
98
Added:
single "sit-ups";
99
Added:
]
100
Added:
101
Added:
let ideal_routine =
102
Added:
preset_exn
103
Added:
(fun ppf Empty_routine -> Format.pp_print_string ppf "empty routine")
104
Added:
(make ~name:"Ideal Routine"
105
Added:
~workouts:[ ideal_day_one; ideal_day_two; ideal_day_three ])
lib/core/routine.mli
@@ -1,26 +1,44 @@
1
Removed:
(** A routine is a sequence of prescribed workouts cycled through over time —
2
Removed:
the Ideal Routine is a three-way split, Consolidation a two-way one. Purely
3
Removed:
a template: no targets, no history. *)
1
Added:
(** A routine: the sequence of prescribed workouts cycled through over time, and
2
Added:
how long to rest between them.
4
3
4
Added:
A routine prescribes; it never judges. What the evidence says about it is
5
Added:
{!Progression}'s business. *)
6
Added:
5
7
type t
6
8
type error = Empty_routine
7
9
8
10
val make :
9
11
name:string -> workouts:Workout_prescription.t list -> (t, error) result
12
Added:
(** [Error Empty_routine] if [workouts] is empty. *)
10
13
11
14
val name : t -> string
15
Added:
12
16
val workouts : t -> Workout_prescription.t list
17
Added:
(** In cycle order. *)
13
18
14
19
val workout_after : t -> Workout_prescription.t -> Workout_prescription.t
15
Removed:
(** The next workout in the cycle after the given one, wrapping around. Falls
16
Removed:
back to the first workout if the argument is not part of this routine. *)
20
Added:
(** The next workout in the cycle, wrapping at the end. Falls back to the first
21
Added:
workout when [t] does not contain the one given. *)
17
22
18
Removed:
val recovery_base : t -> Recovery.duration
19
Removed:
(** Nominal rest between workouts; Consolidation rests longer than Ideal. *)
20
Removed:
21
23
val pp : Format.formatter -> t -> unit
22
24
23
Removed:
(** {1 Heavy Duty presets} *)
25
Added:
(** {1 Rest between workouts}
24
26
27
Added:
HD1 prescribes training every other day, then two full days off at the
28
Added:
conclusion of each cycle — so the recommended rest depends on where in the
29
Added:
cycle you are, and is not one flat interval. *)
30
Added:
31
Added:
val training_interval : Recovery.duration
32
Added:
(** 48h: every other day, within a cycle. *)
33
Added:
34
Added:
val cycle_rest : Recovery.duration
35
Added:
(** 72h: the two days off once the cycle completes. *)
36
Added:
37
Added:
val recovery_after : t -> Workout_prescription.t -> Recovery.duration
38
Added:
(** How long to rest having performed that workout. *)
39
Added:
40
Added:
(** {1 Presets} *)
41
Added:
25
42
val ideal_routine : t
26
Removed:
val consolidation_routine : t
43
Added:
(** HD1's Ideal Routine, three workouts: pecs/delts/triceps, then
44
Added:
lats/traps/erectors/biceps, then legs/abs. *)
test/dune
@@ -10,5 +10,6 @@
10
10
test_exercise
11
11
test_prescription
12
12
test_workout_prescription
13
Added:
test_routine
13
14
test_recovery)
14
15
(libraries hito.core alcotest))
test/test_hito.ml
@@ -5,4 +5,4 @@
5
5
Alcotest.run "hito"
6
6
(Test_units.suite @ Test_muscle.suite @ Test_exercise.suite
7
7
@ Test_prescription.suite @ Test_workout_prescription.suite
8
Removed:
@ Test_recovery.suite)
8
Added:
@ Test_routine.suite @ Test_recovery.suite)
test/test_routine.ml
@@ -1,59 +1,135 @@
1
Removed:
(** Unit tests for {!Routine}, authored against routine.mli.
1
Added:
(** Unit tests for {!Routine}. *)
2
2
3
Removed:
A routine is a sequence of prescribed workouts rotated through, not a flat
4
Removed:
list of exercises. *)
3
Added:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Added:
let secs = Recovery.duration_to_seconds
5
Added:
let ideal = Routine.ideal_routine
6
Added:
let days = Routine.workouts ideal
5
7
6
Removed:
let preset_tests =
8
Added:
let nth n =
9
Added:
match List.nth_opt days n with
10
Added:
| Some w -> w
11
Added:
| None -> Alcotest.failf "Ideal Routine has no workout %d" n
12
Added:
13
Added:
let construction_tests =
7
14
[
8
Removed:
( "ideal routine cycles several workouts",
15
Added:
( "an empty routine is refused",
9
16
`Quick,
10
17
fun () ->
11
Removed:
Alcotest.(check bool)
12
Removed:
"more than one workout" true
13
Removed:
(List.length (Routine.workouts Routine.ideal_routine) > 1) );
14
Removed:
( "consolidation routine has workouts",
18
Added:
match Routine.make ~name:"Nothing" ~workouts:[] with
19
Added:
| Error Routine.Empty_routine -> ()
20
Added:
| Ok _ -> Alcotest.fail "expected Empty_routine" );
21
Added:
( "the Ideal Routine is HD1's three days",
15
22
`Quick,
16
23
fun () ->
17
Removed:
Alcotest.(check bool)
18
Removed:
"non-empty" true
19
Removed:
(List.length (Routine.workouts Routine.consolidation_routine) > 0) );
20
Removed:
( "every workout prescribes at least one set group",
24
Added:
Alcotest.(check string) "name" "Ideal Routine" (Routine.name ideal);
25
Added:
Alcotest.(check int) "three workouts" 3 (List.length days);
26
Added:
Alcotest.(check (list string))
27
Added:
"in order"
28
Added:
[ "Day 1"; "Day 2"; "Day 3" ]
29
Added:
(List.map Workout_prescription.name days) );
30
Added:
( "each day prescribes the movements HD1 lists",
21
31
`Quick,
22
32
fun () ->
23
Removed:
List.iter
24
Removed:
(fun w ->
25
Removed:
Alcotest.(check bool)
26
Removed:
"workout non-empty" true
27
Removed:
(List.length (Workout_prescription.set_groups w) > 0))
28
Removed:
(Routine.workouts Routine.ideal_routine) );
29
Removed:
( "rotation advances then wraps around the cycle",
33
Added:
Alcotest.(check (list int))
34
Added:
"stimuli per day" [ 4; 5; 4 ]
35
Added:
(List.map
36
Added:
(fun w -> List.length (Workout_prescription.prescriptions w))
37
Added:
days) );
38
Added:
( "Day 1 opens with the pec pre-exhaust and closes with the triceps one",
30
39
`Quick,
31
40
fun () ->
32
Removed:
let r = Routine.ideal_routine in
33
Removed:
let workouts = Routine.workouts r in
34
Removed:
let first = List.hd workouts in
35
Removed:
let second = Routine.workout_after r first in
36
Removed:
Alcotest.(check bool)
37
Removed:
"advances" false
38
Removed:
(Workout_prescription.equal first second);
39
Removed:
(* Stepping through the whole cycle returns to the first. *)
40
Removed:
let n = List.length workouts in
41
Removed:
let rec step w i =
42
Removed:
if i = 0 then w else step (Routine.workout_after r w) (i - 1)
41
Added:
let ps = Workout_prescription.prescriptions (nth 0) in
42
Added:
let names p = List.map Exercise.name (Prescription.exercises p) in
43
Added:
Alcotest.(check (list string))
44
Added:
"flyes into incline press"
45
Added:
[ "Dumbbell Flyes"; "Incline Presses" ]
46
Added:
(names (List.hd ps));
47
Added:
Alcotest.(check (list string))
48
Added:
"french press into dips"
49
Added:
[ "Lying French Presses"; "Dips" ]
50
Added:
(names (List.nth ps 3)) );
51
Added:
( "Day 2's superset is the lat pre-exhaust, not an antagonist pairing",
52
Added:
`Quick,
53
Added:
fun () ->
54
Added:
let ps = Workout_prescription.prescriptions (nth 1) in
55
Added:
match Prescription.delivery (List.hd ps) with
56
Added:
| Prescription.Pre_exhaust { isolation; compound } ->
57
Added:
Alcotest.(check string)
58
Added:
"isolation" "Pullovers" (Exercise.name isolation);
59
Added:
Alcotest.(check string)
60
Added:
"compound" "Close-grip, palms-up Pulldowns"
61
Added:
(Exercise.name compound)
62
Added:
| Prescription.Single _ -> Alcotest.fail "expected a pre-exhaust" );
63
Added:
( "HD1's alternatives are permitted where it offers them",
64
Added:
`Quick,
65
Added:
fun () ->
66
Added:
let get id =
67
Added:
match Exercise.find id with
68
Added:
| Some e -> e
69
Added:
| None -> Alcotest.failf "no exercise %S" id
43
70
in
71
Added:
let legs = List.hd (Workout_prescription.prescriptions (nth 2)) in
44
72
Alcotest.(check bool)
45
Removed:
"wraps after a full cycle" true
46
Removed:
(Workout_prescription.equal first (step first n)) );
73
Added:
"squats may replace the leg press" true
74
Added:
(Prescription.permits legs (get "squats"));
75
Added:
let pecs = List.hd (Workout_prescription.prescriptions (nth 0)) in
76
Added:
Alcotest.(check bool)
77
Added:
"pec deck may replace flyes" true
78
Added:
(Prescription.permits pecs (get "pec-deck")) );
47
79
]
48
80
49
Removed:
let make_tests =
81
Added:
let rotation_tests =
50
82
[
51
Removed:
( "empty routine rejected",
83
Added:
( "the cycle advances and wraps",
52
84
`Quick,
53
85
fun () ->
54
Removed:
Alcotest.(check bool)
55
Removed:
"empty rejected" true
56
Removed:
(Result.is_error (Routine.make ~name:"Empty" ~workouts:[])) );
86
Added:
let name w = Workout_prescription.name w in
87
Added:
Alcotest.(check string)
88
Added:
"1 -> 2" "Day 2"
89
Added:
(name (Routine.workout_after ideal (nth 0)));
90
Added:
Alcotest.(check string)
91
Added:
"2 -> 3" "Day 3"
92
Added:
(name (Routine.workout_after ideal (nth 1)));
93
Added:
Alcotest.(check string)
94
Added:
"3 wraps to 1" "Day 1"
95
Added:
(name (Routine.workout_after ideal (nth 2))) );
96
Added:
( "an unknown workout falls back to the start of the cycle",
97
Added:
`Quick,
98
Added:
fun () ->
99
Added:
let stranger =
100
Added:
ok
101
Added:
(Workout_prescription.make ~id:"elsewhere" ~name:"Elsewhere"
102
Added:
~prescriptions:(Workout_prescription.prescriptions (nth 0)))
103
Added:
in
104
Added:
Alcotest.(check string)
105
Added:
"falls back" "Day 1"
106
Added:
(Workout_prescription.name (Routine.workout_after ideal stranger)) );
57
107
]
58
108
59
Removed:
let suite = [ ("routine.presets", preset_tests); ("routine.make", make_tests) ]
109
Added:
let rest_tests =
110
Added:
[
111
Added:
( "HD1's intervals are every other day, then two days off",
112
Added:
`Quick,
113
Added:
fun () ->
114
Added:
Alcotest.(check int) "48h" 172_800 (secs Routine.training_interval);
115
Added:
Alcotest.(check int) "72h" 259_200 (secs Routine.cycle_rest) );
116
Added:
( "rest within the cycle is 48h, and 72h once it completes",
117
Added:
`Quick,
118
Added:
fun () ->
119
Added:
Alcotest.(check int)
120
Added:
"after Day 1" 172_800
121
Added:
(secs (Routine.recovery_after ideal (nth 0)));
122
Added:
Alcotest.(check int)
123
Added:
"after Day 2" 172_800
124
Added:
(secs (Routine.recovery_after ideal (nth 1)));
125
Added:
Alcotest.(check int)
126
Added:
"after Day 3" 259_200
127
Added:
(secs (Routine.recovery_after ideal (nth 2))) );
128
Added:
]
129
Added:
130
Added:
let suite =
131
Added:
[
132
Added:
("routine.construction", construction_tests);
133
Added:
("routine.rotation", rotation_tests);
134
Added:
("routine.rest", rest_tests);
135
Added:
]