[OCaml] High Intensity Training Online
feat implement Muscle and Exercise with pre-exhaust validation
Muscle is a closed variant of the thirteen targets HD1 names. It exists only so a pre-exhaust pairing can be checked; nothing else consults it. Exercise gains a mechanic (Isolation | Compound) and the set of muscles a movement works, which together make may_pre_exhaust decidable: the isolation's target must be among the compound's muscles, and the compound must involve at least one further muscle able to serve the pre-exhausted target once it gives out. Muscles are a set rather than a single primary because HD1 uses one compound for two different pairings: Dips is the compound both for triceps (Day 1, "Lying French Presses ... supersetted with Dips") and for pecs (ch. 5, "a compound exercise, such as Dips or Incline Presses"). A singular primary would have made one of Mentzer's own prescriptions unrepresentable. The catalog holds the 27 movements HD1 names, and substitution whitelists are expressed as mutually-substitutable groups taken from its own "or" lists, which makes symmetry structural rather than asserted. 32 Alcotests, including the pairings HD1 prescribes and the three shapes it forbids.
Changed files
lib/core/dune
@@ -5,5 +5,5 @@
5
5
(library
6
6
(name hito_core)
7
7
(public_name hito.core)
8
Removed:
(modules units exercise recovery prescription)
8
Added:
(modules units muscle exercise recovery prescription)
9
9
(wrapped false))
lib/core/exercise.ml
@@ -1,17 +1,113 @@
1
Removed:
(* Blank slate: stub only. Interface (exercise.mli) is the design surface. *)
2
Removed:
3
1
type id = string
4
Removed:
type t = unit
2
Added:
type mechanic = Isolation | Compound
5
3
6
Removed:
let id _ = failwith "TODO"
7
Removed:
let name _ = failwith "TODO"
8
Removed:
let equal _ _ = failwith "TODO"
9
Removed:
let pp _ _ = failwith "TODO"
10
Removed:
let catalog = []
11
Removed:
let find _ = failwith "TODO"
4
Added:
type t = {
5
Added:
id : id;
6
Added:
name : string;
7
Added:
mechanic : mechanic;
8
Added:
muscles : Muscle.t list;
9
Added:
}
12
10
11
Added:
let id t = t.id
12
Added:
let name t = t.name
13
Added:
let mechanic t = t.mechanic
14
Added:
let muscles t = t.muscles
15
Added:
let equal a b = String.equal a.id b.id
16
Added:
let pp ppf t = Format.pp_print_string ppf t.name
17
Added:
18
Added:
let iso id name muscle =
19
Added:
{ id; name; mechanic = Isolation; muscles = [ muscle ] }
20
Added:
21
Added:
let comp id name muscles = { id; name; mechanic = Compound; muscles }
22
Added:
23
Added:
(* The movements HD1 names, in the order its Ideal Routine introduces them.
24
Added:
Compound muscle lists put the chiefly-worked muscle first, followed by the
25
Added:
assisting muscles that HD1's weak-link discussion identifies. *)
26
Added:
let catalog =
27
Added:
[
28
Added:
(* Day 1 — pecs, delts, triceps *)
29
Added:
iso "dumbbell-flyes" "Dumbbell Flyes" Muscle.Pecs;
30
Added:
iso "cable-crossovers" "Cable Crossovers" Muscle.Pecs;
31
Added:
iso "pec-deck" "Pec Deck" Muscle.Pecs;
32
Added:
comp "incline-press" "Incline Presses"
33
Added:
[ Muscle.Pecs; Muscle.Delts; Muscle.Triceps ];
34
Added:
iso "laterals" "Laterals" Muscle.Delts;
35
Added:
iso "bent-over-laterals" "Bent-over Dumbbell Laterals" Muscle.Delts;
36
Added:
iso "reverse-pec-deck" "Pec Deck (rear delts)" Muscle.Delts;
37
Added:
iso "lying-french-press" "Lying French Presses" Muscle.Triceps;
38
Added:
iso "pressdowns" "Pressdowns" Muscle.Triceps;
39
Added:
iso "triceps-machine" "Triceps Machine" Muscle.Triceps;
40
Added:
comp "dips" "Dips" [ Muscle.Triceps; Muscle.Pecs; Muscle.Delts ];
41
Added:
(* Day 2 — lats, traps, erectors, biceps *)
42
Added:
iso "pullovers" "Pullovers" Muscle.Lats;
43
Added:
iso "straight-arm-pulldowns" "Straight-Arm Pulldowns" Muscle.Lats;
44
Added:
comp "close-grip-pulldowns" "Close-grip, palms-up Pulldowns"
45
Added:
[ Muscle.Lats; Muscle.Biceps; Muscle.Forearms ];
46
Added:
comp "bent-over-rows" "Bent-over Barbell Rows"
47
Added:
[ Muscle.Lats; Muscle.Biceps; Muscle.Forearms; Muscle.Erectors ];
48
Added:
comp "chins" "Chins" [ Muscle.Lats; Muscle.Biceps; Muscle.Forearms ];
49
Added:
iso "shrugs" "Shrugs" Muscle.Traps;
50
Added:
iso "hyperextensions" "Hyperextensions" Muscle.Erectors;
51
Added:
comp "deadlifts" "Deadlifts"
52
Added:
[
53
Added:
Muscle.Erectors;
54
Added:
Muscle.Glutes;
55
Added:
Muscle.Hamstrings;
56
Added:
Muscle.Quadriceps;
57
Added:
Muscle.Traps;
58
Added:
];
59
Added:
iso "curls" "Curls" Muscle.Biceps;
60
Added:
iso "preacher-curls" "Preacher Curls" Muscle.Biceps;
61
Added:
(* Day 3 — legs, abs *)
62
Added:
iso "leg-extensions" "Leg Extensions" Muscle.Quadriceps;
63
Added:
comp "leg-presses" "Leg Presses"
64
Added:
[ Muscle.Quadriceps; Muscle.Glutes; Muscle.Hamstrings ];
65
Added:
comp "squats" "Squats"
66
Added:
[ Muscle.Quadriceps; Muscle.Glutes; Muscle.Hamstrings; Muscle.Erectors ];
67
Added:
iso "leg-curls" "Leg Curls" Muscle.Hamstrings;
68
Added:
iso "calf-raises" "Calf Raises" Muscle.Calves;
69
Added:
iso "sit-ups" "Sit-Ups" Muscle.Abdominals;
70
Added:
]
71
Added:
72
Added:
let find sought = List.find_opt (fun e -> String.equal e.id sought) catalog
73
Added:
74
Added:
(* Mutually substitutable movements. Grouping guarantees symmetry: every member
75
Added:
of a group may stand in for every other. Each group is one of HD1's own
76
Added:
"or" lists. *)
77
Added:
let substitution_groups =
78
Added:
[
79
Added:
[ "dumbbell-flyes"; "cable-crossovers"; "pec-deck" ];
80
Added:
[ "lying-french-press"; "pressdowns"; "triceps-machine" ];
81
Added:
[ "bent-over-laterals"; "reverse-pec-deck" ];
82
Added:
[ "pullovers"; "straight-arm-pulldowns" ];
83
Added:
[ "close-grip-pulldowns"; "bent-over-rows"; "chins" ];
84
Added:
[ "hyperextensions"; "deadlifts" ];
85
Added:
[ "curls"; "preacher-curls" ];
86
Added:
[ "leg-presses"; "squats" ];
87
Added:
]
88
Added:
89
Added:
let group_of e =
90
Added:
List.find_opt (fun g -> List.mem e.id g) substitution_groups
91
Added:
|> Option.value ~default:[]
92
Added:
93
Added:
let permitted_substitutes e =
94
Added:
group_of e
95
Added:
|> List.filter (fun i -> not (String.equal i e.id))
96
Added:
|> List.filter_map find
97
Added:
98
Added:
let may_substitute ~original ~candidate =
99
Added:
List.exists (equal candidate) (permitted_substitutes original)
100
Added:
13
101
type error = Not_permitted of { original : id; candidate : id }
14
102
15
Removed:
let permitted_substitutes _ = failwith "TODO"
16
Removed:
let may_substitute ~original:_ ~candidate:_ = failwith "TODO"
17
Removed:
let substitute ~original:_ ~candidate:_ = failwith "TODO"
103
Added:
let substitute ~original ~candidate =
104
Added:
if may_substitute ~original ~candidate then Ok candidate
105
Added:
else
106
Added:
Error (Not_permitted { original = original.id; candidate = candidate.id })
107
Added:
108
Added:
let may_pre_exhaust ~isolation ~compound =
109
Added:
match (isolation.mechanic, compound.mechanic, isolation.muscles) with
110
Added:
| Isolation, Compound, [ target ] ->
111
Added:
List.exists (Muscle.equal target) compound.muscles
112
Added:
&& List.length compound.muscles >= 2
113
Added:
| _ -> false
lib/core/exercise.mli
@@ -18,7 +18,25 @@
18
18
val catalog : t list
19
19
(** The complete curated catalog; the only source of {!t} values. *)
20
20
21
Removed:
val find : id -> t option
21
Added:
val find : string -> t option
22
Added:
(** By {!id}. *)
23
Added:
24
Added:
(** {1 Mechanics} *)
25
Added:
26
Added:
(** Whether a movement works one muscle or several. *)
27
Added:
type mechanic =
28
Added:
| Isolation
29
Added:
| Compound (** Involves assisting muscles, one of which is the weak link. *)
30
Added:
31
Added:
val mechanic : t -> mechanic
32
Added:
33
Added:
val muscles : t -> Muscle.t list
34
Added:
(** Isolation: exactly one. Compound: two or more, strongest first. *)
35
Added:
36
Added:
val may_pre_exhaust : isolation:t -> compound:t -> bool
37
Added:
(** Whether the pair forms a valid pre-exhaustion: [isolation] isolates a muscle
38
Added:
that [compound] also works, and [compound] involves at least one further
39
Added:
muscle able to serve it once the target is pre-exhausted. *)
22
40
23
41
(** {1 Substitutions} *)
24
42
lib/core/muscle.ml
@@ -0,0 +1,50 @@
1
Added:
type t =
2
Added:
| Pecs
3
Added:
| Delts
4
Added:
| Triceps
5
Added:
| Biceps
6
Added:
| Forearms
7
Added:
| Lats
8
Added:
| Traps
9
Added:
| Erectors
10
Added:
| Quadriceps
11
Added:
| Hamstrings
12
Added:
| Glutes
13
Added:
| Calves
14
Added:
| Abdominals
15
Added:
16
Added:
let all =
17
Added:
[
18
Added:
Pecs;
19
Added:
Delts;
20
Added:
Triceps;
21
Added:
Biceps;
22
Added:
Forearms;
23
Added:
Lats;
24
Added:
Traps;
25
Added:
Erectors;
26
Added:
Quadriceps;
27
Added:
Hamstrings;
28
Added:
Glutes;
29
Added:
Calves;
30
Added:
Abdominals;
31
Added:
]
32
Added:
33
Added:
let name = function
34
Added:
| Pecs -> "pecs"
35
Added:
| Delts -> "delts"
36
Added:
| Triceps -> "triceps"
37
Added:
| Biceps -> "biceps"
38
Added:
| Forearms -> "forearms"
39
Added:
| Lats -> "lats"
40
Added:
| Traps -> "traps"
41
Added:
| Erectors -> "erectors"
42
Added:
| Quadriceps -> "quadriceps"
43
Added:
| Hamstrings -> "hamstrings"
44
Added:
| Glutes -> "glutes"
45
Added:
| Calves -> "calves"
46
Added:
| Abdominals -> "abdominals"
47
Added:
48
Added:
let equal = ( = )
49
Added:
let compare = Stdlib.compare
50
Added:
let pp ppf t = Format.pp_print_string ppf (name t)
lib/core/muscle.mli
@@ -0,0 +1,26 @@
1
Added:
(** The muscles HD1 names as training targets.
2
Added:
3
Added:
Deliberately minimal: muscles exist here only so a pre-exhaust pairing can
4
Added:
be validated — an isolation movement must feed a compound that works the
5
Added:
same muscle alongside others able to assist it. *)
6
Added:
7
Added:
type t =
8
Added:
| Pecs
9
Added:
| Delts
10
Added:
| Triceps
11
Added:
| Biceps
12
Added:
| Forearms
13
Added:
| Lats
14
Added:
| Traps
15
Added:
| Erectors
16
Added:
| Quadriceps
17
Added:
| Hamstrings
18
Added:
| Glutes
19
Added:
| Calves
20
Added:
| Abdominals
21
Added:
22
Added:
val all : t list
23
Added:
val name : t -> string
24
Added:
val equal : t -> t -> bool
25
Added:
val compare : t -> t -> int
26
Added:
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)
6
Added:
(modules test_hito test_units test_muscle test_exercise)
7
7
(libraries hito.core alcotest))
test/test_exercise.ml
@@ -1,61 +1,167 @@
1
Removed:
(** Unit tests for {!Exercise}, authored against exercise.mli.
1
Added:
(** Unit tests for {!Exercise}, authored against the exercise.mli contract. *)
2
2
3
Removed:
NOTE: Not yet registered in the main runner (see test_units.ml for the
4
Removed:
rationale); wired in during implementation (Task 8). exercise.mli is the
5
Removed:
source of truth over these assertions. *)
3
Added:
let get id =
4
Added:
match Exercise.find id with
5
Added:
| Some e -> e
6
Added:
| None -> Alcotest.failf "catalog is missing %S" id
6
7
7
Removed:
let get = function Some v -> v | None -> Alcotest.fail "expected Some"
8
Removed:
9
8
let catalog_tests =
10
9
[
11
Removed:
( "catalog is non-empty",
10
Added:
( "catalog is non-empty and ids are unique",
12
11
`Quick,
13
12
fun () ->
13
Added:
let ids =
14
Added:
List.map (fun e -> (Exercise.id e :> string)) Exercise.catalog
15
Added:
in
16
Added:
Alcotest.(check bool) "non-empty" true (ids <> []);
17
Added:
Alcotest.(check int)
18
Added:
"unique" (List.length ids)
19
Added:
(List.length (List.sort_uniq String.compare ids)) );
20
Added:
( "find locates a catalog entry and rejects unknown ids",
21
Added:
`Quick,
22
Added:
fun () ->
23
Added:
Alcotest.(check string)
24
Added:
"name" "Dumbbell Flyes"
25
Added:
(Exercise.name (get "dumbbell-flyes"));
14
26
Alcotest.(check bool)
15
Removed:
"has exercises" true
16
Removed:
(List.length Exercise.catalog > 0) );
17
Removed:
( "every catalog exercise is findable by its id",
27
Added:
"unknown" true
28
Added:
(Option.is_none (Exercise.find "jefferson-curl")) );
29
Added:
( "isolations work exactly one muscle, compounds two or more",
18
30
`Quick,
19
31
fun () ->
20
32
List.iter
21
Removed:
(fun ex ->
22
Removed:
let looked_up = get (Exercise.find (Exercise.id ex)) in
23
Removed:
Alcotest.(check bool)
24
Removed:
"round-trips" true
25
Removed:
(Exercise.equal ex looked_up))
33
Added:
(fun e ->
34
Added:
let n = List.length (Exercise.muscles e) in
35
Added:
match Exercise.mechanic e with
36
Added:
| Exercise.Isolation ->
37
Added:
Alcotest.(check int) (Exercise.name e ^ " isolates one") 1 n
38
Added:
| Exercise.Compound ->
39
Added:
Alcotest.(check bool)
40
Added:
(Exercise.name e ^ " involves assistors")
41
Added:
true (n >= 2))
26
42
Exercise.catalog );
27
43
]
28
44
45
Added:
let pre_exhaust_tests =
46
Added:
[
47
Added:
( "accepts HD1's pec pairing",
48
Added:
`Quick,
49
Added:
fun () ->
50
Added:
Alcotest.(check bool)
51
Added:
"flyes then incline press" true
52
Added:
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
53
Added:
~compound:(get "incline-press")) );
54
Added:
( "accepts HD1's triceps pairing, where Dips serves a second muscle",
55
Added:
`Quick,
56
Added:
fun () ->
57
Added:
Alcotest.(check bool)
58
Added:
"french press then dips" true
59
Added:
(Exercise.may_pre_exhaust ~isolation:(get "lying-french-press")
60
Added:
~compound:(get "dips"));
61
Added:
(* The same compound also serves the pecs, which is why a movement
62
Added:
carries a set of muscles rather than one primary. *)
63
Added:
Alcotest.(check bool)
64
Added:
"flyes then dips" true
65
Added:
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
66
Added:
~compound:(get "dips")) );
67
Added:
( "accepts HD1's lat and leg pairings",
68
Added:
`Quick,
69
Added:
fun () ->
70
Added:
Alcotest.(check bool)
71
Added:
"pullovers then pulldowns" true
72
Added:
(Exercise.may_pre_exhaust ~isolation:(get "pullovers")
73
Added:
~compound:(get "close-grip-pulldowns"));
74
Added:
Alcotest.(check bool)
75
Added:
"leg extensions then leg presses" true
76
Added:
(Exercise.may_pre_exhaust ~isolation:(get "leg-extensions")
77
Added:
~compound:(get "leg-presses")) );
78
Added:
( "rejects a compound paired with a compound",
79
Added:
`Quick,
80
Added:
fun () ->
81
Added:
Alcotest.(check bool)
82
Added:
"dips then incline press" false
83
Added:
(Exercise.may_pre_exhaust ~isolation:(get "dips")
84
Added:
~compound:(get "incline-press")) );
85
Added:
( "rejects an isolation paired with an isolation",
86
Added:
`Quick,
87
Added:
fun () ->
88
Added:
Alcotest.(check bool)
89
Added:
"flyes then pec deck" false
90
Added:
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
91
Added:
~compound:(get "pec-deck")) );
92
Added:
( "rejects a pairing that shares no muscle",
93
Added:
`Quick,
94
Added:
fun () ->
95
Added:
Alcotest.(check bool)
96
Added:
"flyes then squats" false
97
Added:
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
98
Added:
~compound:(get "squats")) );
99
Added:
]
100
Added:
29
101
let substitution_tests =
30
102
[
31
Removed:
( "permitted substitute is accepted",
103
Added:
( "HD1's alternatives are substitutable",
32
104
`Quick,
33
105
fun () ->
34
Removed:
(* Find any exercise that declares at least one permitted substitute. *)
35
Removed:
match
36
Removed:
List.find_opt
37
Removed:
(fun ex -> Exercise.permitted_substitutes ex <> [])
38
Removed:
Exercise.catalog
39
Removed:
with
40
Removed:
| None -> ()
41
Removed:
| Some original ->
42
Removed:
let candidate = List.hd (Exercise.permitted_substitutes original) in
43
Removed:
Alcotest.(check bool)
44
Removed:
"swap permitted" true
45
Removed:
(Result.is_ok (Exercise.substitute ~original ~candidate)) );
46
Removed:
( "non-whitelisted substitute is rejected",
106
Added:
Alcotest.(check bool)
107
Added:
"flyes for pec deck" true
108
Added:
(Exercise.may_substitute ~original:(get "dumbbell-flyes")
109
Added:
~candidate:(get "pec-deck"));
110
Added:
Alcotest.(check bool)
111
Added:
"leg press for squat" true
112
Added:
(Exercise.may_substitute ~original:(get "leg-presses")
113
Added:
~candidate:(get "squats")) );
114
Added:
( "substitution is symmetric",
47
115
`Quick,
48
116
fun () ->
49
Removed:
match Exercise.catalog with
50
Removed:
| a :: b :: _
51
Removed:
when not (Exercise.may_substitute ~original:a ~candidate:b) ->
52
Removed:
Alcotest.(check bool)
53
Removed:
"swap rejected" true
54
Removed:
(Result.is_error (Exercise.substitute ~original:a ~candidate:b))
55
Removed:
| _ -> () );
117
Added:
List.iter
118
Added:
(fun e ->
119
Added:
List.iter
120
Added:
(fun sub ->
121
Added:
Alcotest.(check bool)
122
Added:
(Exercise.name e ^ " <-> " ^ Exercise.name sub)
123
Added:
true
124
Added:
(Exercise.may_substitute ~original:sub ~candidate:e))
125
Added:
(Exercise.permitted_substitutes e))
126
Added:
Exercise.catalog );
127
Added:
( "an exercise is not its own substitute",
128
Added:
`Quick,
129
Added:
fun () ->
130
Added:
let flyes = get "dumbbell-flyes" in
131
Added:
Alcotest.(check bool)
132
Added:
"not self" false
133
Added:
(List.exists (Exercise.equal flyes)
134
Added:
(Exercise.permitted_substitutes flyes)) );
135
Added:
( "unrelated movements are not substitutable",
136
Added:
`Quick,
137
Added:
fun () ->
138
Added:
Alcotest.(check bool)
139
Added:
"curls for squats" false
140
Added:
(Exercise.may_substitute ~original:(get "curls")
141
Added:
~candidate:(get "squats")) );
142
Added:
( "substitute yields the candidate or a typed refusal",
143
Added:
`Quick,
144
Added:
fun () ->
145
Added:
(match
146
Added:
Exercise.substitute ~original:(get "dumbbell-flyes")
147
Added:
~candidate:(get "pec-deck")
148
Added:
with
149
Added:
| Ok e ->
150
Added:
Alcotest.(check string) "pec deck" "Pec Deck" (Exercise.name e)
151
Added:
| Error _ -> Alcotest.fail "expected Ok");
152
Added:
match
153
Added:
Exercise.substitute ~original:(get "curls") ~candidate:(get "squats")
154
Added:
with
155
Added:
| Ok _ -> Alcotest.fail "expected Error"
156
Added:
| Error (Exercise.Not_permitted { original; candidate }) ->
157
Added:
Alcotest.(check string) "original" "curls" (original :> string);
158
Added:
Alcotest.(check string) "candidate" "squats" (candidate :> string)
159
Added:
);
56
160
]
57
161
58
162
let suite =
59
163
[
60
Removed:
("exercise.catalog", catalog_tests); ("exercise.subst", substitution_tests);
164
Added:
("exercise.catalog", catalog_tests);
165
Added:
("exercise.pre_exhaust", pre_exhaust_tests);
166
Added:
("exercise.substitution", substitution_tests);
61
167
]
test/test_hito.ml
@@ -1,4 +1,6 @@
1
1
(** Test harness entry point. Suites are registered here as the HD1 rebuild
2
2
lands each module. *)
3
3
4
Removed:
let () = Alcotest.run "hito" Test_units.suite
4
Added:
let () =
5
Added:
Alcotest.run "hito"
6
Added:
(Test_units.suite @ Test_muscle.suite @ Test_exercise.suite)
test/test_muscle.ml
@@ -0,0 +1,26 @@
1
Added:
(** Unit tests for {!Muscle}. *)
2
Added:
3
Added:
let muscle_tests =
4
Added:
[
5
Added:
( "all lists every constructor exactly once",
6
Added:
`Quick,
7
Added:
fun () ->
8
Added:
let n = List.length Muscle.all in
9
Added:
let unique = List.sort_uniq Muscle.compare Muscle.all in
10
Added:
Alcotest.(check int) "no duplicates" n (List.length unique);
11
Added:
Alcotest.(check int) "thirteen targets" 13 n );
12
Added:
( "names are distinct",
13
Added:
`Quick,
14
Added:
fun () ->
15
Added:
let names = List.map Muscle.name Muscle.all in
16
Added:
Alcotest.(check int)
17
Added:
"distinct" (List.length names)
18
Added:
(List.length (List.sort_uniq String.compare names)) );
19
Added:
( "equal distinguishes targets",
20
Added:
`Quick,
21
Added:
fun () ->
22
Added:
Alcotest.(check bool) "pecs = pecs" true (Muscle.equal Pecs Pecs);
23
Added:
Alcotest.(check bool) "pecs <> lats" false (Muscle.equal Pecs Lats) );
24
Added:
]
25
Added:
26
Added:
let suite = [ ("muscle", muscle_tests) ]