View raw

1 (** Unit tests for {!Progression}. *) 2 3 module Stimulus = Evidence.Stimulus 4 module Workout = Evidence.Workout 5 6 let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok" 7 8 let get id = 9 match Exercise.find_id id with 10 | Some e -> e 11 | None -> Alcotest.failf "catalog is missing %S" id 12 13 let load n = n 14 let reps n = n 15 let at s = Recovery.timestamp_of_unix_seconds s 16 let day n = at (n * 86_400) 17 let secs = Recovery.duration_to_seconds 18 let six_to_ten = Prescription.Rep_range.make ~min:6 ~max:10 19 let rep_range min max = Prescription.Rep_range.make ~min ~max 20 21 let move ?(outcome = Stimulus.Positive_failure) ?(id = "laterals") load_kg 22 rep_count = 23 Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg) 24 ~reps:(reps rep_count) ~outcome 25 26 (* An observation is a public record, so evidence can be written directly. *) 27 let seen ~on load r : Evidence.Log.observation = 28 { exercise = get "laterals"; effort = move load r; performed_at = day on } 29 30 let raises_insufficient_data f = 31 try 32 let _ = f () in 33 false 34 with Progression.Invalid Progression.Insufficient_data -> true 35 36 let assess_tests = 37 [ 38 ( "the stall window is two weeks", 39 `Quick, 40 fun () -> 41 Alcotest.(check int) "14 days" 1_209_600 (secs Progression.stall_window) 42 ); 43 ( "too little record to judge", 44 `Quick, 45 fun () -> 46 Alcotest.(check bool) 47 "nothing" true 48 (raises_insufficient_data (fun () -> Progression.assess [])); 49 Alcotest.(check bool) 50 "a single session" true 51 (raises_insufficient_data (fun () -> 52 Progression.assess [ seen ~on:1 12. 8 ])); 53 Alcotest.(check bool) 54 "flat but recent" true 55 (raises_insufficient_data (fun () -> 56 Progression.assess [ seen ~on:1 12. 8; seen ~on:3 12. 8 ])) ); 57 ( "a recent advance is progress", 58 `Quick, 59 fun () -> 60 Alcotest.(check bool) 61 "progressing" true 62 (Progression.assess 63 [ seen ~on:1 12. 8; seen ~on:3 12. 9; seen ~on:5 12. 9 ] 64 = Progression.Progressing) ); 65 ( "no advance for two weeks is a stall", 66 `Quick, 67 fun () -> 68 Alcotest.(check bool) 69 "stalled" true 70 (Progression.assess 71 [ seen ~on:1 12. 8; seen ~on:8 12. 8; seen ~on:16 12. 8 ] 72 = Progression.Stalled) ); 73 ( "an advance more than two weeks ago is also a stall", 74 `Quick, 75 fun () -> 76 Alcotest.(check bool) 77 "stalled" true 78 (Progression.assess 79 [ seen ~on:1 12. 8; seen ~on:3 12. 9; seen ~on:20 12. 9 ] 80 = Progression.Stalled) ); 81 ] 82 83 let remedy_tests = 84 [ 85 ( "progress calls for no change", 86 `Quick, 87 fun () -> 88 Alcotest.(check bool) 89 "none" true 90 (Option.is_none (Progression.remedy Progression.Progressing)) ); 91 ( "a stall calls for a lay-off, then less work and more rest", 92 `Quick, 93 fun () -> 94 match Progression.remedy Progression.Stalled with 95 | Some 96 (Progression.Lay_off_then_reduce 97 { lay_off; drop_stimuli_per_workout; extra_rest }) -> 98 Alcotest.(check int) "one week off" 604_800 (secs lay_off); 99 Alcotest.(check int) 100 "one fewer stimulus per workout" 1 drop_stimuli_per_workout; 101 Alcotest.(check int) "one extra rest day" 86_400 (secs extra_rest) 102 | None -> Alcotest.fail "a stall must have a remedy" ); 103 ( "no remedy ever adds work", 104 `Quick, 105 fun () -> 106 (* Structural: the only remedy subtracts. This asserts the intent. *) 107 match Progression.remedy Progression.Stalled with 108 | Some (Progression.Lay_off_then_reduce { drop_stimuli_per_workout; _ }) 109 -> 110 Alcotest.(check bool) 111 "subtracts volume" true 112 (drop_stimuli_per_workout > 0) 113 | None -> Alcotest.fail "expected a remedy" ); 114 ] 115 116 let load_tests = 117 [ 118 ( "the load rises at twelve reps", 119 `Quick, 120 fun () -> 121 Alcotest.(check int) "trigger" 12 Progression.load_increase_trigger ); 122 ( "the increase is a 10-20% window", 123 `Quick, 124 fun () -> 125 let low, high = Progression.load_increase ~current:(load 100.) in 126 Alcotest.(check (float 0.001)) "110kg" 110. low; 127 Alcotest.(check (float 0.001)) "120kg" 120. high ); 128 ( "inside the window the load holds", 129 `Quick, 130 fun () -> 131 Alcotest.(check bool) 132 "8 reps of 6-10" true 133 (Progression.judge_load ~rep_range:six_to_ten (move 12. 8) 134 = Progression.Hold) ); 135 ( "eleven reps is slack, not yet a load increase", 136 `Quick, 137 fun () -> 138 (* HD1 raises the load at twelve, not merely above the window. *) 139 Alcotest.(check bool) 140 "11 reps of 6-10 holds" true 141 (Progression.judge_load ~rep_range:six_to_ten (move 12. 11) 142 = Progression.Hold) ); 143 ( "twelve reps calls for more load", 144 `Quick, 145 fun () -> 146 match Progression.judge_load ~rep_range:six_to_ten (move 100. 12) with 147 | Progression.Increase (low, high) -> 148 Alcotest.(check (float 0.001)) "110kg" 110. low; 149 Alcotest.(check (float 0.001)) "120kg" 120. high 150 | _ -> Alcotest.fail "expected Increase" ); 151 ( "failing below the window means the load is too heavy", 152 `Quick, 153 fun () -> 154 Alcotest.(check bool) 155 "4 reps of 6-10" true 156 (Progression.judge_load ~rep_range:six_to_ten (move 12. 4) 157 = Progression.Too_heavy) ); 158 (* The window's ceiling never gates the verdict: HD1's trigger is the 159 absolute twelve, and overshooting a narrower band is the slack it 160 allows. Only the floor decides Too_heavy. *) 161 ( "a band's ceiling does not gate the verdict", 162 `Quick, 163 fun () -> 164 Alcotest.(check bool) 165 "10 reps of 6-8 still holds" true 166 (Progression.judge_load ~rep_range:(rep_range 6 8) (move 12. 10) 167 = Progression.Hold) ); 168 ( "the twelve-rep trigger is absolute, whatever the ceiling", 169 `Quick, 170 fun () -> 171 List.iter 172 (fun (lo, hi) -> 173 match 174 Progression.judge_load ~rep_range:(rep_range lo hi) (move 100. 12) 175 with 176 | Progression.Increase _ -> () 177 | _ -> 178 Alcotest.failf "%d-%d at twelve reps must call for more load" lo 179 hi) 180 [ (6, 8); (6, 10); (6, 12); (8, 12); (12, 12) ] ); 181 ( "the floor moves with the band", 182 `Quick, 183 fun () -> 184 Alcotest.(check bool) 185 "7 reps of 8-12 is too heavy" true 186 (Progression.judge_load ~rep_range:(rep_range 8 12) (move 12. 7) 187 = Progression.Too_heavy); 188 Alcotest.(check bool) 189 "7 reps of 6-10 holds" true 190 (Progression.judge_load ~rep_range:six_to_ten (move 12. 7) 191 = Progression.Hold) ); 192 ] 193 194 (* Performed workouts, for the diagnostics. *) 195 let cleared = Option.get (Recovery.clear Recovery.Ready) 196 197 let prescribed = 198 List.hd (Prescription.Routine.workouts Prescription.Routine.ideal) 199 200 let performed ~clearance ~stimuli = 201 List.fold_left 202 (fun w s -> Workout.add_stimulus w s) 203 (Workout.start prescribed ~clearance ~started_at:(day 1)) 204 stimuli 205 206 let stimulus ?outcome id load r = 207 Stimulus.make (Stimulus.Single (move ?outcome ~id load r)) 208 209 let laterals ?outcome load r = stimulus ?outcome "laterals" load r 210 211 let extended = 212 Stimulus.Beyond_failure (Stimulus.Forced_reps, [ Stimulus.Negatives ]) 213 214 let diagnostic_tests = 215 [ 216 ( "a clean record yields no diagnostics", 217 `Quick, 218 fun () -> 219 let w = performed ~clearance:cleared ~stimuli:[ laterals 12. 8 ] in 220 Alcotest.(check int) 221 "none" 0 222 (List.length 223 (Progression.diagnose (Evidence.Log.add Evidence.Log.empty w))) ); 224 ( "extra recorded volume is flagged", 225 `Quick, 226 fun () -> 227 let w = 228 performed ~clearance:cleared 229 ~stimuli:[ laterals 12. 8; laterals 12. 6 ] 230 in 231 match Progression.diagnose (Evidence.Log.add Evidence.Log.empty w) with 232 | [ Progression.Excess_volume n ] -> 233 Alcotest.(check int) "one workout" 1 n 234 | _ -> Alcotest.fail "expected the excess-volume diagnostic" ); 235 ( "extending every stimulus is flagged", 236 `Quick, 237 fun () -> 238 let w = 239 performed ~clearance:cleared 240 ~stimuli:[ laterals ~outcome:extended 12. 8 ] 241 in 242 match Progression.diagnose (Evidence.Log.add Evidence.Log.empty w) with 243 | [ Progression.Extensions_on_every_stimulus n ] -> 244 Alcotest.(check int) "one workout" 1 n 245 | _ -> Alcotest.fail "expected the extension diagnostic" ); 246 ( "extending only some stimuli is not flagged", 247 `Quick, 248 fun () -> 249 let w = 250 performed ~clearance:cleared 251 ~stimuli: 252 [ 253 laterals ~outcome:extended 12. 8; 254 stimulus "bent-over-laterals" 10. 9; 255 ] 256 in 257 Alcotest.(check int) 258 "none" 0 259 (List.length 260 (Progression.diagnose (Evidence.Log.add Evidence.Log.empty w))) ); 261 ( "training on an override is flagged", 262 `Quick, 263 fun () -> 264 let recovering = 265 Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12) 266 ~recommended:Prescription.Routine.training_interval 267 in 268 let w = 269 performed 270 ~clearance:(Recovery.override recovering) 271 ~stimuli:[ laterals 12. 8 ] 272 in 273 match Progression.diagnose (Evidence.Log.add Evidence.Log.empty w) with 274 | [ Progression.Trained_under_recovered n ] -> 275 Alcotest.(check int) "one workout" 1 n 276 | _ -> Alcotest.fail "expected the under-recovery diagnostic" ); 277 ( "a stall alongside both habits names both as suspects", 278 `Quick, 279 fun () -> 280 let recovering = 281 Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12) 282 ~recommended:Prescription.Routine.training_interval 283 in 284 let w = 285 performed 286 ~clearance:(Recovery.override recovering) 287 ~stimuli:[ laterals ~outcome:extended 12. 8 ] 288 in 289 Alcotest.(check int) 290 "both" 2 291 (List.length 292 (Progression.diagnose (Evidence.Log.add Evidence.Log.empty w))); 293 Alcotest.(check bool) 294 "and the routine is stalled" true 295 (Progression.assess 296 [ seen ~on:1 12. 8; seen ~on:8 12. 8; seen ~on:16 12. 8 ] 297 = Progression.Stalled) ); 298 ] 299 300 let suite = 301 [ 302 ("progression.assess", assess_tests); 303 ("progression.remedy", remedy_tests); 304 ("progression.load", load_tests); 305 ("progression.diagnostics", diagnostic_tests); 306 ] 307