1 module Effort = Evidence.Stimulus.Effort 2 3 let beats ~previous ~current = 4 let load = Float.compare (Effort.load current) (Effort.load previous) in 5 let reps = Int.compare (Effort.reps current) (Effort.reps previous) in 6 load > 0 || (load = 0 && reps > 0) 7 8 type assessment = Progressing | Stalled 9 type error = Insufficient_data 10 11 exception Invalid of error 12 13 let pp_assessment ppf = function 14 | Progressing -> Format.pp_print_string ppf "progressing" 15 | Stalled -> Format.pp_print_string ppf "stalled" 16 17 let pp_error ppf Insufficient_data = 18 Format.pp_print_string ppf "not enough record to judge" 19 20 let stall_window = Recovery.days 14 21 let rec last = function [] -> None | [ x ] -> Some x | _ :: rest -> last rest 22 23 (* The most recent observation that improved on the one before it. *) 24 let last_advance observations = 25 let rec scan found = function 26 | (previous : Evidence.Log.observation) :: (current :: _ as rest) -> 27 let found = 28 if beats ~previous:previous.effort ~current:current.effort then 29 Some current 30 else found 31 in 32 scan found rest 33 | _ -> found 34 in 35 scan None observations 36 37 let elapsed_between (a : Evidence.Log.observation) 38 (b : Evidence.Log.observation) = 39 Recovery.duration_to_seconds 40 (Recovery.elapsed ~since:a.performed_at ~now:b.performed_at) 41 42 let assess observations = 43 let window = Recovery.duration_to_seconds stall_window in 44 match (observations, last observations) with 45 | ([] | [ _ ]), _ | _, None -> raise (Invalid Insufficient_data) 46 | first :: _, Some latest -> ( 47 match last_advance observations with 48 | Some advance -> 49 if elapsed_between advance latest >= window then Stalled 50 else Progressing 51 | None -> 52 (* Never advanced. Only a stall once the record is long enough to say 53 so; otherwise two sessions a day apart would condemn the routine. *) 54 if elapsed_between first latest >= window then Stalled 55 else raise (Invalid Insufficient_data)) 56 57 type remedy = 58 | Lay_off_then_reduce of { 59 lay_off : Recovery.duration; 60 drop_stimuli_per_workout : int; 61 extra_rest : Recovery.duration; 62 } 63 64 let remedy = function 65 | Progressing -> None 66 | Stalled -> 67 Some 68 (Lay_off_then_reduce 69 { 70 lay_off = Recovery.days 7; 71 drop_stimuli_per_workout = 1; 72 extra_rest = Recovery.days 1; 73 }) 74 75 let pp_remedy ppf 76 (Lay_off_then_reduce { lay_off; drop_stimuli_per_workout; extra_rest }) = 77 Format.fprintf ppf 78 "take %a off, then drop %d stimulus per workout and add %a between workouts" 79 Recovery.pp_duration lay_off drop_stimuli_per_workout Recovery.pp_duration 80 extra_rest 81 82 let load_increase_trigger = 12 83 let load_increase ~current = (current *. 1.10, current *. 1.20) 84 85 type load_verdict = Hold | Increase of float * float | Too_heavy 86 87 (* The trigger is absolute, so the window's ceiling never gates the verdict — 88 only its floor does. *) 89 let judge_load ~rep_range effort = 90 let reps = Effort.reps effort in 91 let min_reps, _ = Prescription.Rep_range.bounds rep_range in 92 if reps >= load_increase_trigger then 93 let low, high = load_increase ~current:(Effort.load effort) in 94 Increase (low, high) 95 else if reps < min_reps then Too_heavy 96 else Hold 97 98 let pp_load_verdict ppf = function 99 | Hold -> Format.pp_print_string ppf "hold the load" 100 | Increase (low, high) -> 101 Format.fprintf ppf "raise the load to %g-%g kg" low high 102 | Too_heavy -> Format.pp_print_string ppf "load is too heavy for the window" 103 104 type diagnostic = 105 | Excess_volume of int 106 | Extensions_on_every_stimulus of int 107 | Trained_under_recovered of int 108 109 let excess_volume workout = 110 List.length (Evidence.Workout.stimuli workout) 111 > Evidence.Workout.filled_slots workout 112 113 let all_extended workout = 114 match Evidence.Workout.stimuli workout with 115 | [] -> false 116 | stimuli -> List.for_all Evidence.Stimulus.is_extended stimuli 117 118 let under_recovered workout = 119 match Recovery.basis (Evidence.Workout.clearance workout) with 120 | Recovery.Recovered -> false 121 | Recovery.Overridden _ -> true 122 123 let diagnose log = 124 let workouts = Evidence.Log.workouts log in 125 let count predicate = List.length (List.filter predicate workouts) in 126 let excessive = count excess_volume in 127 let extended = count all_extended in 128 let overridden = count under_recovered in 129 let when_present n d = if n > 0 then [ d n ] else [] in 130 when_present excessive (fun n -> Excess_volume n) 131 @ when_present extended (fun n -> Extensions_on_every_stimulus n) 132 @ when_present overridden (fun n -> Trained_under_recovered n) 133 134 let pp_diagnostic ppf = function 135 | Excess_volume n -> 136 Format.fprintf ppf "%d workout(s) recorded more stimuli than prescribed" n 137 | Extensions_on_every_stimulus n -> 138 Format.fprintf ppf "%d workout(s) extended every stimulus beyond failure" 139 n 140 | Trained_under_recovered n -> 141 Format.fprintf ppf "%d workout(s) begun before recovery was complete" n 142