From 91e4979b2da4471bc16b2cf82138a70d801f29e0 Mon Sep 17 00:00:00 2001 From: Ang Date: Sat, 17 Jan 2026 05:46:14 +0800 Subject: [PATCH 1/2] v1.0.2: runnable vignettes, sample datasets, styler formatting --- DESCRIPTION | 7 +- NAMESPACE | 12 + NEWS.md | 25 +- R/Athlytics-package.R | 92 ++++++ R/calculate_acwr.R | 105 ++++--- R/calculate_acwr_ewma.R | 232 +++++++------- R/calculate_decoupling.R | 193 ++++++------ R/calculate_ef.R | 166 +++++----- R/calculate_exposure.R | 35 +-- R/calculate_pbs.R | 85 ++--- R/cohort_reference.R | 201 +++++++----- R/color_palettes.R | 173 +++++------ R/data.R | 10 +- R/flag_quality.R | 136 ++++---- R/internal_load.R | 52 ++-- R/load_local_activities.R | 226 ++++++++------ R/parse_activity_file.R | 130 ++++---- R/plot_acwr.R | 158 +++++----- R/plot_acwr_enhanced.R | 144 +++++---- R/plot_decoupling.R | 65 ++-- R/plot_ef.R | 98 +++--- R/plot_exposure.R | 155 +++++----- R/plot_pbs.R | 176 ++++++----- R/utils.R | 8 +- R/zzz.R | 17 +- README.md | 10 +- data-raw/generate_sample_acwr.R | 59 ++++ data-raw/generate_sample_decoupling.R | 46 +++ data-raw/generate_sample_ef.R | 52 ++++ data-raw/generate_sample_exposure.R | 59 ++++ data-raw/generate_sample_pbs.R | 15 +- data/athlytics_sample_acwr.rda | Bin 24928 -> 0 bytes data/athlytics_sample_decoupling.rda | Bin 1432 -> 0 bytes data/athlytics_sample_ef.rda | Bin 1544 -> 0 bytes data/athlytics_sample_exposure.rda | Bin 5580 -> 0 bytes data/athlytics_sample_pbs.rda | Bin 1004 -> 0 bytes data/sample_acwr.rda | Bin 0 -> 3436 bytes data/sample_decoupling.rda | Bin 0 -> 552 bytes data/sample_ef.rda | Bin 0 -> 656 bytes data/sample_exposure.rda | Bin 0 -> 3804 bytes data/sample_pbs.rda | Bin 0 -> 992 bytes generate_plot_examples.R | 44 +-- man/Athlytics-package.Rd | 102 ++++++ man/add_reference_bands.Rd | 2 +- man/athlytics_colors_acwr_zones.Rd | 2 +- man/athlytics_colors_ef.Rd | 2 +- man/athlytics_colors_training_load.Rd | 2 +- man/athlytics_palette_academic.Rd | 7 +- man/athlytics_palette_cell.Rd | 2 +- man/athlytics_palette_nature.Rd | 10 +- man/athlytics_palette_science.Rd | 2 +- man/athlytics_palette_vibrant.Rd | 7 +- man/calculate_acwr.Rd | 31 +- man/calculate_acwr_ewma.Rd | 6 +- ...rence.Rd => calculate_cohort_reference.Rd} | 41 ++- man/calculate_decoupling.Rd | 14 +- man/calculate_ef.Rd | 20 +- man/calculate_exposure.Rd | 4 +- man/calculate_pbs.Rd | 4 +- man/flag_quality.Rd | 13 +- man/plot_acwr.Rd | 26 +- man/plot_acwr_comparison.Rd | 10 +- man/plot_acwr_enhanced.Rd | 10 +- man/plot_decoupling.Rd | 14 +- man/plot_ef.Rd | 32 +- man/plot_exposure.Rd | 32 +- man/plot_pbs.Rd | 68 ++-- man/plot_with_reference.Rd | 12 +- ...thlytics_sample_acwr.Rd => sample_acwr.Rd} | 6 +- ...ple_decoupling.Rd => sample_decoupling.Rd} | 6 +- man/{athlytics_sample_ef.Rd => sample_ef.Rd} | 6 +- ..._sample_exposure.Rd => sample_exposure.Rd} | 6 +- ...{athlytics_sample_pbs.Rd => sample_pbs.Rd} | 6 +- ...uality_summary.Rd => summarize_quality.Rd} | 7 +- paper/paper.md | 4 +- tests/testthat.R | 2 +- tests/testthat/helper-mock-files.R | 138 +++++---- tests/testthat/helper-mockdata.R | 31 +- tests/testthat/test-absolute-real-data.R | 83 ++--- tests/testthat/test-acwr-ewma-advanced.R | 198 ++++++------ tests/testthat/test-acwr-ewma.R | 45 ++- tests/testthat/test-acwr.R | 52 ++-- tests/testthat/test-additional-edge-cases.R | 18 +- tests/testthat/test-calculate-decoupling.R | 4 +- tests/testthat/test-calculate-ef-advanced.R | 204 ++++++------ tests/testthat/test-calculate-ef-extended.R | 49 ++- tests/testthat/test-calculate-ef-simple.R | 52 ++-- tests/testthat/test-calculate-ef-stream.R | 271 ++++++++-------- .../test-calculate-exposure-extended.R | 38 +-- tests/testthat/test-calculate-exposure.R | 14 +- tests/testthat/test-calculate-functions.R | 98 +++--- .../testthat/test-calculate-with-mock-files.R | 76 ++--- tests/testthat/test-cohort-reference.R | 102 +++--- tests/testthat/test-color-palettes.R | 50 +-- tests/testthat/test-date-ranges.R | 10 +- tests/testthat/test-decoupling.R | 109 +++---- tests/testthat/test-ef-stream-coverage.R | 83 +++-- tests/testthat/test-ef.R | 40 +-- tests/testthat/test-exposure.R | 67 ++-- tests/testthat/test-extreme-edge-cases.R | 215 +++++++------ tests/testthat/test-flag-quality-streams.R | 118 +++---- tests/testthat/test-flag-quality.R | 63 ++-- tests/testthat/test-load-local-activities.R | 15 +- tests/testthat/test-load-with-real-data.R | 153 ++++----- tests/testthat/test-parameter-boundaries.R | 12 +- .../test-parse-activity-file-stream.R | 50 +-- tests/testthat/test-parse-real-files.R | 292 ++++++++++-------- tests/testthat/test-pbs.R | 47 ++- tests/testthat/test-plot-acwr-enhanced.R | 77 ++--- tests/testthat/test-plot-ef-advanced.R | 161 +++++----- tests/testthat/test-plot-ef-comprehensive.R | 132 ++++---- tests/testthat/test-plot-ef-extended.R | 61 ++-- tests/testthat/test-plot-ef-simple.R | 48 +-- tests/testthat/test-plot-ef-stream.R | 161 +++++----- .../test-plot-exposure-comprehensive.R | 166 +++++----- tests/testthat/test-plot-pbs-comprehensive.R | 154 +++++---- tests/testthat/test-plot-pbs-extended.R | 41 ++- tests/testthat/test-plot-pbs-simple.R | 24 +- tests/testthat/test-smoke-and-errors.R | 157 +++++----- tests/testthat/test-uncovered-branches.R | 221 +++++++------ tests/testthat/test-utils-extended.R | 71 +++-- tests/testthat/test-utils.R | 6 +- vignettes/advanced_features.Rmd | 85 ++--- vignettes/athlytics_introduction.Rmd | 137 +++++--- 124 files changed, 4540 insertions(+), 3463 deletions(-) create mode 100644 R/Athlytics-package.R create mode 100644 data-raw/generate_sample_acwr.R create mode 100644 data-raw/generate_sample_decoupling.R create mode 100644 data-raw/generate_sample_ef.R create mode 100644 data-raw/generate_sample_exposure.R delete mode 100644 data/athlytics_sample_acwr.rda delete mode 100644 data/athlytics_sample_decoupling.rda delete mode 100644 data/athlytics_sample_ef.rda delete mode 100644 data/athlytics_sample_exposure.rda delete mode 100644 data/athlytics_sample_pbs.rda create mode 100644 data/sample_acwr.rda create mode 100644 data/sample_decoupling.rda create mode 100644 data/sample_ef.rda create mode 100644 data/sample_exposure.rda create mode 100644 data/sample_pbs.rda create mode 100644 man/Athlytics-package.Rd rename man/{cohort_reference.Rd => calculate_cohort_reference.Rd} (71%) rename man/{athlytics_sample_acwr.Rd => sample_acwr.Rd} (90%) rename man/{athlytics_sample_decoupling.Rd => sample_decoupling.Rd} (85%) rename man/{athlytics_sample_ef.Rd => sample_ef.Rd} (89%) rename man/{athlytics_sample_exposure.Rd => sample_exposure.Rd} (89%) rename man/{athlytics_sample_pbs.Rd => sample_pbs.Rd} (94%) rename man/{quality_summary.Rd => summarize_quality.Rd} (88%) diff --git a/DESCRIPTION b/DESCRIPTION index 7c02c21..530abff 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: Athlytics Title: Academic R Package for Sports Physiology Analysis from Local 'Strava' Data -Version: 1.0.1 +Version: 1.0.2 Author: Zhiang He [aut, cre] Maintainer: Zhiang He Authors@R: @@ -39,10 +39,7 @@ Suggests: testthat (>= 3.0.0), mockery, rStrava, - xml2, - FITfileR -Remotes: - grimbough/FITfileR + xml2 VignetteBuilder: knitr RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index 3e770f2..80f0c37 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ export(athlytics_palette_science) export(athlytics_palette_vibrant) export(calculate_acwr) export(calculate_acwr_ewma) +export(calculate_cohort_reference) export(calculate_decoupling) export(calculate_ef) export(calculate_ef_from_stream) @@ -30,9 +31,13 @@ export(plot_pbs) export(plot_with_reference) export(quality_summary) export(scale_athlytics) +export(summarize_quality) export(theme_athlytics) import(ggplot2) importFrom(dplyr,"%>%") +importFrom(dplyr,across) +importFrom(dplyr,all_of) +importFrom(dplyr,any_of) importFrom(dplyr,arrange) importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) @@ -48,6 +53,7 @@ importFrom(dplyr,last) importFrom(dplyr,lead) importFrom(dplyr,left_join) importFrom(dplyr,mutate) +importFrom(dplyr,n) importFrom(dplyr,pull) importFrom(dplyr,recode) importFrom(dplyr,rename) @@ -69,6 +75,7 @@ importFrom(ggplot2,ggplot) importFrom(ggplot2,labs) importFrom(ggplot2,scale_color_viridis_d) importFrom(ggplot2,scale_x_date) +importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme) importFrom(ggplot2,theme_minimal) importFrom(lubridate,as_date) @@ -78,6 +85,7 @@ importFrom(lubridate,date) importFrom(lubridate,days) importFrom(lubridate,duration) importFrom(lubridate,floor_date) +importFrom(lubridate,hms) importFrom(lubridate,interval) importFrom(lubridate,parse_date_time) importFrom(lubridate,period) @@ -92,7 +100,9 @@ importFrom(purrr,quietly) importFrom(readr,cols) importFrom(readr,read_csv) importFrom(rlang,"%||%") +importFrom(rlang,":=") importFrom(rlang,.data) +importFrom(rlang,sym) importFrom(scales,pretty_breaks) importFrom(stats,median) importFrom(stats,na.omit) @@ -104,6 +114,8 @@ importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_wider) importFrom(tidyr,unnest) importFrom(tools,toTitleCase) +importFrom(utils,head) importFrom(utils,read.csv) +importFrom(utils,tail) importFrom(zoo,rollapply) importFrom(zoo,rollmean) diff --git a/NEWS.md b/NEWS.md index 8f5ca3d..10f8f4f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,16 @@ -# Athlytics 1.0.1 +# Athlytics 1.0.2 + +## Documentation & Review Fixes + +* **Runnable vignettes**: Added executable demo chunks using built-in sample datasets so key plots render during `build_vignettes()`. + +* **Sample data naming**: Renamed built-in datasets from `athlytics_sample_*` to `sample_*` and updated docs/examples accordingly. + +* **Styling**: Ran `styler::style_pkg()` to improve formatting consistency. + +--- + +# Athlytics 1.0.1 ## Code Quality Improvements @@ -8,6 +20,11 @@ * **Documentation Fixes**: Fixed Rd line width issues in `plot_with_reference()` examples. +* **API Naming Consistency**: Added verb-first primary APIs and kept previous names as deprecated wrappers for backward compatibility. + - New: `calculate_cohort_reference()` (replaces `cohort_reference()`) + - New: `summarize_quality()` (replaces `quality_summary()`) + - Old names remain available but emit a deprecation warning to guide migration. + * **Build Configuration**: Updated `.Rbuildignore` to properly exclude development files. --- @@ -81,12 +98,12 @@ For users upgrading from 0.1.x: ## Core Improvement: Enhanced Reliability & Testing with Simulated Data -This significant update enhances package reliability and ease of use by integrating `athlytics_sample_data`. This enables all examples to run offline and ensures core functionalities have undergone more rigorous, reproducible testing. +This significant update enhances package reliability and ease of use by integrating sample datasets. This enables all examples to run offline and ensures core functionalities have undergone more rigorous, reproducible testing. ## Key Changes -* **Examples & Vignettes**: All Roxygen examples and key vignette examples now primarily use `athlytics_sample_data` for offline execution and clarity. Network-dependent examples are clearly separated in `\donttest{}` blocks. -* **Test Suite**: Fundamentally refactored the test suite to extensively use `athlytics_sample_data` and `mockery`, improving test robustness and parameter coverage. +* **Examples & Vignettes**: All Roxygen examples and key vignette examples now primarily use sample datasets for offline execution and clarity. Network-dependent examples are clearly separated in `\donttest{}` blocks. +* **Test Suite**: Fundamentally refactored the test suite to extensively use sample datasets and `mockery`, improving test robustness and parameter coverage. * **Strengthened Package Quality & Compliance**: Undertook thorough package validation, leading to key enhancements for overall robustness and adherence to R packaging standards. This involved: ensuring all **function examples** are correct and reliably executable (notably addressing `strava_oauth(...)` scenarios for offline/testing contexts); providing accurate and **refined documentation for data objects** in `R/data.R`; fixing **Roxygen import directives** for precise namespace definition; improving **help file readability** through Rd line width adjustments; and optimizing package data loading by adding `LazyData: true` to `DESCRIPTION`. * **Documentation**: Minor improvements to documentation clarity and consistency (e.g., date formatting in plots, explicit naming of data frame arguments in examples). diff --git a/R/Athlytics-package.R b/R/Athlytics-package.R new file mode 100644 index 0000000..e7a3a4b --- /dev/null +++ b/R/Athlytics-package.R @@ -0,0 +1,92 @@ +#' @keywords internal +"_PACKAGE" + +#' Athlytics: Academic R Package for Sports Physiology Analysis +#' +#' @description +#' Athlytics is an open-source computational framework for longitudinal analysis +#' of exercise physiology metrics using local Strava data exports. Designed for +#' personal analysis and sports science applications, this package provides +#' standardized functions to calculate and visualize key physiological indicators. +#' +#' @section Main Functions: +#' **Data Loading:** +#' \itemize{ +#' \item \code{\link{load_local_activities}}: Load activities from Strava export ZIP or directory +#' \item \code{\link{parse_activity_file}}: Parse individual FIT/TCX/GPX files +#' } +#' +#' **Training Load Analysis:** +#' \itemize{ +#' \item \code{\link{calculate_acwr}}: Calculate Acute:Chronic Workload Ratio +#' \item \code{\link{calculate_acwr_ewma}}: ACWR using exponentially weighted moving averages +#' \item \code{\link{calculate_exposure}}: Calculate training load exposure metrics +#' } +#' +#' **Physiological Metrics:** +#' \itemize{ +#' \item \code{\link{calculate_ef}}: Calculate Efficiency Factor (EF) +#' \item \code{\link{calculate_decoupling}}: Calculate cardiovascular decoupling +#' \item \code{\link{calculate_pbs}}: Calculate personal bests +#' } +#' +#' **Visualization:** +#' \itemize{ +#' \item \code{\link{plot_acwr}}, \code{\link{plot_acwr_enhanced}}: Plot ACWR trends +#' \item \code{\link{plot_ef}}: Plot Efficiency Factor trends +#' \item \code{\link{plot_decoupling}}: Plot decoupling analysis +#' \item \code{\link{plot_exposure}}: Plot training load exposure +#' \item \code{\link{plot_pbs}}: Plot personal bests progression +#' } +#' +#' **Quality Control & Cohort Analysis:** +#' \itemize{ +#' \item \code{\link{flag_quality}}: Flag activities based on quality criteria +#' \item \code{\link{summarize_quality}}: Summarize stream quality flags +#' \item \code{\link{calculate_cohort_reference}}: Generate cohort reference bands +#' } +#' +#' @section Sample Datasets: +#' The package includes simulated datasets for examples and testing: +#' \itemize{ +#' \item \code{\link{sample_acwr}}: Sample ACWR data +#' \item \code{\link{sample_ef}}: Sample Efficiency Factor data +#' \item \code{\link{sample_decoupling}}: Sample decoupling data +#' \item \code{\link{sample_exposure}}: Sample exposure data +#' \item \code{\link{sample_pbs}}: Sample personal bests data +#' } +#' +#' @section Getting Started: +#' ``` +#' library(Athlytics) +#' +#' # Load your Strava export +#' activities <- load_local_activities("path/to/strava_export.zip") +#' +#' # Calculate ACWR +#' acwr_data <- calculate_acwr(activities, activity_type = "Run") +#' +#' # Visualize + +#' plot_acwr(acwr_data) +#' ``` +#' +#' @seealso +#' \itemize{ +#' \item Package website: \url{https://hzacode.github.io/Athlytics/} +#' \item GitHub repository: \url{https://github.com/HzaCode/Athlytics} +#' \item Strava: \url{https://www.strava.com/} +#' } +#' +#' @importFrom dplyr mutate filter select group_by ungroup summarise arrange +#' @importFrom dplyr left_join bind_rows n lag lead across any_of all_of +#' @importFrom ggplot2 ggplot aes geom_line geom_point geom_ribbon theme_minimal +#' @importFrom ggplot2 labs scale_x_date scale_y_continuous theme element_text +#' @importFrom lubridate as_date ymd hms seconds_to_period +#' @importFrom rlang .data := sym +#' @importFrom stats na.omit sd median quantile +#' @importFrom utils head tail +#' +#' @name Athlytics-package +#' @aliases Athlytics +NULL diff --git a/R/calculate_acwr.R b/R/calculate_acwr.R index 28fdd5b..416a514 100644 --- a/R/calculate_acwr.R +++ b/R/calculate_acwr.R @@ -10,7 +10,7 @@ #' This function calculates daily training load and derives acute (short-term) and #' chronic (long-term) load averages, then computes their ratio (ACWR). The ACWR #' helps identify periods of rapid training load increases that may elevate injury risk. -#' +#' #' **Key Concepts:** #' \itemize{ #' \item **Acute Load (ATL)**: Rolling average of recent training (default: 7 days) @@ -21,9 +21,9 @@ #' } #' #' @param activities_data A data frame of activities from `load_local_activities()`. -#' Must contain columns: `date`, `distance`, `moving_time`, `elapsed_time`, +#' Must contain columns: `date`, `distance`, `moving_time`, `elapsed_time`, #' `average_heartrate`, `average_watts`, `type`, `elevation_gain`. -#' @param activity_type **Required** character vector. Filter activities by type +#' @param activity_type **Required** character vector. Filter activities by type #' (e.g., `"Run"`, `"Ride"`). **Must specify** to avoid mixing incompatible load metrics. #' @param load_metric Character string specifying the load calculation method: #' \itemize{ @@ -107,7 +107,7 @@ #' \code{\link{plot_acwr}} for visualization, #' \code{\link{calculate_acwr_ewma}} for EWMA-based ACWR, #' \code{\link{load_local_activities}} for data loading, -#' \code{\link{cohort_reference}} for multi-athlete comparisons +#' \code{\link{calculate_cohort_reference}} for multi-athlete comparisons #' #' @importFrom dplyr filter select mutate group_by summarise arrange %>% left_join coalesce case_when ungroup #' @importFrom lubridate as_date date days ymd ymd_hms as_datetime @@ -118,57 +118,62 @@ #' #' @examples #' # Example using simulated data (Note: sample data is pre-calculated, shown for demonstration) -#' data(athlytics_sample_acwr) -#' print(head(athlytics_sample_acwr)) +#' data(sample_acwr) +#' print(head(sample_acwr)) #' #' \dontrun{ #' # Example using local Strava export data #' # Step 1: Download your Strava data export #' # Go to Strava.com > Settings > My Account > Download or Delete Your Account #' # You'll receive a ZIP file via email (e.g., export_12345678.zip) -#' +#' #' # Step 2: Load activities directly from ZIP (no extraction needed!) #' activities <- load_local_activities("export_12345678.zip") -#' +#' #' # Or from extracted CSV #' activities <- load_local_activities("strava_export_data/activities.csv") -#' +#' #' # Step 3: Calculate ACWR for Runs (using distance) -#' run_acwr <- calculate_acwr(activities_data = activities, -#' activity_type = "Run", -#' load_metric = "distance_km") +#' run_acwr <- calculate_acwr( +#' activities_data = activities, +#' activity_type = "Run", +#' load_metric = "distance_km" +#' ) #' print(tail(run_acwr)) -#' +#' #' # Calculate ACWR for Rides (using TSS, requires FTP) -#' ride_acwr_tss <- calculate_acwr(activities_data = activities, -#' activity_type = "Ride", -#' load_metric = "tss", -#' user_ftp = 280) +#' ride_acwr_tss <- calculate_acwr( +#' activities_data = activities, +#' activity_type = "Ride", +#' load_metric = "tss", +#' user_ftp = 280 +#' ) #' print(tail(ride_acwr_tss)) -#' +#' #' # Plot the results #' plot_acwr(run_acwr, highlight_zones = TRUE) -#' +#' #' # Multi-athlete cohort analysis -#' +#' #' # Load data for multiple athletes and add athlete_id #' athlete1 <- load_local_activities("athlete1_export.zip") %>% #' dplyr::mutate(athlete_id = "athlete1") -#' +#' #' athlete2 <- load_local_activities("athlete2_export.zip") %>% #' dplyr::mutate(athlete_id = "athlete2") -#' +#' #' # Combine all athletes #' cohort_data <- dplyr::bind_rows(athlete1, athlete2) -#' +#' #' # Calculate ACWR for each athlete using group_modify() #' cohort_acwr <- cohort_data %>% #' dplyr::group_by(athlete_id) %>% -#' dplyr::group_modify(~ calculate_acwr(.x, -#' activity_type = "Run", -#' load_metric = "duration_mins")) %>% +#' dplyr::group_modify(~ calculate_acwr(.x, +#' activity_type = "Run", +#' load_metric = "duration_mins" +#' )) %>% #' dplyr::ungroup() -#' +#' #' # View results #' print(cohort_acwr) #' } @@ -183,27 +188,28 @@ calculate_acwr <- function(activities_data, user_max_hr = NULL, user_resting_hr = NULL, smoothing_period = 7) { - # --- Input Validation --- if (missing(activities_data) || is.null(activities_data)) { stop("`activities_data` must be provided. Use load_local_activities() to load your Strava export data.") } - + if (!is.data.frame(activities_data)) { stop("`activities_data` must be a data frame (e.g., from load_local_activities()).") } if (!is.numeric(acute_period) || acute_period <= 0) stop("`acute_period` must be a positive integer.") if (!is.numeric(chronic_period) || chronic_period <= 0) stop("`chronic_period` must be a positive integer.") if (acute_period >= chronic_period) stop("`acute_period` must be less than `chronic_period`.") - + # Validate load metric parameters using internal helper validate_load_metric_params(load_metric, user_ftp, user_max_hr, user_resting_hr) - + # Force explicit activity_type specification to prevent mixing incompatible sports if (is.null(activity_type) || length(activity_type) == 0) { - stop("`activity_type` must be explicitly specified (e.g., 'Run' or 'Ride'). ", - "Mixing different activity types can lead to incompatible load metrics. ", - "Please specify the activity type(s) you want to analyze.") + stop( + "`activity_type` must be explicitly specified (e.g., 'Run' or 'Ride'). ", + "Mixing different activity types can lead to incompatible load metrics. ", + "Please specify the activity type(s) you want to analyze." + ) } # --- Date Handling --- @@ -212,28 +218,28 @@ calculate_acwr <- function(activities_data, if (analysis_start_date >= analysis_end_date) stop("start_date must be before end_date.") message(sprintf("Calculating ACWR data from %s to %s.", analysis_start_date, analysis_end_date)) - message(sprintf("Using metric: %s, Activity types: %s", load_metric, paste(activity_type %||% "All", collapse=", "))) + message(sprintf("Using metric: %s, Activity types: %s", load_metric, paste(activity_type %||% "All", collapse = ", "))) message(sprintf("Acute period: %d days, Chronic period: %d days", acute_period, chronic_period)) # --- Get Activities Data (Local Only) --- fetch_start_buffer_days <- chronic_period fetch_start_date <- analysis_start_date - lubridate::days(fetch_start_buffer_days) - + # Use local activities data message("Processing local activities data...") activities_df_filtered <- activities_data %>% dplyr::filter(.data$date >= fetch_start_date & .data$date <= analysis_end_date) - + if (!is.null(activity_type)) { activities_df_filtered <- activities_df_filtered %>% dplyr::filter(.data$type %in% activity_type) } - + activities_fetched_count <- nrow(activities_df_filtered) message(sprintf("Loaded %d activities from local data.", activities_fetched_count)) - + if (activities_fetched_count == 0) { - stop("No activities found in local data for the required date range (", fetch_start_date, " to ", analysis_end_date,").") + stop("No activities found in local data for the required date range (", fetch_start_date, " to ", analysis_end_date, ").") } # --- Process Activities into Daily Load (using internal helper) --- @@ -244,7 +250,7 @@ calculate_acwr <- function(activities_data, user_max_hr = user_max_hr, user_resting_hr = user_resting_hr ) - + message("Finished processing activity list.") if (is.null(daily_load_df) || nrow(daily_load_df) == 0) { @@ -253,20 +259,20 @@ calculate_acwr <- function(activities_data, daily_load_summary <- daily_load_df %>% dplyr::group_by(date) %>% - dplyr::summarise(daily_load = sum(load, na.rm = TRUE), .groups = 'drop') + dplyr::summarise(daily_load = sum(load, na.rm = TRUE), .groups = "drop") # --- Create Full Time Series & Calculate ATL/CTL --- all_dates_sequence <- seq(fetch_start_date, analysis_end_date, by = "day") daily_load_complete <- dplyr::tibble(date = all_dates_sequence) %>% dplyr::left_join(daily_load_summary, by = "date") %>% - dplyr::mutate(daily_load = dplyr::coalesce(.data$daily_load, 0)) %>% + dplyr::mutate(daily_load = dplyr::coalesce(.data$daily_load, 0)) %>% dplyr::arrange(.data$date) - + # --- Force evaluation to potentially resolve lazy-eval issues --- force(daily_load_complete) # --- End force eval --- - + # --- DEBUG REMOVED: Check daily_load_complete before pipeline --- # message("--- Checking daily_load_complete structure and summary ---") # print(utils::str(daily_load_complete)) @@ -276,7 +282,7 @@ calculate_acwr <- function(activities_data, if (nrow(daily_load_complete) < chronic_period) { warning("Not enough data points (after fetching) to calculate the full chronic period. Results may be unreliable.") } - + acwr_data_intermediate <- daily_load_complete %>% dplyr::mutate( # Convert daily_load to numeric before rollmean @@ -290,8 +296,9 @@ calculate_acwr <- function(activities_data, dplyr::mutate( # Explicitly handle potential NA in chronic_load within the condition acwr = ifelse(!is.na(.data$chronic_load) & .data$chronic_load > 0.01, - .data$acute_load / .data$chronic_load, - NA) + .data$acute_load / .data$chronic_load, + NA + ) ) %>% # --- Ensure acwr is numeric before next rollmean --- dplyr::mutate(acwr = as.numeric(.data$acwr)) %>% @@ -312,4 +319,4 @@ calculate_acwr <- function(activities_data, } # Helper needed if not globally available -# `%||%` <- function(x, y) if (is.null(x) || length(x) == 0) y else x \ No newline at end of file +# `%||%` <- function(x, y) if (is.null(x) || length(x) == 0) y else x diff --git a/R/calculate_acwr_ewma.R b/R/calculate_acwr_ewma.R index bb2d903..697613e 100644 --- a/R/calculate_acwr_ewma.R +++ b/R/calculate_acwr_ewma.R @@ -35,7 +35,7 @@ #' with configurable half-lives. More responsive to recent changes. #' } #' -#' **EWMA Formula**: The smoothing parameter alpha is calculated from half-life: +#' **EWMA Formula**: The smoothing parameter alpha is calculated from half-life: #' `alpha = ln(2) / half_life`. The EWMA update is: `E_t = alpha * L_t + (1-alpha) * E_{t-1}` #' where L_t is daily load and E_t is the exponentially weighted average. #' @@ -50,8 +50,12 @@ #' @importFrom stats quantile #' #' @examples +#' # Example using pre-calculated sample data +#' data("sample_acwr", package = "Athlytics") +#' head(sample_acwr) +#' #' \dontrun{ -#' # Load local activities +#' # Full workflow with real data - Load local activities #' activities <- load_local_activities("export_12345678.zip") #' #' # Calculate ACWR using Rolling Average (RA) @@ -72,36 +76,35 @@ #' } #' @export calculate_acwr_ewma <- function(activities_data, - activity_type = NULL, - load_metric = "duration_mins", - method = c("ra", "ewma"), - acute_period = 7, - chronic_period = 28, - half_life_acute = 3.5, - half_life_chronic = 14, - start_date = NULL, - end_date = NULL, - user_ftp = NULL, - user_max_hr = NULL, - user_resting_hr = NULL, - smoothing_period = 7, - ci = FALSE, - B = 200, - block_len = 7, - conf_level = 0.95) { - + activity_type = NULL, + load_metric = "duration_mins", + method = c("ra", "ewma"), + acute_period = 7, + chronic_period = 28, + half_life_acute = 3.5, + half_life_chronic = 14, + start_date = NULL, + end_date = NULL, + user_ftp = NULL, + user_max_hr = NULL, + user_resting_hr = NULL, + smoothing_period = 7, + ci = FALSE, + B = 200, + block_len = 7, + conf_level = 0.95) { # --- Match method argument --- method <- match.arg(method) - + # --- Input Validation --- if (missing(activities_data) || is.null(activities_data)) { stop("`activities_data` must be provided.") } - + if (!is.data.frame(activities_data)) { stop("`activities_data` must be a data frame.") } - + if (method == "ewma") { if (!is.numeric(half_life_acute) || half_life_acute <= 0) { stop("`half_life_acute` must be a positive number.") @@ -123,94 +126,108 @@ calculate_acwr_ewma <- function(activities_data, stop("`acute_period` must be less than `chronic_period`.") } } - + if (ci && method == "ra") { warning("Confidence bands are only available for EWMA method. Setting ci = FALSE.") ci <- FALSE } - + # --- Date Handling --- - analysis_end_date <- tryCatch(lubridate::as_date(end_date %||% Sys.Date()), - error = function(e) Sys.Date()) - analysis_start_date <- tryCatch(lubridate::as_date(start_date %||% (analysis_end_date - lubridate::days(365))), - error = function(e) analysis_end_date - lubridate::days(365)) - + analysis_end_date <- tryCatch(lubridate::as_date(end_date %||% Sys.Date()), + error = function(e) Sys.Date() + ) + analysis_start_date <- tryCatch(lubridate::as_date(start_date %||% (analysis_end_date - lubridate::days(365))), + error = function(e) analysis_end_date - lubridate::days(365) + ) + if (analysis_start_date >= analysis_end_date) { stop("start_date must be before end_date.") } - + # Validate load_metric and required parameters valid_load_metrics <- c("duration_mins", "distance_km", "elapsed_time_mins", "tss", "hrss", "elevation_gain_m") if (!load_metric %in% valid_load_metrics) { stop("Invalid `load_metric`. Choose from: ", paste(valid_load_metrics, collapse = ", ")) } - + if (load_metric == "tss" && is.null(user_ftp)) { stop("`user_ftp` is required when `load_metric` is 'tss'.") } - + if (load_metric == "hrss" && (is.null(user_max_hr) || is.null(user_resting_hr))) { stop("`user_max_hr` and `user_resting_hr` are required when `load_metric` is 'hrss'.") } - + # Force explicit activity_type specification to prevent mixing incompatible sports if (is.null(activity_type) || length(activity_type) == 0) { - stop("`activity_type` must be explicitly specified (e.g., 'Run' or 'Ride'). ", - "Mixing different activity types can lead to incompatible load metrics. ", - "Please specify the activity type(s) you want to analyze.") + stop( + "`activity_type` must be explicitly specified (e.g., 'Run' or 'Ride'). ", + "Mixing different activity types can lead to incompatible load metrics. ", + "Please specify the activity type(s) you want to analyze." + ) } - - message(sprintf("Calculating ACWR (%s) from %s to %s.", - toupper(method), analysis_start_date, analysis_end_date)) - message(sprintf("Load metric: %s, Activity types: %s", - load_metric, paste(activity_type %||% "All", collapse = ", "))) - + + message(sprintf( + "Calculating ACWR (%s) from %s to %s.", + toupper(method), analysis_start_date, analysis_end_date + )) + message(sprintf( + "Load metric: %s, Activity types: %s", + load_metric, paste(activity_type %||% "All", collapse = ", ") + )) + # --- Get Daily Load (reuse logic from calculate_acwr) --- fetch_start_buffer_days <- if (method == "ra") chronic_period else ceiling(4 * half_life_chronic) fetch_start_date <- analysis_start_date - lubridate::days(fetch_start_buffer_days) - + # Filter activities activities_df_filtered <- activities_data %>% dplyr::filter(.data$date >= fetch_start_date & .data$date <= analysis_end_date) - + if (!is.null(activity_type)) { activities_df_filtered <- activities_df_filtered %>% dplyr::filter(.data$type %in% activity_type) } - + message(sprintf("Processing %d activities...", nrow(activities_df_filtered))) - + if (nrow(activities_df_filtered) == 0) { stop("No activities found for the specified criteria.") } - + # Calculate daily load using internal helper - daily_load_df <- calculate_daily_load_internal(activities_df_filtered, load_metric, - user_ftp, user_max_hr, user_resting_hr) - + daily_load_df <- calculate_daily_load_internal( + activities_df_filtered, load_metric, + user_ftp, user_max_hr, user_resting_hr + ) + daily_load_summary <- daily_load_df %>% dplyr::group_by(date) %>% - dplyr::summarise(daily_load = sum(load, na.rm = TRUE), .groups = 'drop') - + dplyr::summarise(daily_load = sum(load, na.rm = TRUE), .groups = "drop") + # Create complete time series all_dates_sequence <- seq(fetch_start_date, analysis_end_date, by = "day") daily_load_complete <- dplyr::tibble(date = all_dates_sequence) %>% dplyr::left_join(daily_load_summary, by = "date") %>% dplyr::mutate(daily_load = dplyr::coalesce(.data$daily_load, 0)) %>% dplyr::arrange(.data$date) - + # --- Calculate ACWR based on method --- if (method == "ra") { - acwr_data <- calculate_acwr_ra_internal(daily_load_complete, acute_period, - chronic_period, smoothing_period, - analysis_start_date, analysis_end_date) + acwr_data <- calculate_acwr_ra_internal( + daily_load_complete, acute_period, + chronic_period, smoothing_period, + analysis_start_date, analysis_end_date + ) } else { - acwr_data <- calculate_acwr_ewma_internal(daily_load_complete, half_life_acute, - half_life_chronic, smoothing_period, - analysis_start_date, analysis_end_date, - ci, B, block_len, conf_level) + acwr_data <- calculate_acwr_ewma_internal( + daily_load_complete, half_life_acute, + half_life_chronic, smoothing_period, + analysis_start_date, analysis_end_date, + ci, B, block_len, conf_level + ) } - + message("Calculation complete.") return(acwr_data) } @@ -220,20 +237,23 @@ calculate_acwr_ewma <- function(activities_data, #' @keywords internal #' @noRd calculate_acwr_ra_internal <- function(daily_load_complete, acute_period, chronic_period, - smoothing_period, start_date, end_date) { + smoothing_period, start_date, end_date) { acwr_data <- daily_load_complete %>% dplyr::mutate( daily_load = as.numeric(.data$daily_load), acute_load = zoo::rollmean(.data$daily_load, k = acute_period, fill = NA, align = "right"), chronic_load = zoo::rollmean(.data$daily_load, k = chronic_period, fill = NA, align = "right"), acwr = ifelse(!is.na(.data$chronic_load) & .data$chronic_load > 0.01, - .data$acute_load / .data$chronic_load, NA), + .data$acute_load / .data$chronic_load, NA + ), acwr_smooth = zoo::rollmean(.data$acwr, k = smoothing_period, align = "right", fill = NA) ) %>% dplyr::filter(.data$date >= start_date & .data$date <= end_date) %>% - dplyr::select(.data$date, atl = .data$acute_load, ctl = .data$chronic_load, - .data$acwr, .data$acwr_smooth) - + dplyr::select(.data$date, + atl = .data$acute_load, ctl = .data$chronic_load, + .data$acwr, .data$acwr_smooth + ) + return(acwr_data) } @@ -242,34 +262,33 @@ calculate_acwr_ra_internal <- function(daily_load_complete, acute_period, chroni #' @keywords internal #' @noRd calculate_acwr_ewma_internal <- function(daily_load_complete, half_life_acute, half_life_chronic, - smoothing_period, start_date, end_date, - ci, B, block_len, conf_level) { - + smoothing_period, start_date, end_date, + ci, B, block_len, conf_level) { # Calculate alpha from half-life: α = ln(2) / half_life alpha_acute <- log(2) / half_life_acute alpha_chronic <- log(2) / half_life_chronic - + # Calculate EWMA loads loads <- daily_load_complete$daily_load n <- length(loads) - + acute_load <- numeric(n) chronic_load <- numeric(n) - + acute_load[1] <- loads[1] chronic_load[1] <- loads[1] - + for (i in 2:n) { - acute_load[i] <- alpha_acute * loads[i] + (1 - alpha_acute) * acute_load[i-1] - chronic_load[i] <- alpha_chronic * loads[i] + (1 - alpha_chronic) * chronic_load[i-1] + acute_load[i] <- alpha_acute * loads[i] + (1 - alpha_acute) * acute_load[i - 1] + chronic_load[i] <- alpha_chronic * loads[i] + (1 - alpha_chronic) * chronic_load[i - 1] } - + # Calculate ACWR acwr <- ifelse(chronic_load > 0.01, acute_load / chronic_load, NA) - + # Smooth ACWR acwr_smooth <- zoo::rollmean(acwr, k = smoothing_period, align = "right", fill = NA) - + # Build base result acwr_data <- data.frame( date = daily_load_complete$date, @@ -279,19 +298,23 @@ calculate_acwr_ewma_internal <- function(daily_load_complete, half_life_acute, h acwr_smooth = acwr_smooth ) %>% dplyr::filter(.data$date >= start_date & .data$date <= end_date) - + # --- Bootstrap Confidence Bands --- if (ci) { - message(sprintf("Calculating %d%% confidence bands using %d bootstrap iterations...", - conf_level * 100, B)) - - ci_bounds <- bootstrap_acwr_ci(loads, alpha_acute, alpha_chronic, - smoothing_period, B, block_len, conf_level) - + message(sprintf( + "Calculating %d%% confidence bands using %d bootstrap iterations...", + conf_level * 100, B + )) + + ci_bounds <- bootstrap_acwr_ci( + loads, alpha_acute, alpha_chronic, + smoothing_period, B, block_len, conf_level + ) + # Trim to analysis period start_idx <- which(daily_load_complete$date == start_date)[1] end_idx <- which(daily_load_complete$date == end_date)[1] - + if (!is.na(start_idx) && !is.na(end_idx)) { acwr_data$acwr_lower <- ci_bounds$lower[start_idx:end_idx] acwr_data$acwr_upper <- ci_bounds$upper[start_idx:end_idx] @@ -300,7 +323,7 @@ calculate_acwr_ewma_internal <- function(daily_load_complete, half_life_acute, h acwr_data$acwr_upper <- NA } } - + return(acwr_data) } @@ -308,55 +331,52 @@ calculate_acwr_ewma_internal <- function(daily_load_complete, half_life_acute, h #' Internal: Bootstrap Confidence Intervals for EWMA ACWR #' @keywords internal #' @noRd -bootstrap_acwr_ci <- function(loads, alpha_acute, alpha_chronic, - smoothing_period, B, block_len, conf_level) { - +bootstrap_acwr_ci <- function(loads, alpha_acute, alpha_chronic, + smoothing_period, B, block_len, conf_level) { n <- length(loads) n_blocks <- ceiling(n / block_len) - + # Store bootstrap ACWR values boot_acwr_matrix <- matrix(NA, nrow = n, ncol = B) - + for (b in 1:B) { # Moving-block bootstrap: sample blocks with replacement sampled_blocks <- sample(1:n_blocks, n_blocks, replace = TRUE) boot_loads <- numeric(0) - + for (block_idx in sampled_blocks) { start_pos <- (block_idx - 1) * block_len + 1 end_pos <- min(block_idx * block_len, n) boot_loads <- c(boot_loads, loads[start_pos:end_pos]) } - + # Trim to original length boot_loads <- boot_loads[1:n] - + # Calculate EWMA for this bootstrap sample acute_boot <- numeric(n) chronic_boot <- numeric(n) acute_boot[1] <- boot_loads[1] chronic_boot[1] <- boot_loads[1] - + for (i in 2:n) { - acute_boot[i] <- alpha_acute * boot_loads[i] + (1 - alpha_acute) * acute_boot[i-1] - chronic_boot[i] <- alpha_chronic * boot_loads[i] + (1 - alpha_chronic) * chronic_boot[i-1] + acute_boot[i] <- alpha_acute * boot_loads[i] + (1 - alpha_acute) * acute_boot[i - 1] + chronic_boot[i] <- alpha_chronic * boot_loads[i] + (1 - alpha_chronic) * chronic_boot[i - 1] } - + acwr_boot <- ifelse(chronic_boot > 0.01, acute_boot / chronic_boot, NA) acwr_boot_smooth <- zoo::rollmean(acwr_boot, k = smoothing_period, align = "right", fill = NA) - + boot_acwr_matrix[, b] <- acwr_boot_smooth } - + # Calculate percentiles alpha_level <- 1 - conf_level lower_quantile <- alpha_level / 2 upper_quantile <- 1 - alpha_level / 2 - + acwr_lower <- apply(boot_acwr_matrix, 1, function(x) quantile(x, probs = lower_quantile, na.rm = TRUE)) acwr_upper <- apply(boot_acwr_matrix, 1, function(x) quantile(x, probs = upper_quantile, na.rm = TRUE)) - + list(lower = acwr_lower, upper = acwr_upper) } - - diff --git a/R/calculate_decoupling.R b/R/calculate_decoupling.R index 2187a55..641a0a9 100644 --- a/R/calculate_decoupling.R +++ b/R/calculate_decoupling.R @@ -11,7 +11,7 @@ #' @param export_dir Base directory of Strava export containing the activities folder. #' Default is "strava_export_data". #' @param activity_type Type(s) of activities to analyze (e.g., "Run", "Ride"). -#' @param decouple_metric Basis for calculation: "pace_hr" or "power_hr" +#' @param decouple_metric Basis for calculation: "pace_hr" or "power_hr" #' (legacy "pace_hr"/"power_hr" also supported). #' @param start_date Optional. Analysis start date (YYYY-MM-DD string or Date). Defaults to one year ago. #' @param end_date Optional. Analysis end date (YYYY-MM-DD string or Date). Defaults to today. @@ -22,18 +22,18 @@ #' Activities with higher variability are rejected as non-steady-state. #' @param min_hr_coverage Minimum HR data coverage threshold (default: 0.9 = 90%). #' Activities with lower HR coverage are rejected as insufficient data quality. -#' @param quality_control Quality control mode: "off" (no filtering), "flag" (mark issues), +#' @param quality_control Quality control mode: "off" (no filtering), "flag" (mark issues), #' or "filter" (exclude flagged data). Default "filter" for scientific rigor. #' @param stream_df Optional. A pre-fetched data frame for a *single* activity's stream. #' If provided, calculates decoupling for this data directly, ignoring other parameters. -#' Must include columns: `time`, `heartrate`, and either `velocity_smooth`/`distance` +#' Must include columns: `time`, `heartrate`, and either `velocity_smooth`/`distance` #' (for pace_hr) or `watts` (for power_hr). #' #' @return Returns a data frame with columns: #' \describe{ #' \item{date}{Activity date (Date class)} #' \item{decoupling}{Decoupling percentage (\\%). Positive = HR drift, negative = improved efficiency} -#' \item{status}{Character. "ok" for successful calculation, "non_steady" if steady-state +#' \item{status}{Character. "ok" for successful calculation, "non_steady" if steady-state #' criteria not met, "insufficient_data" if data quality issues} #' } #' OR a single numeric decoupling value if `stream_df` is provided. @@ -41,9 +41,9 @@ #' @details Provides data for `plot_decoupling`. Compares output/HR efficiency #' between first and second halves of activities. Positive values indicate #' HR drift (cardiovascular drift). -#' +#' #' **Best practice**: Use `load_local_activities()` to load data, then pass to this function. -#' +#' #' The function parses FIT/TCX/GPX files from your Strava export to extract detailed #' stream data (time, heartrate, distance/power). Activities are split into two halves, #' and the efficiency factor (output/HR) is compared between halves. @@ -57,8 +57,8 @@ #' #' @examples #' # Example using simulated data -#' data(athlytics_sample_decoupling) -#' print(head(athlytics_sample_decoupling)) +#' data(sample_decoupling) +#' print(head(sample_decoupling)) #' #' \dontrun{ #' # Load local activities @@ -66,14 +66,14 @@ #' #' # Calculate Pace/HR decoupling for recent runs #' run_decoupling <- calculate_decoupling( -#' activities_data = activities, -#' export_dir = "strava_export_data", -#' activity_type = "Run", -#' decouple_metric = "pace_hr", -#' start_date = "2024-01-01" +#' activities_data = activities, +#' export_dir = "strava_export_data", +#' activity_type = "Run", +#' decouple_metric = "pace_hr", +#' start_date = "2024-01-01" #' ) #' print(tail(run_decoupling)) -#' +#' #' # Calculate for a single activity stream #' # stream_data <- parse_activity_file("strava_export_data/activities/12345.fit") #' # single_decoupling <- calculate_decoupling(stream_df = stream_data, decouple_metric = "pace_hr") @@ -90,25 +90,24 @@ calculate_decoupling <- function(activities_data = NULL, min_hr_coverage = 0.9, quality_control = c("off", "flag", "filter"), stream_df = NULL) { - # --- Input Validation --- decouple_metric <- match.arg(decouple_metric) - + # Normalize to lowercase (support legacy capitalized names) decouple_metric <- tolower(decouple_metric) - + # If stream_df provided, calculate for single activity if (!is.null(stream_df)) { result <- calculate_single_decoupling(stream_df, decouple_metric) # Return just the numeric value for backward compatibility return(result$value) } - + # Otherwise, need activities_data if (missing(activities_data) || is.null(activities_data) || !is.data.frame(activities_data)) { stop("`activities_data` must be provided as a data frame from load_local_activities().") } - + if (!is.numeric(min_duration_mins) || min_duration_mins <= 0) { stop("`min_duration_mins` must be a positive number.") } @@ -121,22 +120,26 @@ calculate_decoupling <- function(activities_data = NULL, if (!is.numeric(min_hr_coverage) || min_hr_coverage <= 0 || min_hr_coverage > 1) { stop("`min_hr_coverage` must be between 0 and 1.") } - + quality_control <- match.arg(quality_control) - + # --- Date Handling --- - analysis_end_date <- tryCatch(lubridate::as_date(end_date %||% Sys.Date()), - error = function(e) Sys.Date()) - analysis_start_date <- tryCatch(lubridate::as_date(start_date %||% (analysis_end_date - lubridate::days(365))), - error = function(e) analysis_end_date - lubridate::days(365)) - + analysis_end_date <- tryCatch(lubridate::as_date(end_date %||% Sys.Date()), + error = function(e) Sys.Date() + ) + analysis_start_date <- tryCatch(lubridate::as_date(start_date %||% (analysis_end_date - lubridate::days(365))), + error = function(e) analysis_end_date - lubridate::days(365) + ) + if (analysis_start_date >= analysis_end_date) { stop("start_date must be before end_date.") } - - message(sprintf("Calculating decoupling (%s) from %s to %s.", - decouple_metric, analysis_start_date, analysis_end_date)) - + + message(sprintf( + "Calculating decoupling (%s) from %s to %s.", + decouple_metric, analysis_start_date, analysis_end_date + )) + # --- Filter Activities --- filtered_activities <- activities_data %>% dplyr::filter( @@ -146,56 +149,68 @@ calculate_decoupling <- function(activities_data = NULL, (.data$moving_time / 60) >= min_duration_mins ) %>% dplyr::arrange(dplyr::desc(.data$date)) - + if (nrow(filtered_activities) == 0) { stop("No activities found matching the specified criteria.") } - + message(sprintf("Found %d activities meeting criteria. Processing...", nrow(filtered_activities))) - + # --- Process Each Activity --- decoupling_results <- purrr::map_dfr(1:nrow(filtered_activities), function(i) { activity <- filtered_activities[i, ] - + if (is.na(activity$filename) || activity$filename == "") { - message(sprintf("[%d/%d] Skipping activity %s (no filename)", - i, nrow(filtered_activities), activity$date)) + message(sprintf( + "[%d/%d] Skipping activity %s (no filename)", + i, nrow(filtered_activities), activity$date + )) return(NULL) } - + # Construct file path file_path <- file.path(export_dir, activity$filename) - + if (!file.exists(file_path)) { - message(sprintf("[%d/%d] Skipping activity %s (file not found: %s)", - i, nrow(filtered_activities), activity$date, basename(file_path))) + message(sprintf( + "[%d/%d] Skipping activity %s (file not found: %s)", + i, nrow(filtered_activities), activity$date, basename(file_path) + )) return(NULL) } - - message(sprintf("[%d/%d] Processing %s (%s)", - i, nrow(filtered_activities), activity$date, basename(file_path))) - + + message(sprintf( + "[%d/%d] Processing %s (%s)", + i, nrow(filtered_activities), activity$date, basename(file_path) + )) + # Parse activity file - stream_data <- tryCatch({ - parse_activity_file(file_path) - }, error = function(e) { - message(sprintf(" Error parsing file: %s", e$message)) - return(NULL) - }) - + stream_data <- tryCatch( + { + parse_activity_file(file_path) + }, + error = function(e) { + message(sprintf(" Error parsing file: %s", e$message)) + return(NULL) + } + ) + if (is.null(stream_data) || nrow(stream_data) == 0) { message(" No stream data extracted") return(NULL) } - + # Calculate decoupling for this activity - decoupling_result <- tryCatch({ - calculate_single_decoupling(stream_data, decouple_metric, quality_control, min_steady_minutes, steady_cv_threshold, min_hr_coverage) - }, error = function(e) { - message(sprintf(" Error calculating decoupling: %s", e$message)) - return(list(value = NA_real_, status = "calculation_error")) - }) - + decoupling_result <- tryCatch( + { + calculate_single_decoupling(stream_data, decouple_metric, quality_control, min_steady_minutes, steady_cv_threshold, min_hr_coverage) + }, + error = function(e) { + message(sprintf(" Error calculating decoupling: %s", e$message)) + return(list(value = NA_real_, status = "calculation_error")) + } + ) + # Handle both old format (just numeric) and new format (list with status) if (is.list(decoupling_result)) { decoupling_value <- decoupling_result$value @@ -204,7 +219,7 @@ calculate_decoupling <- function(activities_data = NULL, decoupling_value <- decoupling_result status <- if (is.na(decoupling_value)) "insufficient_data" else "ok" } - + # Return result with status data.frame( date = activity$date, @@ -213,13 +228,13 @@ calculate_decoupling <- function(activities_data = NULL, stringsAsFactors = FALSE ) }) - + if (is.null(decoupling_results) || nrow(decoupling_results) == 0) { stop("No decoupling values could be calculated. Check that activity files contain stream data.") } - + message(sprintf("Successfully calculated decoupling for %d activities.", nrow(decoupling_results))) - + return(decoupling_results %>% dplyr::arrange(.data$date)) } @@ -228,32 +243,31 @@ calculate_decoupling <- function(activities_data = NULL, #' @keywords internal #' @noRd calculate_single_decoupling <- function(stream_df, decouple_metric, quality_control = "filter", min_steady_minutes = 40, steady_cv_threshold = 0.08, min_hr_coverage = 0.9) { - # Validate stream_df structure required_cols <- c("time", "heartrate") if (decouple_metric == "pace_hr") { if (!"distance" %in% colnames(stream_df) && !"velocity_smooth" %in% colnames(stream_df)) { stop("For pace_hr decoupling, stream_df must contain 'distance' or 'velocity_smooth' column.") } - } else { # power_hr + } else { # power_hr if (!"watts" %in% colnames(stream_df)) { stop("For power_hr decoupling, stream_df must contain 'watts' column.") } } - + missing_cols <- setdiff(required_cols, colnames(stream_df)) if (length(missing_cols) > 0) { stop("stream_df missing required columns: ", paste(missing_cols, collapse = ", ")) } - + # Remove NA values stream_clean <- stream_df %>% dplyr::filter(!is.na(.data$time), !is.na(.data$heartrate)) - + if (nrow(stream_clean) < 100) { return(list(value = NA_real_, status = "insufficient_data_points")) } - + # Calculate velocity if needed if (decouple_metric == "pace_hr") { if ("velocity_smooth" %in% colnames(stream_clean)) { @@ -269,50 +283,50 @@ calculate_single_decoupling <- function(stream_df, decouple_metric, quality_cont velocity = ifelse(.data$time_diff > 0, .data$distance_diff / .data$time_diff, 0) ) } - + stream_clean <- stream_clean %>% dplyr::filter(!is.na(.data$velocity), .data$velocity > 0, .data$heartrate > 0) } else { stream_clean <- stream_clean %>% dplyr::filter(!is.na(.data$watts), .data$watts > 0, .data$heartrate > 0) } - + if (nrow(stream_clean) < 100) { return(list(value = NA_real_, status = "insufficient_valid_data")) } - + # Apply quality control and steady-state gating if (quality_control != "off") { # Basic quality gates if (decouple_metric == "pace_hr") { # Check for reasonable velocity values stream_clean <- stream_clean %>% - dplyr::filter(.data$velocity > 0.5, .data$velocity < 15) # 0.5-15 m/s reasonable range + dplyr::filter(.data$velocity > 0.5, .data$velocity < 15) # 0.5-15 m/s reasonable range } else { # Check for reasonable power values stream_clean <- stream_clean %>% - dplyr::filter(.data$watts > 0, .data$watts < 2000) # 0-2000W reasonable range + dplyr::filter(.data$watts > 0, .data$watts < 2000) # 0-2000W reasonable range } - + # Check for reasonable HR values stream_clean <- stream_clean %>% dplyr::filter(.data$heartrate > 50, .data$heartrate < 220) - + if (nrow(stream_clean) < 100) { return(list(value = NA_real_, status = "insufficient_data_after_quality_filter")) } } - + # Calculate HR coverage hr_coverage <- sum(!is.na(stream_clean$heartrate) & stream_clean$heartrate > 0) / nrow(stream_clean) if (hr_coverage < min_hr_coverage) { return(list(value = NA_real_, status = "insufficient_hr_data")) } - + # Find steady-state windows using rolling coefficient of variation - window_size <- min(300, nrow(stream_clean) %/% 4) # 5-minute windows or 1/4 of data - if (window_size < 60) window_size <- 60 # Minimum 1-minute windows - + window_size <- min(300, nrow(stream_clean) %/% 4) # 5-minute windows or 1/4 of data + if (window_size < 60) window_size <- 60 # Minimum 1-minute windows + if (decouple_metric == "pace_hr") { # Calculate rolling CV for velocity stream_clean <- stream_clean %>% @@ -322,11 +336,10 @@ calculate_single_decoupling <- function(stream_df, decouple_metric, quality_cont velocity_rollsd = zoo::rollapply(.data$velocity, window_size, sd, fill = NA, align = "center"), velocity_cv = .data$velocity_rollsd / .data$velocity_rollmean ) - + # Find steady-state periods (CV < threshold) steady_periods <- stream_clean %>% dplyr::filter(!is.na(.data$velocity_cv), .data$velocity_cv < steady_cv_threshold) - } else { # Calculate rolling CV for power stream_clean <- stream_clean %>% @@ -336,12 +349,12 @@ calculate_single_decoupling <- function(stream_df, decouple_metric, quality_cont watts_rollsd = zoo::rollapply(.data$watts, window_size, sd, fill = NA, align = "center"), watts_cv = .data$watts_rollsd / .data$watts_rollmean ) - + # Find steady-state periods (CV < threshold) steady_periods <- stream_clean %>% dplyr::filter(!is.na(.data$watts_cv), .data$watts_cv < steady_cv_threshold) } - + # Check minimum duration for steady-state periods if (nrow(steady_periods) > 0) { steady_duration_minutes <- (max(steady_periods$time, na.rm = TRUE) - min(steady_periods$time, na.rm = TRUE)) / 60 @@ -349,16 +362,16 @@ calculate_single_decoupling <- function(stream_df, decouple_metric, quality_cont return(list(value = NA_real_, status = "insufficient_steady_duration")) } } - + if (nrow(steady_periods) < 100) { return(list(value = NA_real_, status = "non_steady")) } - + # Split steady-state periods into two halves midpoint <- floor(nrow(steady_periods) / 2) first_half <- steady_periods[1:midpoint, ] second_half <- steady_periods[(midpoint + 1):nrow(steady_periods), ] - + # Calculate efficiency factor for each half from steady-state data only if (decouple_metric == "pace_hr") { ef_first <- median(first_half$velocity / first_half$heartrate, na.rm = TRUE) @@ -367,7 +380,7 @@ calculate_single_decoupling <- function(stream_df, decouple_metric, quality_cont ef_first <- median(first_half$watts / first_half$heartrate, na.rm = TRUE) ef_second <- median(second_half$watts / second_half$heartrate, na.rm = TRUE) } - + # Calculate decoupling percentage if (ef_first > 0) { decoupling_pct <- ((ef_first - ef_second) / ef_first) * 100 @@ -376,6 +389,6 @@ calculate_single_decoupling <- function(stream_df, decouple_metric, quality_cont decoupling_pct <- NA_real_ status <- "calculation_failed" } - + return(list(value = decoupling_pct, status = status)) } diff --git a/R/calculate_ef.R b/R/calculate_ef.R index fa2776f..6dfc8e0 100644 --- a/R/calculate_ef.R +++ b/R/calculate_ef.R @@ -29,16 +29,16 @@ #' } #' #' @param activities_data A data frame of activities from `load_local_activities()`. -#' Must contain columns: `date`, `type`, `moving_time`, `distance`, +#' Must contain columns: `date`, `type`, `moving_time`, `distance`, #' `average_heartrate`, and `average_watts` (for power_hr metric). #' @param activity_type Character vector or single string specifying activity type(s) #' to analyze. Common values: `"Run"`, `"Ride"`, or `c("Run", "Ride")`. #' Default: `c("Run", "Ride")`. #' @param ef_metric Character string specifying the efficiency metric: #' \itemize{ -#' \item `"pace_hr"`: Pace-based efficiency (for running). +#' \item `"pace_hr"`: Pace-based efficiency (for running). #' Formula: speed (m/s) / avg_HR. Units: m/s/bpm (higher = better fitness) -#' \item `"power_hr"`: Power-based efficiency (for cycling). +#' \item `"power_hr"`: Power-based efficiency (for cycling). #' Formula: avg_watts / avg_HR. Units: W/bpm (higher = better fitness) #' } #' Default: `c("pace_hr", "power_hr")` (uses first matching metric for activity type). @@ -55,7 +55,7 @@ #' Activities with higher variability are rejected as non-steady-state. #' @param min_hr_coverage Numeric. Minimum HR data coverage threshold (default: 0.9 = 90%). #' Activities with lower HR coverage are rejected as insufficient data quality. -#' @param quality_control Character. Quality control mode: "off" (no filtering), "flag" (mark issues), +#' @param quality_control Character. Quality control mode: "off" (no filtering), "flag" (mark issues), #' or "filter" (exclude flagged data). Default "filter" for scientific rigor. #' @param export_dir Optional. Path to Strava export directory containing activity files. #' When provided, enables stream data analysis for more accurate steady-state detection. @@ -66,8 +66,8 @@ #' \item{activity_type}{Activity type (character: "Run" or "Ride")} #' \item{ef_value}{Efficiency Factor value (numeric). Higher = better fitness. #' Units: m/s/bpm for pace_hr, W/bpm for power_hr.} -#' \item{status}{Character. "ok" for successful calculation with stream data, "no_streams" for -#' activity-level calculation without stream data, "non_steady" if steady-state +#' \item{status}{Character. "ok" for successful calculation with stream data, "no_streams" for +#' activity-level calculation without stream data, "non_steady" if steady-state #' criteria not met, "insufficient_data" if data quality issues, "too_short" if below min_steady_minutes, #' "insufficient_hr_data" if HR coverage below threshold.} #' } @@ -125,23 +125,27 @@ #' #' @examples #' # Example using simulated data -#' data(athlytics_sample_ef) -#' print(head(athlytics_sample_ef)) +#' data(sample_ef) +#' print(head(sample_ef)) #' #' \dontrun{ #' # Example using local Strava export data #' activities <- load_local_activities("strava_export_data/activities.csv") #' #' # Calculate Pace/HR efficiency factor for Runs -#' ef_data_run <- calculate_ef(activities_data = activities, -#' activity_type = "Run", -#' ef_metric = "pace_hr") +#' ef_data_run <- calculate_ef( +#' activities_data = activities, +#' activity_type = "Run", +#' ef_metric = "pace_hr" +#' ) #' print(tail(ef_data_run)) #' #' # Calculate Power/HR efficiency factor for Rides -#' ef_data_ride <- calculate_ef(activities_data = activities, -#' activity_type = "Ride", -#' ef_metric = "power_hr") +#' ef_data_ride <- calculate_ef( +#' activities_data = activities, +#' activity_type = "Ride", +#' ef_metric = "power_hr" +#' ) #' print(tail(ef_data_ride)) #' } calculate_ef <- function(activities_data, @@ -155,18 +159,17 @@ calculate_ef <- function(activities_data, min_hr_coverage = 0.9, quality_control = c("off", "flag", "filter"), export_dir = NULL) { - # --- Input Validation --- if (missing(activities_data) || is.null(activities_data)) { stop("`activities_data` must be provided. Use load_local_activities() to load your Strava export data.") } - + if (!is.data.frame(activities_data)) { stop("`activities_data` must be a data frame (e.g., from load_local_activities()).") } - + ef_metric <- match.arg(ef_metric) - + # Normalize to lowercase (support legacy capitalized names) ef_metric <- tolower(ef_metric) if (!is.numeric(min_duration_mins) || min_duration_mins < 0) { @@ -181,7 +184,7 @@ calculate_ef <- function(activities_data, if (!is.numeric(min_hr_coverage) || min_hr_coverage <= 0 || min_hr_coverage > 1) { stop("`min_hr_coverage` must be between 0 and 1.") } - + quality_control <- match.arg(quality_control) # --- Date Handling --- @@ -190,27 +193,29 @@ calculate_ef <- function(activities_data, if (analysis_start_date >= analysis_end_date) stop("start_date must be before end_date.") message(sprintf("Calculating EF data from %s to %s.", analysis_start_date, analysis_end_date)) - message(sprintf("Metric: %s, Activity types: %s", ef_metric, paste(activity_type, collapse=", "))) + message(sprintf("Metric: %s, Activity types: %s", ef_metric, paste(activity_type, collapse = ", "))) # --- Filter Activities --- message("Processing local activities data...") activities_df_filtered <- activities_data %>% dplyr::filter(.data$date >= analysis_start_date & .data$date <= analysis_end_date) - + if (!is.null(activity_type)) { activities_df_filtered <- activities_df_filtered %>% dplyr::filter(.data$type %in% activity_type) } - + activities_fetched_count <- nrow(activities_df_filtered) message(sprintf("Loaded %d activities from local data.", activities_fetched_count)) - + if (activities_fetched_count == 0) { stop("No activities found in local data for the date range.") } # --- Process Activities & Calculate EF --- - safe_as_numeric <- function(x) { as.numeric(rlang::`%||%`(x, 0)) } + safe_as_numeric <- function(x) { + as.numeric(rlang::`%||%`(x, 0)) + } ef_data <- purrr::map_dfr(1:nrow(activities_df_filtered), function(i) { activity <- activities_df_filtered[i, ] @@ -223,36 +228,49 @@ calculate_ef <- function(activities_data, weighted_power <- safe_as_numeric(activity$weighted_average_watts) power_used <- ifelse(weighted_power > 0, weighted_power, avg_power) - if (is.na(activity_date) || activity_date < analysis_start_date || activity_date > analysis_end_date) return(NULL) - if (!act_type %in% activity_type) return(NULL) - if (duration_sec < (min_duration_mins * 60)) return(NULL) - if (is.na(avg_hr) || avg_hr <= 0) return(NULL) - + if (is.na(activity_date) || activity_date < analysis_start_date || activity_date > analysis_end_date) { + return(NULL) + } + if (!act_type %in% activity_type) { + return(NULL) + } + if (duration_sec < (min_duration_mins * 60)) { + return(NULL) + } + if (is.na(avg_hr) || avg_hr <= 0) { + return(NULL) + } + # Try to parse stream data for proper steady-state analysis stream_data <- NULL if (!is.null(export_dir) && !is.na(activity$filename) && nchar(activity$filename) > 0) { - tryCatch({ - stream_data <- parse_activity_file(activity$filename, export_dir) - }, error = function(e) { - message(sprintf(" Could not parse stream data for activity %s: %s", activity_date, e$message)) - }) + tryCatch( + { + stream_data <- parse_activity_file(activity$filename, export_dir) + }, + error = function(e) { + message(sprintf(" Could not parse stream data for activity %s: %s", activity_date, e$message)) + } + ) } - + # If we have stream data, do proper steady-state analysis if (!is.null(stream_data) && nrow(stream_data) > 0) { - return(calculate_ef_from_stream(stream_data, activity_date, act_type, ef_metric, - min_steady_minutes, steady_cv_threshold, min_hr_coverage, quality_control)) + return(calculate_ef_from_stream( + stream_data, activity_date, act_type, ef_metric, + min_steady_minutes, steady_cv_threshold, min_hr_coverage, quality_control + )) } - + # Fallback to activity-level averages (with warnings about limitations) message(sprintf(" No stream data available for %s, using activity-level averages (less reliable)", activity_date)) - + # Quality control integration if (quality_control != "off") { # For now, we use simplified quality checks since we don't have stream data # In a full implementation, we would parse stream files and call flag_quality() # This is a placeholder for the quality control framework - + # Check for reasonable HR values (basic quality gate) if (avg_hr < 50 || avg_hr > 220) { if (quality_control == "filter") { @@ -267,7 +285,7 @@ calculate_ef <- function(activities_data, # If "flag", we continue but mark the status } } - + # Steady-state gating: check minimum duration if (duration_sec < (min_steady_minutes * 60)) { return(data.frame( @@ -314,9 +332,11 @@ calculate_ef <- function(activities_data, if (is.null(ef_data) || nrow(ef_data) == 0) { warning("No activities met the EF calculation criteria. Returning empty data frame.") - return(data.frame(date = lubridate::as_date(character(0)), - activity_type = character(0), - ef_value = numeric(0))) + return(data.frame( + date = lubridate::as_date(character(0)), + activity_type = character(0), + ef_value = numeric(0) + )) } ef_data <- ef_data %>% @@ -327,7 +347,7 @@ calculate_ef <- function(activities_data, } #' Calculate EF from Stream Data with Steady-State Analysis -#' +#' #' Calculate efficiency factor (EF) from detailed stream data using steady-state analysis. #' This function analyzes heart rate and power/pace data to find periods of steady effort #' and calculates the efficiency factor for those periods. @@ -360,9 +380,8 @@ calculate_ef <- function(activities_data, #' } #' #' @export -calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_metric, - min_steady_minutes, steady_cv_threshold, min_hr_coverage, quality_control) { - +calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_metric, + min_steady_minutes, steady_cv_threshold, min_hr_coverage, quality_control) { # Validate stream data structure required_cols <- c("time", "heartrate") if (ef_metric == "pace_hr") { @@ -375,7 +394,7 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - } else { # power_hr + } else { # power_hr if (!"watts" %in% colnames(stream_data)) { return(data.frame( date = activity_date, @@ -386,7 +405,7 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me )) } } - + missing_cols <- setdiff(required_cols, colnames(stream_data)) if (length(missing_cols) > 0) { return(data.frame( @@ -397,11 +416,11 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - + # Clean stream data stream_clean <- stream_data %>% dplyr::filter(!is.na(.data$time), !is.na(.data$heartrate)) - + if (nrow(stream_clean) < 100) { return(data.frame( date = activity_date, @@ -411,12 +430,12 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - + # Calculate HR coverage total_time <- max(stream_clean$time, na.rm = TRUE) - min(stream_clean$time, na.rm = TRUE) hr_data_time <- sum(!is.na(stream_clean$heartrate) & stream_clean$heartrate > 0) hr_coverage <- hr_data_time / nrow(stream_clean) - + if (hr_coverage < min_hr_coverage) { return(data.frame( date = activity_date, @@ -426,7 +445,7 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - + # Calculate velocity if needed for pace_hr if (ef_metric == "pace_hr") { if ("velocity_smooth" %in% colnames(stream_clean)) { @@ -442,14 +461,14 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me velocity = ifelse(.data$time_diff > 0, .data$distance_diff / .data$time_diff, 0) ) } - + stream_clean <- stream_clean %>% dplyr::filter(!is.na(.data$velocity), .data$velocity > 0, .data$heartrate > 0) } else { stream_clean <- stream_clean %>% dplyr::filter(!is.na(.data$watts), .data$watts > 0, .data$heartrate > 0) } - + if (nrow(stream_clean) < 100) { return(data.frame( date = activity_date, @@ -459,21 +478,21 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - + # Quality control if (quality_control != "off") { # Check for reasonable values if (ef_metric == "pace_hr") { stream_clean <- stream_clean %>% - dplyr::filter(.data$velocity > 0.5, .data$velocity < 15) # 0.5-15 m/s reasonable range + dplyr::filter(.data$velocity > 0.5, .data$velocity < 15) # 0.5-15 m/s reasonable range } else { stream_clean <- stream_clean %>% - dplyr::filter(.data$watts > 0, .data$watts < 2000) # 0-2000W reasonable range + dplyr::filter(.data$watts > 0, .data$watts < 2000) # 0-2000W reasonable range } - + stream_clean <- stream_clean %>% dplyr::filter(.data$heartrate > 50, .data$heartrate < 220) - + if (nrow(stream_clean) < 100) { return(data.frame( date = activity_date, @@ -484,7 +503,7 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me )) } } - + # Check minimum duration duration_minutes <- (max(stream_clean$time, na.rm = TRUE) - min(stream_clean$time, na.rm = TRUE)) / 60 if (duration_minutes < min_steady_minutes) { @@ -496,11 +515,11 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - + # Find steady-state windows using rolling coefficient of variation - window_size <- min(300, nrow(stream_clean) %/% 4) # 5-minute windows or 1/4 of data - if (window_size < 60) window_size <- 60 # Minimum 1-minute windows - + window_size <- min(300, nrow(stream_clean) %/% 4) # 5-minute windows or 1/4 of data + if (window_size < 60) window_size <- 60 # Minimum 1-minute windows + if (ef_metric == "pace_hr") { # Calculate rolling CV for velocity stream_clean <- stream_clean %>% @@ -510,11 +529,10 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me velocity_rollsd = zoo::rollapply(.data$velocity, window_size, sd, fill = NA, align = "center"), velocity_cv = .data$velocity_rollsd / .data$velocity_rollmean ) - + # Find steady-state periods (CV < threshold) steady_periods <- stream_clean %>% dplyr::filter(!is.na(.data$velocity_cv), .data$velocity_cv < steady_cv_threshold) - } else { # Calculate rolling CV for power stream_clean <- stream_clean %>% @@ -524,12 +542,12 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me watts_rollsd = zoo::rollapply(.data$watts, window_size, sd, fill = NA, align = "center"), watts_cv = .data$watts_rollsd / .data$watts_rollmean ) - + # Find steady-state periods (CV < threshold) steady_periods <- stream_clean %>% dplyr::filter(!is.na(.data$watts_cv), .data$watts_cv < steady_cv_threshold) } - + if (nrow(steady_periods) < 100) { return(data.frame( date = activity_date, @@ -539,14 +557,14 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE )) } - + # Calculate EF from steady-state periods if (ef_metric == "pace_hr") { ef_value <- median(steady_periods$velocity / steady_periods$heartrate, na.rm = TRUE) } else { ef_value <- median(steady_periods$watts / steady_periods$heartrate, na.rm = TRUE) } - + if (!is.na(ef_value) && ef_value > 0) { data.frame( date = activity_date, @@ -564,4 +582,4 @@ calculate_ef_from_stream <- function(stream_data, activity_date, act_type, ef_me stringsAsFactors = FALSE ) } -} \ No newline at end of file +} diff --git a/R/calculate_exposure.R b/R/calculate_exposure.R index 0b7ef00..48f6990 100644 --- a/R/calculate_exposure.R +++ b/R/calculate_exposure.R @@ -7,7 +7,7 @@ #' Calculates daily load, ATL, CTL, and ACWR from Strava activities based on the chosen metric and periods. #' #' @param activities_data A data frame of activities from `load_local_activities()`. -#' Must contain columns: date, distance, moving_time, elapsed_time, +#' Must contain columns: date, distance, moving_time, elapsed_time, #' average_heartrate, average_watts, type, elevation_gain. #' @param activity_type Type(s) of activities to include (e.g., "Run", "Ride"). #' Default includes common run/ride types. @@ -35,13 +35,13 @@ #' #' @examples #' # Example using simulated data -#' data(athlytics_sample_exposure) -#' print(head(athlytics_sample_exposure)) +#' data(sample_exposure) +#' print(head(sample_exposure)) #' #' \dontrun{ #' # Example using local Strava export data #' activities <- load_local_activities("strava_export_data/activities.csv") -#' +#' #' # Calculate training load for Rides using TSS #' ride_exposure_tss <- calculate_exposure( #' activities_data = activities, @@ -52,7 +52,7 @@ #' chronic_period = 28 #' ) #' print(head(ride_exposure_tss)) -#' +#' #' # Calculate training load for Runs using HRSS #' run_exposure_hrss <- calculate_exposure( #' activities_data = activities, @@ -72,47 +72,46 @@ calculate_exposure <- function(activities_data, user_max_hr = NULL, user_resting_hr = NULL, end_date = NULL) { - # --- Input Validation --- if (missing(activities_data) || is.null(activities_data)) { stop("`activities_data` must be provided. Use load_local_activities() to load your Strava export data.") } - + if (!is.data.frame(activities_data)) { stop("`activities_data` must be a data frame (e.g., from load_local_activities()).") } - + if (acute_period >= chronic_period) { stop("acute_period must be less than chronic_period.") } - + # Validate load metric parameters using internal helper validate_load_metric_params(load_metric, user_ftp, user_max_hr, user_resting_hr) - + analysis_end_date <- tryCatch(lubridate::as_date(end_date %||% Sys.Date()), error = function(e) Sys.Date()) analysis_start_date <- analysis_end_date - lubridate::days(chronic_period) + lubridate::days(1) message(sprintf("Calculating load exposure data from %s to %s.", analysis_start_date, analysis_end_date)) - message(sprintf("Using metric: %s, Activity types: %s", load_metric, paste(activity_type, collapse=", "))) + message(sprintf("Using metric: %s, Activity types: %s", load_metric, paste(activity_type, collapse = ", "))) message(sprintf("Acute period: %d days, Chronic period: %d days", acute_period, chronic_period)) # --- Get Activity Data (Local Only) --- fetch_start_date <- analysis_start_date - lubridate::days(chronic_period) - + message("Processing local activities data...") activities_df_filtered <- activities_data %>% dplyr::filter(.data$date >= fetch_start_date & .data$date <= analysis_end_date) - + if (!is.null(activity_type)) { activities_df_filtered <- activities_df_filtered %>% dplyr::filter(.data$type %in% activity_type) } - + activities_fetched_count <- nrow(activities_df_filtered) message(sprintf("Loaded %d activities from local data.", activities_fetched_count)) - + if (activities_fetched_count == 0) { - stop("No activities found in local data for the required date range (", fetch_start_date, " to ", analysis_end_date,").") + stop("No activities found in local data for the required date range (", fetch_start_date, " to ", analysis_end_date, ").") } # --- Process Activities into Daily Load (using internal helper) --- @@ -131,7 +130,7 @@ calculate_exposure <- function(activities_data, # --- Aggregate Daily Load --- daily_load_agg <- daily_load_df %>% dplyr::group_by(.data$date) %>% - dplyr::summarise(daily_load = sum(.data$load, na.rm = TRUE), .groups = 'drop') %>% + dplyr::summarise(daily_load = sum(.data$load, na.rm = TRUE), .groups = "drop") %>% dplyr::arrange(.data$date) # --- Create Full Date Sequence --- @@ -164,4 +163,4 @@ calculate_exposure <- function(activities_data, message("Exposure calculation complete.") return(exposure_data) -} \ No newline at end of file +} diff --git a/R/calculate_pbs.R b/R/calculate_pbs.R index 795a7e0..7febf98 100644 --- a/R/calculate_pbs.R +++ b/R/calculate_pbs.R @@ -12,11 +12,11 @@ #' @param activity_type Type of activities to analyze (typically "Run"). Default "Run". #' @param start_date Optional start date for analysis (YYYY-MM-DD). Defaults to NULL (all dates). #' @param end_date Optional end date for analysis (YYYY-MM-DD). Defaults to NULL (all dates). -#' @param distances_m Target distances in meters to track. +#' @param distances_m Target distances in meters to track. #' Default: c(1000, 5000, 10000, 21097.5, 42195) for 1k, 5k, 10k, half, full marathon. #' -#' @return A data frame with columns: activity_id, activity_date, distance, -#' elapsed_time, moving_time, time_seconds, cumulative_pb_seconds, is_pb, +#' @return A data frame with columns: activity_id, activity_date, distance, +#' elapsed_time, moving_time, time_seconds, cumulative_pb_seconds, is_pb, #' distance_label, time_period #' #' @details @@ -34,8 +34,8 @@ #' #' @examples #' # Example using simulated data -#' data(athlytics_sample_pbs) -#' print(head(athlytics_sample_pbs)) +#' data(sample_pbs) +#' print(head(sample_pbs)) #' #' \dontrun{ #' # Load local activities @@ -55,7 +55,6 @@ calculate_pbs <- function(activities_data, start_date = NULL, end_date = NULL, distances_m = c(1000, 5000, 10000, 21097.5, 42195)) { - # --- Input Validation --- if (missing(activities_data) || is.null(activities_data)) { stop("`activities_data` must be provided. Use load_local_activities() to load your Strava export data.") @@ -74,7 +73,7 @@ calculate_pbs <- function(activities_data, } `%||%` <- function(x, y) if (is.null(x) || length(x) == 0) y else x - + # --- Date Handling --- analysis_end_date <- tryCatch(lubridate::as_date(end_date %||% Sys.Date()), error = function(e) Sys.Date()) analysis_start_date <- tryCatch(lubridate::as_date(start_date %||% (analysis_end_date - lubridate::days(365))), error = function(e) analysis_end_date - lubridate::days(365)) @@ -121,9 +120,11 @@ calculate_pbs <- function(activities_data, # --- Calculate Best Efforts for Each Activity --- all_efforts <- purrr::map_dfr(1:nrow(filtered_activities), function(i) { activity <- filtered_activities[i, ] - - message(sprintf("Processing activity %d/%d: %s (%s)", - i, nrow(filtered_activities), activity$name, activity$date)) + + message(sprintf( + "Processing activity %d/%d: %s (%s)", + i, nrow(filtered_activities), activity$name, activity$date + )) # Parse activity file file_path <- file.path(export_dir, activity$filename) @@ -143,11 +144,11 @@ calculate_pbs <- function(activities_data, # Calculate best efforts for each target distance efforts <- purrr::map_dfr(distances_m, function(target_distance) { best_effort <- find_best_effort(stream_data, target_distance) - + if (is.null(best_effort)) { return(NULL) } - + data.frame( activity_id = activity$id, activity_date = activity$start_date_local, @@ -198,7 +199,7 @@ calculate_pbs <- function(activities_data, "21097.5" = "Half Marathon", "42195" = "Marathon" ) - + pb_results <- pb_results %>% dplyr::mutate( distance_label = dplyr::case_when( @@ -209,8 +210,9 @@ calculate_pbs <- function(activities_data, .data$distance == 42195 ~ "Marathon", TRUE ~ paste0(round(.data$distance), "m") ), - distance_label = factor(.data$distance_label, - levels = c("1k", "5k", "10k", "Half Marathon", "Marathon")), + distance_label = factor(.data$distance_label, + levels = c("1k", "5k", "10k", "Half Marathon", "Marathon") + ), time_period = as.character(lubridate::seconds_to_period(.data$time_seconds)) ) @@ -223,15 +225,19 @@ calculate_pbs <- function(activities_data, # Select final columns pb_results <- pb_results %>% - dplyr::select(.data$activity_id, .data$activity_date, .data$distance, - .data$elapsed_time, .data$moving_time, .data$time_seconds, - .data$cumulative_pb_seconds, .data$is_pb, - .data$distance_label, .data$time_period) %>% + dplyr::select( + .data$activity_id, .data$activity_date, .data$distance, + .data$elapsed_time, .data$moving_time, .data$time_seconds, + .data$cumulative_pb_seconds, .data$is_pb, + .data$distance_label, .data$time_period + ) %>% dplyr::arrange(.data$activity_date, .data$distance) - message(sprintf("PB analysis complete. Found %d efforts, %d are new PBs.", - nrow(pb_results), sum(pb_results$is_pb))) - + message(sprintf( + "PB analysis complete. Found %d efforts, %d are new PBs.", + nrow(pb_results), sum(pb_results$is_pb) + )) + return(pb_results) } @@ -240,46 +246,47 @@ calculate_pbs <- function(activities_data, find_best_effort <- function(stream_data, target_distance) { # Remove rows with missing distance or time valid_data <- stream_data[!is.na(stream_data$distance) & !is.na(stream_data$time), ] - + if (nrow(valid_data) < 10) { return(NULL) } - + # Check if activity is long enough max_distance <- max(valid_data$distance, na.rm = TRUE) if (max_distance < target_distance) { return(NULL) } - + # Use sliding window to find fastest segment of target distance # Allow 2% tolerance for distance matching tolerance <- target_distance * 0.02 - + best_time <- Inf best_start_idx <- NA best_end_idx <- NA - + # For each starting point, find the point where distance >= target for (i in 1:(nrow(valid_data) - 1)) { start_dist <- valid_data$distance[i] target_dist <- start_dist + target_distance - + # Find first point that reaches or exceeds target distance candidates <- which(valid_data$distance >= target_dist) - + if (length(candidates) == 0) { - break # No more segments possible + break # No more segments possible } - + end_idx <- candidates[1] actual_dist <- valid_data$distance[end_idx] - start_dist - + # Check if distance is within tolerance if (abs(actual_dist - target_distance) <= tolerance) { - elapsed_time <- as.numeric(difftime(valid_data$time[end_idx], - valid_data$time[i], - units = "secs")) - + elapsed_time <- as.numeric(difftime(valid_data$time[end_idx], + valid_data$time[i], + units = "secs" + )) + if (elapsed_time > 0 && elapsed_time < best_time) { best_time <- elapsed_time best_start_idx <- i @@ -287,14 +294,14 @@ find_best_effort <- function(stream_data, target_distance) { } } } - + if (is.infinite(best_time) || is.na(best_start_idx)) { return(NULL) } - + return(list( time_seconds = best_time, start_distance = valid_data$distance[best_start_idx], end_distance = valid_data$distance[best_end_idx] )) -} \ No newline at end of file +} diff --git a/R/cohort_reference.R b/R/cohort_reference.R index 8f4795e..b0f1b85 100644 --- a/R/cohort_reference.R +++ b/R/cohort_reference.R @@ -9,7 +9,7 @@ #' Must include columns: `date`, `athlete_id`, and the metric column. #' @param metric Name of the metric column to calculate percentiles for #' (e.g., "acwr", "acwr_smooth", "ef", "decoupling"). Default "acwr_smooth". -#' @param by Character vector of grouping variables. Options: "sport", "sex", +#' @param by Character vector of grouping variables. Options: "sport", "sex", #' "age_band", "athlete_id". Default c("sport"). #' @param probs Numeric vector of probabilities for percentiles (0-1). #' Default c(0.05, 0.25, 0.50, 0.75, 0.95) for 5th, 25th, 50th, 75th, 95th percentiles. @@ -45,8 +45,31 @@ #' @export #' #' @examples +#' # Example using sample data to create a mock cohort +#' data("sample_acwr", package = "Athlytics") +#' +#' # Simulate a cohort by duplicating with different athlete IDs +#' cohort_mock <- dplyr::bind_rows( +#' dplyr::mutate(sample_acwr, athlete_id = "A1", sport = "Run"), +#' dplyr::mutate(sample_acwr, +#' athlete_id = "A2", sport = "Run", +#' acwr_smooth = acwr_smooth * runif(nrow(sample_acwr), 0.9, 1.1) +#' ), +#' dplyr::mutate(sample_acwr, +#' athlete_id = "A3", sport = "Run", +#' acwr_smooth = acwr_smooth * runif(nrow(sample_acwr), 0.85, 1.15) +#' ) +#' ) +#' +#' # Calculate reference percentiles (min_athletes = 2 for demo) +#' reference <- calculate_cohort_reference(cohort_mock, +#' metric = "acwr_smooth", +#' by = "sport", min_athletes = 2 +#' ) +#' head(reference) +#' #' \dontrun{ -#' # Load activities for multiple athletes +#' # Full workflow with real data - Load activities for multiple athletes #' athlete1 <- load_local_activities("athlete1_export.zip") %>% #' mutate(athlete_id = "athlete1") #' athlete2 <- load_local_activities("athlete2_export.zip") %>% @@ -60,10 +83,10 @@ #' # Calculate ACWR for each athlete #' cohort_acwr <- cohort_data %>% #' group_by(athlete_id) %>% -#' group_modify(~calculate_acwr_ewma(.x)) +#' group_modify(~ calculate_acwr_ewma(.x)) #' #' # Calculate reference percentiles -#' reference <- cohort_reference( +#' reference <- calculate_cohort_reference( #' cohort_acwr, #' metric = "acwr_smooth", #' by = c("sport"), @@ -76,55 +99,58 @@ #' reference = reference #' ) #' } -cohort_reference <- function(data, - metric = "acwr_smooth", - by = c("sport"), - probs = c(0.05, 0.25, 0.50, 0.75, 0.95), - min_athletes = 5, - date_col = "date") { - +calculate_cohort_reference <- function(data, + metric = "acwr_smooth", + by = c("sport"), + probs = c(0.05, 0.25, 0.50, 0.75, 0.95), + min_athletes = 5, + date_col = "date") { # --- Input Validation --- if (!is.data.frame(data)) { stop("`data` must be a data frame.") } - + if (nrow(data) == 0) { stop("`data` is empty.") } - + required_cols <- c(date_col, metric) missing_cols <- setdiff(required_cols, colnames(data)) if (length(missing_cols) > 0) { stop(sprintf("Missing required columns: %s", paste(missing_cols, collapse = ", "))) } - + # Check if grouping variables exist if (length(by) > 0) { missing_by <- setdiff(by, colnames(data)) if (length(missing_by) > 0) { - warning(sprintf("Grouping variable(s) not found: %s. Will proceed without them.", - paste(missing_by, collapse = ", "))) + warning(sprintf( + "Grouping variable(s) not found: %s. Will proceed without them.", + paste(missing_by, collapse = ", ") + )) by <- setdiff(by, missing_by) } } - + # Ensure athlete_id exists if not in grouping if (!"athlete_id" %in% colnames(data) && !"athlete_id" %in% by) { warning("`athlete_id` column not found. Assuming single athlete or unable to count distinct athletes.") data$athlete_id <- "unknown" } - + # --- Calculate Percentiles --- - message(sprintf("Calculating percentiles for metric '%s' grouped by: %s", - metric, paste(by, collapse = ", "))) - + message(sprintf( + "Calculating percentiles for metric '%s' grouped by: %s", + metric, paste(by, collapse = ", ") + )) + if (length(by) == 0) { # No grouping - calculate overall percentiles by date grouping_vars <- date_col } else { grouping_vars <- c(date_col, by) } - + # Create dynamic grouping reference_data <- data %>% dplyr::group_by(dplyr::across(dplyr::all_of(grouping_vars))) %>% @@ -136,18 +162,20 @@ cohort_reference <- function(data, }), paste0("p", sprintf("%02d", probs * 100)) ), - .groups = 'drop' + .groups = "drop" ) - + # Filter by minimum athletes reference_data <- reference_data %>% dplyr::filter(.data$n_athletes >= min_athletes) - + if (nrow(reference_data) == 0) { - stop(sprintf("No groups have at least %d athletes. Cannot calculate valid percentiles.", - min_athletes)) + stop(sprintf( + "No groups have at least %d athletes. Cannot calculate valid percentiles.", + min_athletes + )) } - + # Pivot to long format percentile_cols <- paste0("p", sprintf("%02d", probs * 100)) reference_long <- reference_data %>% @@ -156,20 +184,42 @@ cohort_reference <- function(data, names_to = "percentile", values_to = "value" ) - - message(sprintf("Reference calculated for %d date-group combinations.", - nrow(reference_data))) - + + message(sprintf( + "Reference calculated for %d date-group combinations.", + nrow(reference_data) + )) + return(reference_long) } +#' @rdname calculate_cohort_reference +#' @export +cohort_reference <- function(data, + metric = "acwr_smooth", + by = c("sport"), + probs = c(0.05, 0.25, 0.50, 0.75, 0.95), + min_athletes = 5, + date_col = "date") { + .Deprecated("calculate_cohort_reference") + calculate_cohort_reference( + data = data, + metric = metric, + by = by, + probs = probs, + min_athletes = min_athletes, + date_col = date_col + ) +} + + #' Add Cohort Reference Bands to Existing Plot #' #' Adds percentile reference bands from a cohort to an individual's metric plot. #' #' @param p A ggplot object (typically from plot_acwr or similar). -#' @param reference_data A data frame from `cohort_reference()`. +#' @param reference_data A data frame from `calculate_cohort_reference()`. #' @param bands Character vector specifying which bands to plot. Options: #' "p25_p75" (inner quartiles), "p05_p95" (outer 5-95 range), "p50" (median). #' Default c("p25_p75", "p05_p95", "p50"). @@ -193,28 +243,27 @@ cohort_reference <- function(data, #' print(p_with_ref) #' } add_reference_bands <- function(p, - reference_data, - bands = c("p25_p75", "p05_p95", "p50"), - alpha = 0.15, - colors = list( - p25_p75 = "#440154FF", # viridis dark purple - p05_p95 = "#3B528BFF", # viridis blue - p50 = "#21908CFF" # viridis teal - )) { - + reference_data, + bands = c("p25_p75", "p05_p95", "p50"), + alpha = 0.15, + colors = list( + p25_p75 = "#440154FF", # viridis dark purple + p05_p95 = "#3B528BFF", # viridis blue + p50 = "#21908CFF" # viridis teal + )) { if (!inherits(p, "ggplot")) { stop("`p` must be a ggplot object.") } - + if (!is.data.frame(reference_data)) { - stop("`reference_data` must be a data frame from cohort_reference().") + stop("`reference_data` must be a data frame from calculate_cohort_reference().") } - + # Pivot reference data to wide format for plotting ref_wide <- reference_data %>% dplyr::select(.data$date, .data$percentile, .data$value) %>% tidyr::pivot_wider(names_from = .data$percentile, values_from = .data$value) - + # Add bands in order (outermost to innermost) if ("p05_p95" %in% bands && all(c("p05", "p95") %in% colnames(ref_wide))) { p <- p + ggplot2::geom_ribbon( @@ -224,7 +273,7 @@ add_reference_bands <- function(p, alpha = alpha ) } - + if ("p25_p75" %in% bands && all(c("p25", "p75") %in% colnames(ref_wide))) { p <- p + ggplot2::geom_ribbon( data = ref_wide, @@ -233,7 +282,7 @@ add_reference_bands <- function(p, alpha = alpha * 1.5 ) } - + if ("p50" %in% bands && "p50" %in% colnames(ref_wide)) { p <- p + ggplot2::geom_line( data = ref_wide, @@ -243,7 +292,7 @@ add_reference_bands <- function(p, linewidth = 0.8 ) } - + return(p) } @@ -254,7 +303,7 @@ add_reference_bands <- function(p, #' reference percentile bands. #' #' @param individual A data frame with individual athlete data (from calculate_acwr, etc.) -#' @param reference A data frame from `cohort_reference()`. +#' @param reference A data frame from `calculate_cohort_reference()`. #' @param metric Name of the metric to plot. Default "acwr_smooth". #' @param date_col Name of the date column. Default "date". #' @param title Plot title. Default NULL (auto-generated). @@ -278,12 +327,14 @@ add_reference_bands <- function(p, #' reference_data <- data.frame( #' date = as.Date(c("2023-01-01", "2023-04-01", "2023-07-01", "2023-10-01")), #' percentile = rep(c("p05", "p25", "p50", "p75", "p95"), 4), -#' value = c(0.7, 0.9, 1.1, 1.3, 1.5, -#' 0.7, 0.9, 1.1, 1.3, 1.5, -#' 0.7, 0.9, 1.1, 1.3, 1.5, -#' 0.7, 0.9, 1.1, 1.3, 1.5) +#' value = c( +#' 0.7, 0.9, 1.1, 1.3, 1.5, +#' 0.7, 0.9, 1.1, 1.3, 1.5, +#' 0.7, 0.9, 1.1, 1.3, 1.5, +#' 0.7, 0.9, 1.1, 1.3, 1.5 +#' ) #' ) -#' +#' #' p <- plot_with_reference( #' individual = individual_data, #' reference = reference_data, @@ -299,28 +350,27 @@ add_reference_bands <- function(p, #' ) #' } plot_with_reference <- function(individual, - reference, - metric = "acwr_smooth", - date_col = "date", - title = NULL, - bands = c("p25_p75", "p05_p95", "p50")) { - + reference, + metric = "acwr_smooth", + date_col = "date", + title = NULL, + bands = c("p25_p75", "p05_p95", "p50")) { if (!is.data.frame(individual) || !is.data.frame(reference)) { stop("Both `individual` and `reference` must be data frames.") } - + if (!metric %in% colnames(individual)) { stop(sprintf("Metric '%s' not found in individual data.", metric)) } - + # Pivot reference to wide ref_wide <- reference %>% dplyr::select(.data$date, .data$percentile, .data$value) %>% tidyr::pivot_wider(names_from = .data$percentile, values_from = .data$value) - + # Create base plot with reference bands p <- ggplot2::ggplot() - + # Add reference bands (outermost first) - using enhanced colors if ("p05_p95" %in% bands && all(c("p05", "p95") %in% colnames(ref_wide))) { p <- p + ggplot2::geom_ribbon( @@ -329,7 +379,7 @@ plot_with_reference <- function(individual, fill = "#FFB6C1", alpha = 0.3 ) } - + if ("p25_p75" %in% bands && all(c("p25", "p75") %in% colnames(ref_wide))) { p <- p + ggplot2::geom_ribbon( data = ref_wide, @@ -337,7 +387,7 @@ plot_with_reference <- function(individual, fill = "#87CEEB", alpha = 0.4 ) } - + if ("p50" %in% bands && "p50" %in% colnames(ref_wide)) { p <- p + ggplot2::geom_line( data = ref_wide, @@ -345,17 +395,17 @@ plot_with_reference <- function(individual, color = "#4682B4", linetype = "dashed", linewidth = 1.5 ) } - + # Add individual line on top with enhanced visibility p <- p + ggplot2::geom_line( data = individual, ggplot2::aes(x = .data[[date_col]], y = .data[[metric]]), color = "#DC143C", linewidth = 2.5, alpha = 1.0 ) - + # Formatting plot_title <- title %||% sprintf("%s: Individual vs Cohort", tools::toTitleCase(metric)) - + p <- p + ggplot2::labs( title = plot_title, @@ -365,10 +415,12 @@ plot_with_reference <- function(individual, caption = "Red line: Individual athlete | Shaded bands: Cohort percentile ranges" ) + ggplot2::scale_x_date( - date_breaks = "3 months", + date_breaks = "3 months", labels = function(x) { - months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") + months <- c( + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" + ) paste(months[as.integer(format(x, "%m"))], format(x, "%Y")) } ) + @@ -377,7 +429,6 @@ plot_with_reference <- function(individual, axis.text.x = ggplot2::element_text(angle = 45, hjust = 1), plot.margin = ggplot2::margin(20, 20, 20, 20) ) - + return(p) } - diff --git a/R/color_palettes.R b/R/color_palettes.R index 2d2de28..c9ce11f 100644 --- a/R/color_palettes.R +++ b/R/color_palettes.R @@ -15,22 +15,22 @@ NULL #' #' @export #' @examples -#' \dontrun{ -#' ggplot2::ggplot(data, ggplot2::aes(x, y, color = group)) + -#' ggplot2::geom_line() + -#' ggplot2::scale_color_manual(values = athlytics_palette_nature()) -#' } +#' # View the palette colors +#' athlytics_palette_nature() +#' +#' # Display as color swatches +#' barplot(rep(1, 9), col = athlytics_palette_nature(), border = NA) athlytics_palette_nature <- function() { c( - "#E64B35", # Red (primary data) - "#4DBBD5", # Cyan (secondary data) - "#00A087", # Teal (tertiary) - "#3C5488", # Navy blue - "#F39B7F", # Coral - "#8491B4", # Slate blue - "#91D1C2", # Mint green - "#DC0000", # Dark red - "#7E6148" # Brown + "#E64B35", # Red (primary data) + "#4DBBD5", # Cyan (secondary data) + "#00A087", # Teal (tertiary) + "#3C5488", # Navy blue + "#F39B7F", # Coral + "#8491B4", # Slate blue + "#91D1C2", # Mint green + "#DC0000", # Dark red + "#7E6148" # Brown ) } @@ -43,21 +43,18 @@ athlytics_palette_nature <- function() { #' #' @export #' @examples -#' \dontrun{ -#' ggplot2::ggplot(data, ggplot2::aes(x, y, color = group)) + -#' ggplot2::geom_line() + -#' ggplot2::scale_color_manual(values = athlytics_palette_academic()) -#' } +#' # View the palette colors +#' athlytics_palette_academic() athlytics_palette_academic <- function() { c( - "#8C7A6B", # Taupe - "#A8968E", # Warm gray - "#C4B5A8", # Light beige - "#7B9FA3", # Steel blue - "#9DB4B8", # Powder blue - "#B8A68E", # Sand - "#8B9E9F", # Sage - "#D4C4B0" # Light stone (unique shade) + "#8C7A6B", # Taupe + "#A8968E", # Warm gray + "#C4B5A8", # Light beige + "#7B9FA3", # Steel blue + "#9DB4B8", # Powder blue + "#B8A68E", # Sand + "#8B9E9F", # Sage + "#D4C4B0" # Light stone (unique shade) ) } @@ -70,21 +67,18 @@ athlytics_palette_academic <- function() { #' #' @export #' @examples -#' \dontrun{ -#' ggplot2::ggplot(data, ggplot2::aes(x, y, fill = category)) + -#' ggplot2::geom_bar(stat = "identity") + -#' ggplot2::scale_fill_manual(values = athlytics_palette_vibrant()) -#' } +#' # View the palette colors +#' athlytics_palette_vibrant() athlytics_palette_vibrant <- function() { c( - "#FF6B6B", # Coral red - "#4ECDC4", # Turquoise - "#45B7D1", # Sky blue - "#FFA07A", # Light salmon - "#98D8C8", # Seafoam - "#FFE66D", # Yellow - "#A8E6CF", # Mint - "#FF8B94" # Pink + "#FF6B6B", # Coral red + "#4ECDC4", # Turquoise + "#45B7D1", # Sky blue + "#FFA07A", # Light salmon + "#98D8C8", # Seafoam + "#FFE66D", # Yellow + "#A8E6CF", # Mint + "#FF8B94" # Pink ) } @@ -98,19 +92,19 @@ athlytics_palette_vibrant <- function() { #' @examples #' # Get Science palette colors #' colors <- athlytics_palette_science() -#' colors[1] # Dark blue +#' colors[1] # Dark blue #' #' @export athlytics_palette_science <- function() { c( - "#003F5C", # Dark blue - "#58508D", # Purple - "#BC5090", # Magenta - "#FF6361", # Coral - "#FFA600", # Orange - "#7A5195", # Plum - "#EF5675", # Rose - "#FFC300" # Gold + "#003F5C", # Dark blue + "#58508D", # Purple + "#BC5090", # Magenta + "#FF6361", # Coral + "#FFA600", # Orange + "#7A5195", # Plum + "#EF5675", # Rose + "#FFC300" # Gold ) } @@ -124,19 +118,19 @@ athlytics_palette_science <- function() { #' @examples #' # Get Cell palette colors #' colors <- athlytics_palette_cell() -#' colors[1] # Blue +#' colors[1] # Blue #' #' @export athlytics_palette_cell <- function() { c( - "#0173B2", # Blue - "#DE8F05", # Orange - "#029E73", # Green - "#CC78BC", # Purple - "#CA9161", # Tan - "#949494", # Gray - "#ECE133", # Yellow - "#56B4E9" # Light blue + "#0173B2", # Blue + "#DE8F05", # Orange + "#029E73", # Green + "#CC78BC", # Purple + "#CA9161", # Tan + "#949494", # Gray + "#ECE133", # Yellow + "#56B4E9" # Light blue ) } @@ -153,15 +147,15 @@ athlytics_palette_cell <- function() { #' @examples #' # Get ACWR zone colors #' colors <- athlytics_colors_acwr_zones() -#' colors$safe # Returns green color code +#' colors$safe # Returns green color code #' #' @export athlytics_colors_acwr_zones <- function() { list( - undertraining = "#AED6F1", # Light blue - safe = "#A9DFBF", # Green - caution = "#FAD7A0", # Orange - high_risk = "#F5B7B1" # Red + undertraining = "#AED6F1", # Light blue + safe = "#A9DFBF", # Green + caution = "#FAD7A0", # Orange + high_risk = "#F5B7B1" # Red ) } @@ -177,14 +171,14 @@ athlytics_colors_acwr_zones <- function() { #' @examples #' # Get training load colors #' colors <- athlytics_colors_training_load() -#' colors$acute # Red for acute load +#' colors$acute # Red for acute load #' #' @export athlytics_colors_training_load <- function() { list( - acute = "#E64B35", # Red (short-term) - chronic = "#4DBBD5", # Blue (long-term) - ratio = "#00A087" # Teal (ACWR) + acute = "#E64B35", # Red (short-term) + chronic = "#4DBBD5", # Blue (long-term) + ratio = "#00A087" # Teal (ACWR) ) } @@ -201,15 +195,15 @@ athlytics_colors_training_load <- function() { #' @examples #' # Get EF colors by sport #' colors <- athlytics_colors_ef() -#' colors$run # Navy for running +#' colors$run # Navy for running #' #' @export athlytics_colors_ef <- function() { list( - run = "#3C5488", # Navy - ride = "#F39B7F", # Coral - swim = "#4DBBD5", # Cyan - other = "#8491B4" # Slate + run = "#3C5488", # Navy + ride = "#F39B7F", # Coral + swim = "#4DBBD5", # Cyan + other = "#8491B4" # Slate ) } @@ -236,10 +230,10 @@ theme_athlytics <- function(base_size = 13, base_family = "") { # Plot background - clean white plot.background = ggplot2::element_rect(fill = "white", color = NA), panel.background = ggplot2::element_rect(fill = "white", color = NA), - + # Plot titles - modern, bold, left-aligned plot.title = ggplot2::element_text( - face = "bold", + face = "bold", size = base_size * 1.4, hjust = 0, color = "#2c3e50", @@ -259,39 +253,39 @@ theme_athlytics <- function(base_size = 13, base_family = "") { margin = ggplot2::margin(t = base_size * 0.8) ), plot.margin = ggplot2::margin(t = 15, r = 15, b = 15, l = 15), - + # Axes - clean and minimal axis.title.x = ggplot2::element_text( - size = base_size * 1.05, + size = base_size * 1.05, face = "bold", color = "#34495e", margin = ggplot2::margin(t = base_size * 0.6) ), axis.title.y = ggplot2::element_text( - size = base_size * 1.05, + size = base_size * 1.05, face = "bold", color = "#34495e", margin = ggplot2::margin(r = base_size * 0.6) ), axis.text.x = ggplot2::element_text( - size = base_size * 0.9, + size = base_size * 0.9, color = "#7f8c8d", margin = ggplot2::margin(t = base_size * 0.3) ), axis.text.y = ggplot2::element_text( - size = base_size * 0.9, + size = base_size * 0.9, color = "#7f8c8d", margin = ggplot2::margin(r = base_size * 0.3) ), axis.line = ggplot2::element_blank(), axis.ticks = ggplot2::element_line(color = "#bdc3c7", linewidth = 0.3), axis.ticks.length = ggplot2::unit(4, "pt"), - + # Legend - modern and spacious legend.position = "bottom", legend.direction = "horizontal", legend.title = ggplot2::element_text( - size = base_size * 0.95, + size = base_size * 0.95, face = "bold", color = "#34495e" ), @@ -304,17 +298,17 @@ theme_athlytics <- function(base_size = 13, base_family = "") { legend.spacing.x = ggplot2::unit(0.5, "lines"), legend.box.spacing = ggplot2::unit(0.5, "lines"), legend.margin = ggplot2::margin(t = base_size), - + # Panel grid - subtle and elegant panel.grid.major = ggplot2::element_line( - color = "#ecf0f1", + color = "#ecf0f1", linewidth = 0.5, linetype = "solid" ), panel.grid.minor = ggplot2::element_blank(), panel.border = ggplot2::element_blank(), panel.spacing = ggplot2::unit(1.5, "lines"), - + # Strip (for facets) - clean and modern strip.text = ggplot2::element_text( size = base_size * 1.05, @@ -347,23 +341,20 @@ theme_athlytics <- function(base_size = 13, base_family = "") { #' #' @export scale_athlytics <- function(palette_name = "nature", type = "color") { - palette_func <- switch( - palette_name, + palette_func <- switch(palette_name, nature = athlytics_palette_nature, academic = athlytics_palette_academic, vibrant = athlytics_palette_vibrant, science = athlytics_palette_science, cell = athlytics_palette_cell, - athlytics_palette_nature # default + athlytics_palette_nature # default ) - + colors <- palette_func() - + if (type == "color") { ggplot2::scale_color_manual(values = colors) } else { ggplot2::scale_fill_manual(values = colors) } } - - diff --git a/R/data.R b/R/data.R index fd7e951..94e2c3c 100644 --- a/R/data.R +++ b/R/data.R @@ -14,7 +14,7 @@ #' \item{acwr_smooth}{Smoothed ACWR, as a numeric value.} #' } #' @source Simulated data generated for package examples. -"athlytics_sample_acwr" +"sample_acwr" #' Sample Aerobic Decoupling Data for Athlytics #' @@ -27,7 +27,7 @@ #' \item{decoupling}{Calculated decoupling percentage, as a numeric value.} #' } #' @source Simulated data generated for package examples. -"athlytics_sample_decoupling" +"sample_decoupling" #' Sample Efficiency Factor (EF) Data for Athlytics #' @@ -41,7 +41,7 @@ #' \item{ef_value}{Calculated Efficiency Factor, as a numeric value.} #' } #' @source Simulated data generated for package examples. -"athlytics_sample_ef" +"sample_ef" #' Sample Training Load Exposure Data for Athlytics #' @@ -57,7 +57,7 @@ #' \item{acwr}{Acute:Chronic Workload Ratio, as a numeric value.} #' } #' @source Simulated data generated for package examples. -"athlytics_sample_exposure" +"sample_exposure" #' Sample Personal Bests (PBs) Data for Athlytics #' @@ -78,4 +78,4 @@ #' \item{time_period}{Formatted time of the effort, as a Period object from lubridate.} #' } #' @source Simulated data generated for package examples. -"athlytics_sample_pbs" \ No newline at end of file +"sample_pbs" diff --git a/R/flag_quality.R b/R/flag_quality.R index a6774cb..168a86d 100644 --- a/R/flag_quality.R +++ b/R/flag_quality.R @@ -49,39 +49,37 @@ #' @export #' #' @examples -#' \dontrun{ #' # Create sample activity stream data +#' set.seed(42) #' stream_data <- data.frame( #' time = seq(0, 3600, by = 1), -#' heartrate = rnorm(3601, mean = 150, sd = 10), -#' watts = rnorm(3601, mean = 200, sd = 20), -#' velocity_smooth = rnorm(3601, mean = 3.5, sd = 0.3) +#' heartrate = pmax(60, pmin(200, rnorm(3601, mean = 150, sd = 10))), +#' watts = pmax(0, rnorm(3601, mean = 200, sd = 20)), +#' velocity_smooth = pmax(0, rnorm(3601, mean = 3.5, sd = 0.3)) #' ) #' #' # Flag quality issues #' flagged_data <- flag_quality(stream_data, sport = "Run") #' #' # Check summary -#' summary(flagged_data$quality_score) -#' table(flagged_data$flag_any) -#' } +#' cat("Quality score range:", range(flagged_data$quality_score), "\n") +#' cat("Flagged points:", sum(flagged_data$flag_any), "\n") flag_quality <- function(streams, - sport = "Run", - hr_range = c(30, 220), - pw_range = c(0, 1500), - max_run_speed = 7.0, - max_ride_speed = 25.0, - max_accel = 3.0, - max_hr_jump = 10, - max_pw_jump = 300, - min_steady_minutes = 20, - steady_cv_threshold = 8) { - + sport = "Run", + hr_range = c(30, 220), + pw_range = c(0, 1500), + max_run_speed = 7.0, + max_ride_speed = 25.0, + max_accel = 3.0, + max_hr_jump = 10, + max_pw_jump = 300, + min_steady_minutes = 20, + steady_cv_threshold = 8) { # --- Input Validation --- if (!is.data.frame(streams)) { stop("`streams` must be a data frame.") } - + if (nrow(streams) == 0) { warning("Empty streams data provided. Returning empty data frame with flag columns.") streams$flag_hr_spike <- logical(0) @@ -92,12 +90,12 @@ flag_quality <- function(streams, streams$quality_score <- numeric(0) return(streams) } - + # Check for required columns (at least time should exist) if (!"time" %in% colnames(streams)) { stop("`streams` must contain a 'time' column.") } - + # Initialize flag columns streams$flag_hr_spike <- FALSE streams$flag_pw_spike <- FALSE @@ -105,35 +103,35 @@ flag_quality <- function(streams, streams$flag_any <- FALSE streams$is_steady_state <- FALSE streams$quality_score <- 1.0 - + # --- HR Spike Detection --- if ("heartrate" %in% colnames(streams)) { hr <- streams$heartrate - + # Flag out-of-range HR hr_out_of_range <- !is.na(hr) & (hr < hr_range[1] | hr > hr_range[2]) - + # Flag excessive HR jumps hr_diff <- c(0, diff(hr)) hr_excessive_jump <- !is.na(hr_diff) & abs(hr_diff) > max_hr_jump - + streams$flag_hr_spike <- hr_out_of_range | hr_excessive_jump } - + # --- Power Spike Detection --- if ("watts" %in% colnames(streams)) { pw <- streams$watts - + # Flag out-of-range power pw_out_of_range <- !is.na(pw) & (pw < pw_range[1] | pw > pw_range[2]) - + # Flag excessive power jumps pw_diff <- c(0, diff(pw)) pw_excessive_jump <- !is.na(pw_diff) & abs(pw_diff) > max_pw_jump - + streams$flag_pw_spike <- pw_out_of_range | pw_excessive_jump } - + # --- GPS Drift Detection --- # Check for velocity_smooth or speed column speed_col <- NULL @@ -142,38 +140,38 @@ flag_quality <- function(streams, } else if ("speed" %in% colnames(streams)) { speed_col <- "speed" } - + if (!is.null(speed_col)) { speed <- streams[[speed_col]] - + # Set max speed based on sport max_speed <- if (tolower(sport) == "ride") max_ride_speed else max_run_speed - + # Flag implausible speeds speed_implausible <- !is.na(speed) & speed > max_speed - + # Flag excessive acceleration speed_diff <- c(0, diff(speed)) time_diff <- c(1, diff(streams$time)) - time_diff[time_diff == 0] <- 1 # Avoid division by zero + time_diff[time_diff == 0] <- 1 # Avoid division by zero accel <- speed_diff / time_diff accel_excessive <- !is.na(accel) & abs(accel) > max_accel - + streams$flag_gps_drift <- speed_implausible | accel_excessive } - + # --- Aggregate Quality Flags --- streams$flag_any <- streams$flag_hr_spike | streams$flag_pw_spike | streams$flag_gps_drift - + # --- Calculate Quality Score (proportion of clean data) --- if (nrow(streams) > 0) { streams$quality_score <- 1 - (sum(streams$flag_any, na.rm = TRUE) / nrow(streams)) } - + # --- Steady-State Detection --- # Requires sufficient data and a metric to evaluate (prefer power, then speed) - min_samples <- min_steady_minutes * 60 # Convert to seconds - + min_samples <- min_steady_minutes * 60 # Convert to seconds + if (nrow(streams) >= min_samples) { # Determine which metric to use for steady-state ss_metric <- NULL @@ -182,40 +180,44 @@ flag_quality <- function(streams, } else if (!is.null(speed_col) && any(!is.na(streams[[speed_col]]))) { ss_metric <- streams[[speed_col]] } - + if (!is.null(ss_metric)) { # Calculate rolling CV (coefficient of variation) window_size <- min_samples - + if (length(ss_metric) >= window_size) { rolling_cv <- zoo::rollapply( ss_metric, width = window_size, FUN = function(x) { - if (all(is.na(x)) || mean(x, na.rm = TRUE) == 0) return(NA) + if (all(is.na(x)) || mean(x, na.rm = TRUE) == 0) { + return(NA) + } (sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)) * 100 }, align = "center", fill = NA ) - + # Mark as steady-state if CV is below threshold and no flags - streams$is_steady_state <- !is.na(rolling_cv) & - rolling_cv < steady_cv_threshold & - !streams$flag_any + streams$is_steady_state <- !is.na(rolling_cv) & + rolling_cv < steady_cv_threshold & + !streams$flag_any } } } - + # --- Summary Message --- n_flagged <- sum(streams$flag_any, na.rm = TRUE) n_steady <- sum(streams$is_steady_state, na.rm = TRUE) pct_flagged <- round(100 * n_flagged / nrow(streams), 1) pct_steady <- round(100 * n_steady / nrow(streams), 1) - - message(sprintf("Quality check complete: %.1f%% flagged, %.1f%% steady-state", - pct_flagged, pct_steady)) - + + message(sprintf( + "Quality check complete: %.1f%% flagged, %.1f%% steady-state", + pct_flagged, pct_steady + )) + return(streams) } @@ -244,18 +246,18 @@ flag_quality <- function(streams, #' @examples #' \dontrun{ #' flagged_data <- flag_quality(stream_data) -#' quality_summary(flagged_data) +#' summarize_quality(flagged_data) #' } -quality_summary <- function(flagged_streams) { +summarize_quality <- function(flagged_streams) { if (!is.data.frame(flagged_streams)) { stop("`flagged_streams` must be a data frame from flag_quality().") } - + required_cols <- c("flag_any", "is_steady_state", "quality_score") if (!all(required_cols %in% colnames(flagged_streams))) { stop("`flagged_streams` must have been processed by flag_quality().") } - + n <- nrow(flagged_streams) if (n == 0) { return(list( @@ -270,7 +272,7 @@ quality_summary <- function(flagged_streams) { gps_drift_pct = 0 )) } - + list( total_points = n, flagged_points = sum(flagged_streams$flag_any, na.rm = TRUE), @@ -280,14 +282,26 @@ quality_summary <- function(flagged_streams) { quality_score = round(mean(flagged_streams$quality_score, na.rm = TRUE), 3), hr_spike_pct = if ("flag_hr_spike" %in% colnames(flagged_streams)) { round(100 * sum(flagged_streams$flag_hr_spike, na.rm = TRUE) / n, 2) - } else 0, + } else { + 0 + }, pw_spike_pct = if ("flag_pw_spike" %in% colnames(flagged_streams)) { round(100 * sum(flagged_streams$flag_pw_spike, na.rm = TRUE) / n, 2) - } else 0, + } else { + 0 + }, gps_drift_pct = if ("flag_gps_drift" %in% colnames(flagged_streams)) { round(100 * sum(flagged_streams$flag_gps_drift, na.rm = TRUE) / n, 2) - } else 0 + } else { + 0 + } ) } +#' @rdname summarize_quality +#' @export +quality_summary <- function(flagged_streams) { + .Deprecated("summarize_quality") + summarize_quality(flagged_streams = flagged_streams) +} diff --git a/R/internal_load.R b/R/internal_load.R index 3fc5447..df3015a 100644 --- a/R/internal_load.R +++ b/R/internal_load.R @@ -24,22 +24,23 @@ calculate_daily_load_internal <- function(activities_df, user_ftp = NULL, user_max_hr = NULL, user_resting_hr = NULL) { - - safe_as_numeric <- function(x) { as.numeric(rlang::`%||%`(x, 0)) } - + safe_as_numeric <- function(x) { + as.numeric(rlang::`%||%`(x, 0)) + } + purrr::map_dfr(seq_len(nrow(activities_df)), function(i) { activity <- activities_df[i, ] activity_date <- activity$date - + # Extract metrics from data frame columns duration_sec <- safe_as_numeric(activity$moving_time) distance_m <- safe_as_numeric(activity$distance) elapsed_sec <- safe_as_numeric(activity$elapsed_time) avg_hr <- safe_as_numeric(activity$average_heartrate) elevation_gain <- safe_as_numeric(activity$elevation_gain) - np_proxy <- safe_as_numeric(activity$weighted_average_watts %||% - activity$average_watts %||% 0) - + np_proxy <- safe_as_numeric(activity$weighted_average_watts %||% + activity$average_watts %||% 0) + # Calculate load based on metric load_value <- compute_single_load( load_metric = load_metric, @@ -53,7 +54,7 @@ calculate_daily_load_internal <- function(activities_df, user_max_hr = user_max_hr, user_resting_hr = user_resting_hr ) - + if (!is.na(load_value) && load_value > 0) { data.frame( date = activity_date, @@ -97,25 +98,20 @@ compute_single_load <- function(load_metric, user_ftp, user_max_hr, user_resting_hr) { - if (duration_sec <= 0) { return(0) } - + switch(load_metric, "duration_mins" = duration_sec / 60, - "distance_km" = distance_m / 1000, - "elapsed_time_mins" = elapsed_sec / 60, - "elevation_gain_m" = elevation_gain, - "hrss" = { if (!is.null(user_max_hr) && !is.null(user_resting_hr) && - is.numeric(user_max_hr) && is.numeric(user_resting_hr) && - user_max_hr > user_resting_hr && - avg_hr > user_resting_hr && avg_hr <= user_max_hr) { + is.numeric(user_max_hr) && is.numeric(user_resting_hr) && + user_max_hr > user_resting_hr && + avg_hr > user_resting_hr && avg_hr <= user_max_hr) { hr_reserve <- user_max_hr - user_resting_hr avg_hr_rel <- (avg_hr - user_resting_hr) / hr_reserve (duration_sec / 60) * avg_hr_rel @@ -123,17 +119,16 @@ compute_single_load <- function(load_metric, 0 } }, - "tss" = { - if (!is.null(user_ftp) && is.numeric(user_ftp) && - user_ftp > 0 && np_proxy > 0) { + if (!is.null(user_ftp) && is.numeric(user_ftp) && + user_ftp > 0 && np_proxy > 0) { intensity_factor <- np_proxy / user_ftp (duration_sec * np_proxy * intensity_factor) / (user_ftp * 3600) * 100 } else { 0 } }, - + # Default case 0 ) @@ -158,21 +153,22 @@ validate_load_metric_params <- function(load_metric, user_ftp = NULL, user_max_hr = NULL, user_resting_hr = NULL) { - - valid_metrics <- c("duration_mins", "distance_km", "elapsed_time_mins", - "tss", "hrss", "elevation_gain_m") - + valid_metrics <- c( + "duration_mins", "distance_km", "elapsed_time_mins", + "tss", "hrss", "elevation_gain_m" + ) + if (!load_metric %in% valid_metrics) { stop("Invalid `load_metric`. Choose from: ", paste(valid_metrics, collapse = ", ")) } - + if (load_metric == "tss" && is.null(user_ftp)) { stop("`user_ftp` is required when `load_metric` is 'tss'.") } - + if (load_metric == "hrss" && (is.null(user_max_hr) || is.null(user_resting_hr))) { stop("`user_max_hr` and `user_resting_hr` are required when `load_metric` is 'hrss'.") } - + invisible(NULL) } diff --git a/R/load_local_activities.R b/R/load_local_activities.R index 9078f65..31c9db4 100644 --- a/R/load_local_activities.R +++ b/R/load_local_activities.R @@ -70,7 +70,7 @@ #' # Use with Athlytics functions #' acwr_data <- calculate_acwr(activities, load_metric = "distance_km") #' plot_acwr(acwr_data, highlight_zones = TRUE) -#' +#' #' # Multi-metric analysis #' ef_data <- calculate_ef(activities, ef_metric = "pace_hr") #' plot_ef(ef_data, add_trend_line = TRUE) @@ -82,64 +82,72 @@ #' @importFrom rlang .data #' @export load_local_activities <- function(path = "strava_export_data/activities.csv", - start_date = NULL, - end_date = NULL, - activity_types = NULL) { - + start_date = NULL, + end_date = NULL, + activity_types = NULL) { # --- Input Validation --- if (!file.exists(path)) { - stop("File not found at: ", path, - "\nPlease ensure you have downloaded your Strava data export.") + stop( + "File not found at: ", path, + "\nPlease ensure you have downloaded your Strava data export." + ) } - + # --- Handle ZIP files --- temp_extracted <- FALSE original_path <- path - + # Check if input is a ZIP file if (tolower(tools::file_ext(path)) == "zip") { message("Detected ZIP archive. Extracting activities.csv...") - + # Create a temporary directory for extraction temp_dir <- tempdir() - + # List files in the ZIP zip_contents <- utils::unzip(path, list = TRUE) - + # Find activities.csv (case-insensitive) - activities_file <- grep("activities\\.csv$", zip_contents$Name, - ignore.case = TRUE, value = TRUE) - + activities_file <- grep("activities\\.csv$", zip_contents$Name, + ignore.case = TRUE, value = TRUE + ) + if (length(activities_file) == 0) { stop("No activities.csv file found in ZIP archive: ", path) } - + if (length(activities_file) > 1) { warning("Multiple activities.csv files found. Using: ", activities_file[1]) activities_file <- activities_file[1] } - + # Extract the activities.csv file - tryCatch({ - utils::unzip(path, files = activities_file, exdir = temp_dir, overwrite = TRUE) - path <- file.path(temp_dir, activities_file) - temp_extracted <- TRUE - message("Successfully extracted to temporary location.") - }, error = function(e) { - stop("Failed to extract ZIP archive: ", e$message) - }) + tryCatch( + { + utils::unzip(path, files = activities_file, exdir = temp_dir, overwrite = TRUE) + path <- file.path(temp_dir, activities_file) + temp_extracted <- TRUE + message("Successfully extracted to temporary location.") + }, + error = function(e) { + stop("Failed to extract ZIP archive: ", e$message) + } + ) } - + # --- Read CSV --- message("Reading activities from: ", basename(original_path)) - + # Read CSV with appropriate column types - activities_raw <- tryCatch({ - readr::read_csv(path, show_col_types = FALSE, col_types = readr::cols()) - }, error = function(e) { - stop("Failed to read CSV file: ", e$message) - }) - + activities_raw <- tryCatch( + { + readr::read_csv(path, show_col_types = FALSE, col_types = readr::cols()) + }, + error = function(e) { + stop("Failed to read CSV file: ", e$message) + } + ) + if (nrow(activities_raw) == 0) { warning("No activities found in CSV file.") return(dplyr::tibble( @@ -156,73 +164,89 @@ load_local_activities <- function(path = "strava_export_data/activities.csv", elevation_gain = numeric(0) )) } - + message("Found ", nrow(activities_raw), " activities in CSV file.") - + # --- Transform Data --- # Store column names to avoid using `.` inside mutate col_names <- names(activities_raw) - + activities_df <- activities_raw %>% dplyr::mutate( # ID id = as.numeric(.data$`Activity ID`), - + # Name and Type name = as.character(.data$`Activity Name`), type = as.character(.data$`Activity Type`), sport_type = as.character(.data$`Activity Type`), # Strava export doesn't distinguish - + # Parse Date - Strava format: "Feb 17, 2022, 12:18:26 PM" start_date_local = lubridate::parse_date_time( .data$`Activity Date`, orders = c("b d, Y, I:M:S p", "mdy HMS p", "ymd HMS"), - tz = "UTC" # Will be converted to local if needed + tz = "UTC" # Will be converted to local if needed ), date = lubridate::as_date(.data$start_date_local), - + # Distance - CSV has two "Distance" columns, use the second (more detailed) # R renames duplicate columns by appending .1, .2, etc. - distance = as.numeric(if("Distance.1" %in% col_names) .data$Distance.1 - else if("Distance...18" %in% col_names) .data$`Distance...18` - else .data$Distance), - + distance = as.numeric(if ("Distance.1" %in% col_names) { + .data$Distance.1 + } else if ("Distance...18" %in% col_names) { + .data$`Distance...18` + } else { + .data$Distance + }), + # Times - CSV shows seconds, has duplicate columns # Handle different possible column names based on how R reads the CSV - moving_time = as.integer(if("Moving.Time" %in% col_names) .data$Moving.Time else .data$`Moving Time`), - elapsed_time = as.integer(if("Elapsed.Time.1" %in% col_names) .data$Elapsed.Time.1 - else if("Elapsed Time...16" %in% col_names) .data$`Elapsed Time...16` - else .data$`Elapsed Time`), - + moving_time = as.integer(if ("Moving.Time" %in% col_names) .data$Moving.Time else .data$`Moving Time`), + elapsed_time = as.integer(if ("Elapsed.Time.1" %in% col_names) { + .data$Elapsed.Time.1 + } else if ("Elapsed Time...16" %in% col_names) { + .data$`Elapsed Time...16` + } else { + .data$`Elapsed Time` + }), + # Heart Rate - handle duplicate columns - average_heartrate = as.numeric(if("Average.Heart.Rate" %in% col_names) .data$Average.Heart.Rate else .data$`Average Heart Rate`), - max_heartrate = as.numeric(if("Max.Heart.Rate.1" %in% col_names) .data$Max.Heart.Rate.1 - else if("Max Heart Rate...31" %in% col_names) .data$`Max Heart Rate...31` - else .data$`Max Heart Rate`), - + average_heartrate = as.numeric(if ("Average.Heart.Rate" %in% col_names) .data$Average.Heart.Rate else .data$`Average Heart Rate`), + max_heartrate = as.numeric(if ("Max.Heart.Rate.1" %in% col_names) { + .data$Max.Heart.Rate.1 + } else if ("Max Heart Rate...31" %in% col_names) { + .data$`Max Heart Rate...31` + } else { + .data$`Max Heart Rate` + }), + # Power - average_watts = as.numeric(if("Average.Watts" %in% col_names) .data$Average.Watts else .data$`Average Watts`), - max_watts = as.numeric(if("Max.Watts" %in% col_names) .data$Max.Watts else .data$`Max Watts`), - weighted_average_watts = as.numeric(if("Weighted Average Power" %in% col_names) .data$`Weighted Average Power` else NA_real_), - + average_watts = as.numeric(if ("Average.Watts" %in% col_names) .data$Average.Watts else .data$`Average Watts`), + max_watts = as.numeric(if ("Max.Watts" %in% col_names) .data$Max.Watts else .data$`Max Watts`), + weighted_average_watts = as.numeric(if ("Weighted Average Power" %in% col_names) .data$`Weighted Average Power` else NA_real_), + # Elevation - elevation_gain = as.numeric(if("Elevation.Gain" %in% col_names) .data$Elevation.Gain else .data$`Elevation Gain`), - elevation_loss = as.numeric(if("Elevation.Loss" %in% col_names) .data$Elevation.Loss else .data$`Elevation Loss`), - + elevation_gain = as.numeric(if ("Elevation.Gain" %in% col_names) .data$Elevation.Gain else .data$`Elevation Gain`), + elevation_loss = as.numeric(if ("Elevation.Loss" %in% col_names) .data$Elevation.Loss else .data$`Elevation Loss`), + # Speed - average_speed = as.numeric(if("Average.Speed" %in% col_names) .data$Average.Speed else .data$`Average Speed`), - max_speed = as.numeric(if("Max.Speed" %in% col_names) .data$Max.Speed else .data$`Max Speed`), - + average_speed = as.numeric(if ("Average.Speed" %in% col_names) .data$Average.Speed else .data$`Average Speed`), + max_speed = as.numeric(if ("Max.Speed" %in% col_names) .data$Max.Speed else .data$`Max Speed`), + # Other useful metrics calories = as.numeric(.data$Calories), - relative_effort = as.numeric(if("Relative.Effort.1" %in% col_names) .data$Relative.Effort.1 - else if("Relative Effort...38" %in% col_names) .data$`Relative Effort...38` - else .data$`Relative Effort`), - + relative_effort = as.numeric(if ("Relative.Effort.1" %in% col_names) { + .data$Relative.Effort.1 + } else if ("Relative Effort...38" %in% col_names) { + .data$`Relative Effort...38` + } else { + .data$`Relative Effort` + }), + # File path for detailed activity data (for decoupling, pbs analysis) filename = as.character(.data$Filename) ) - + # --- Select Key Columns --- # Keep columns that are commonly used in Athlytics functions key_columns <- c( @@ -236,65 +260,69 @@ load_local_activities <- function(path = "strava_export_data/activities.csv", "calories", "relative_effort", "filename" ) - + # Select only existing columns available_cols <- key_columns[key_columns %in% names(activities_df)] activities_df <- activities_df %>% dplyr::select(dplyr::all_of(available_cols)) - + # --- Apply Filters --- - + # Filter by date range if (!is.null(start_date)) { - start_date_parsed <- tryCatch({ - lubridate::as_datetime(start_date) - }, error = function(e) { - stop("Could not parse start_date. Please use YYYY-MM-DD format or a Date/POSIXct object.") - }) - + start_date_parsed <- tryCatch( + { + lubridate::as_datetime(start_date) + }, + error = function(e) { + stop("Could not parse start_date. Please use YYYY-MM-DD format or a Date/POSIXct object.") + } + ) + activities_df <- activities_df %>% dplyr::filter(.data$start_date_local >= start_date_parsed) - + message("Filtered to activities after ", start_date_parsed) } - + if (!is.null(end_date)) { - end_date_parsed <- tryCatch({ - dt <- lubridate::as_datetime(end_date) - # If time is 00:00:00, extend to end of day - if (format(dt, "%H:%M:%S") == "00:00:00") { - dt <- dt + lubridate::hours(23) + lubridate::minutes(59) + lubridate::seconds(59) + end_date_parsed <- tryCatch( + { + dt <- lubridate::as_datetime(end_date) + # If time is 00:00:00, extend to end of day + if (format(dt, "%H:%M:%S") == "00:00:00") { + dt <- dt + lubridate::hours(23) + lubridate::minutes(59) + lubridate::seconds(59) + } + dt + }, + error = function(e) { + stop("Could not parse end_date. Please use YYYY-MM-DD format or a Date/POSIXct object.") } - dt - }, error = function(e) { - stop("Could not parse end_date. Please use YYYY-MM-DD format or a Date/POSIXct object.") - }) - + ) + activities_df <- activities_df %>% dplyr::filter(.data$start_date_local <= end_date_parsed) - + message("Filtered to activities before ", end_date_parsed) } - + # Filter by activity type if (!is.null(activity_types)) { if (!is.character(activity_types)) { stop("activity_types must be a character vector (e.g., c('Run', 'Ride'))") } - + activities_df <- activities_df %>% dplyr::filter(.data$type %in% activity_types) - + message("Filtered to activity types: ", paste(activity_types, collapse = ", ")) } - + # --- Final Sorting --- activities_df <- activities_df %>% dplyr::arrange(.data$start_date_local) - + message("Data loading complete. ", nrow(activities_df), " activities after filtering.") - + return(activities_df) } - - diff --git a/R/parse_activity_file.R b/R/parse_activity_file.R index afb70e1..959e3a9 100644 --- a/R/parse_activity_file.R +++ b/R/parse_activity_file.R @@ -8,7 +8,7 @@ #' @param file_path Path to the activity file (can be .fit, .tcx, .gpx, or .gz compressed) #' @param export_dir Base directory of the Strava export (for resolving relative paths) #' -#' @return A data frame with columns: time, latitude, longitude, elevation, +#' @return A data frame with columns: time, latitude, longitude, elevation, #' heart_rate, power, cadence, speed (all optional depending on file content). #' Returns NULL if file cannot be parsed or does not exist. #' @@ -24,36 +24,38 @@ #' @importFrom utils read.csv #' @export parse_activity_file <- function(file_path, export_dir = NULL) { - # Resolve full path if (!is.null(export_dir) && !file.exists(file_path)) { file_path <- file.path(export_dir, file_path) } - + if (!file.exists(file_path)) { warning(sprintf("Activity file not found: %s", file_path)) return(NULL) } - + # Handle .gz compressed files original_path <- file_path is_compressed <- grepl("\\.gz$", file_path, ignore.case = TRUE) - + if (is_compressed) { # Decompress to temp file temp_file <- tempfile(fileext = gsub("\\.gz$", "", basename(file_path))) - tryCatch({ - R.utils::gunzip(file_path, destname = temp_file, remove = FALSE, overwrite = TRUE) - file_path <- temp_file - }, error = function(e) { - warning(sprintf("Failed to decompress file: %s", e$message)) - return(NULL) - }) + tryCatch( + { + R.utils::gunzip(file_path, destname = temp_file, remove = FALSE, overwrite = TRUE) + file_path <- temp_file + }, + error = function(e) { + warning(sprintf("Failed to decompress file: %s", e$message)) + return(NULL) + } + ) } - + # Determine file type file_ext <- tolower(tools::file_ext(file_path)) - + result <- tryCatch({ if (file_ext == "fit") { parse_fit_file(file_path) @@ -74,29 +76,31 @@ parse_activity_file <- function(file_path, export_dir = NULL) { unlink(temp_file) } }) - + return(result) } #' Parse FIT file #' @keywords internal parse_fit_file <- function(file_path) { - if (!requireNamespace("FITfileR", quietly = TRUE)) { + fit_pkg <- "FITfileR" + + if (!requireNamespace(fit_pkg, quietly = TRUE)) { warning("Package 'FITfileR' is required to parse FIT files. Please install it from GitHub: remotes::install_github('grimbough/FITfileR')") return(NULL) } - + # Use getFromNamespace to avoid R CMD check warnings about undeclared imports - readFitFile <- utils::getFromNamespace("readFitFile", "FITfileR") - records_fn <- utils::getFromNamespace("records", "FITfileR") - + readFitFile <- utils::getFromNamespace("readFitFile", fit_pkg) + records_fn <- utils::getFromNamespace("records", fit_pkg) + fit_data <- readFitFile(file_path) records <- records_fn(fit_data) - + if (is.null(records) || nrow(records) == 0) { return(NULL) } - + # Extract relevant columns df <- data.frame( time = if ("timestamp" %in% names(records)) as.POSIXct(records$timestamp) else NA, @@ -110,10 +114,10 @@ parse_fit_file <- function(file_path) { distance = if ("distance" %in% names(records)) records$distance else NA, stringsAsFactors = FALSE ) - + # Remove rows where time is NA df <- df[!is.na(df$time), ] - + return(df) } @@ -124,46 +128,46 @@ parse_tcx_file <- function(file_path) { warning("Package 'xml2' is required to parse TCX files. Please install it.") return(NULL) } - + doc <- xml2::read_xml(file_path) - + # Define namespaces ns <- xml2::xml_ns(doc) - + # Find all Trackpoint nodes trackpoints <- xml2::xml_find_all(doc, ".//d1:Trackpoint", ns) - + if (length(trackpoints) == 0) { return(NULL) } - + # Extract data from each trackpoint extract_trackpoint <- function(tp) { time_node <- xml2::xml_find_first(tp, "./d1:Time", ns) time <- if (length(time_node) > 0) xml2::xml_text(time_node) else character(0) - + lat_node <- xml2::xml_find_first(tp, "./d1:Position/d1:LatitudeDegrees", ns) lat <- if (length(lat_node) > 0) xml2::xml_text(lat_node) else character(0) - + lon_node <- xml2::xml_find_first(tp, "./d1:Position/d1:LongitudeDegrees", ns) lon <- if (length(lon_node) > 0) xml2::xml_text(lon_node) else character(0) - + alt_node <- xml2::xml_find_first(tp, "./d1:AltitudeMeters", ns) alt <- if (length(alt_node) > 0) xml2::xml_text(alt_node) else character(0) - + hr_node <- xml2::xml_find_first(tp, ".//d1:HeartRateBpm/d1:Value", ns) hr <- if (length(hr_node) > 0) xml2::xml_text(hr_node) else character(0) - + cadence_node <- xml2::xml_find_first(tp, "./d1:Cadence", ns) cadence <- if (length(cadence_node) > 0) xml2::xml_text(cadence_node) else character(0) - + dist_node <- xml2::xml_find_first(tp, "./d1:DistanceMeters", ns) dist <- if (length(dist_node) > 0) xml2::xml_text(dist_node) else character(0) - + # Extensions for power power_node <- xml2::xml_find_first(tp, ".//ns3:Watts", ns) power <- if (length(power_node) > 0) xml2::xml_text(power_node) else character(0) - + data.frame( time = if (length(time) > 0) as.POSIXct(time[1], format = "%Y-%m-%dT%H:%M:%OS", tz = "UTC") else NA, latitude = if (length(lat) > 0) as.numeric(lat[1]) else NA, @@ -176,17 +180,17 @@ parse_tcx_file <- function(file_path) { stringsAsFactors = FALSE ) } - + df <- do.call(rbind, lapply(trackpoints, extract_trackpoint)) df <- df[!is.na(df$time), ] - + # Calculate speed from distance if available if ("distance" %in% names(df) && nrow(df) > 1) { df$speed <- c(NA, diff(df$distance) / as.numeric(diff(df$time))) } else { df$speed <- NA } - + return(df) } @@ -197,36 +201,36 @@ parse_gpx_file <- function(file_path) { warning("Package 'xml2' is required to parse GPX files. Please install it.") return(NULL) } - + doc <- xml2::read_xml(file_path) - + # Get namespaces from document ns <- xml2::xml_ns(doc) - + # Find all track points trackpoints <- xml2::xml_find_all(doc, ".//d1:trkpt", ns) - + if (length(trackpoints) == 0) { return(NULL) } - + # Extract data from each trackpoint extract_trkpt <- function(trkpt) { lat <- xml2::xml_attr(trkpt, "lat") lon <- xml2::xml_attr(trkpt, "lon") - + ele_node <- xml2::xml_find_first(trkpt, "./d1:ele", ns) ele <- if (length(ele_node) > 0) xml2::xml_text(ele_node) else character(0) - + time_node <- xml2::xml_find_first(trkpt, "./d1:time", ns) time <- if (length(time_node) > 0) xml2::xml_text(time_node) else character(0) - + hr_node <- xml2::xml_find_first(trkpt, ".//gpxtpx:hr", ns) hr <- if (length(hr_node) > 0) xml2::xml_text(hr_node) else character(0) - + cad_node <- xml2::xml_find_first(trkpt, ".//gpxtpx:cad", ns) cad <- if (length(cad_node) > 0) xml2::xml_text(cad_node) else character(0) - + data.frame( time = if (length(time) > 0) as.POSIXct(time[1], format = "%Y-%m-%dT%H:%M:%OSZ", tz = "UTC") else NA, latitude = if (!is.null(lat)) as.numeric(lat) else NA, @@ -238,31 +242,33 @@ parse_gpx_file <- function(file_path) { stringsAsFactors = FALSE ) } - + df <- do.call(rbind, lapply(trackpoints, extract_trkpt)) df <- df[!is.na(df$time), ] - + # Calculate speed and distance from GPS coordinates if (nrow(df) > 1) { # Calculate distance using Haversine formula calc_distance <- function(lat1, lon1, lat2, lon2) { - R <- 6371000 # Earth radius in meters + R <- 6371000 # Earth radius in meters lat1_rad <- lat1 * pi / 180 lat2_rad <- lat2 * pi / 180 delta_lat <- (lat2 - lat1) * pi / 180 delta_lon <- (lon2 - lon1) * pi / 180 - - a <- sin(delta_lat/2)^2 + cos(lat1_rad) * cos(lat2_rad) * sin(delta_lon/2)^2 - c <- 2 * atan2(sqrt(a), sqrt(1-a)) - + + a <- sin(delta_lat / 2)^2 + cos(lat1_rad) * cos(lat2_rad) * sin(delta_lon / 2)^2 + c <- 2 * atan2(sqrt(a), sqrt(1 - a)) + return(R * c) } - + distances <- sapply(2:nrow(df), function(i) { - calc_distance(df$latitude[i-1], df$longitude[i-1], - df$latitude[i], df$longitude[i]) + calc_distance( + df$latitude[i - 1], df$longitude[i - 1], + df$latitude[i], df$longitude[i] + ) }) - + time_diffs <- as.numeric(diff(df$time)) df$speed <- c(NA, ifelse(time_diffs > 0, distances / time_diffs, NA)) df$distance <- c(0, cumsum(distances)) @@ -270,6 +276,6 @@ parse_gpx_file <- function(file_path) { df$speed <- NA df$distance <- NA } - + return(df) } diff --git a/R/plot_acwr.R b/R/plot_acwr.R index 6589bd5..cb838a6 100644 --- a/R/plot_acwr.R +++ b/R/plot_acwr.R @@ -27,7 +27,7 @@ #' @details Plots the ACWR trend over time. **Best practice: Use `load_local_activities()` + `calculate_acwr()` + this function.** #' ACWR is calculated as acute load / chronic load. A ratio of 0.8-1.3 is often considered the "sweet spot". #' -#' +#' #' @importFrom dplyr filter select mutate group_by summarise arrange %>% left_join coalesce case_when ungroup #' @importFrom lubridate as_date date days ymd ymd_hms as_datetime #' @importFrom zoo rollmean @@ -37,26 +37,30 @@ #' #' @examples #' # Example using pre-calculated sample data -#' data("athlytics_sample_acwr", package = "Athlytics") -#' p <- plot_acwr(athlytics_sample_acwr) +#' data("sample_acwr", package = "Athlytics") +#' p <- plot_acwr(sample_acwr) #' print(p) #' #' \dontrun{ #' # Example using local Strava export data #' activities <- load_local_activities("strava_export_data/activities.csv") -#' +#' #' # Plot ACWR trend for Runs (using duration as load metric) -#' plot_acwr(data = activities, -#' activity_type = "Run", -#' load_metric = "duration_mins", -#' acute_period = 7, -#' chronic_period = 28) +#' plot_acwr( +#' data = activities, +#' activity_type = "Run", +#' load_metric = "duration_mins", +#' acute_period = 7, +#' chronic_period = 28 +#' ) #' #' # Plot ACWR trend for Rides (using TSS as load metric) -#' plot_acwr(data = activities, -#' activity_type = "Ride", -#' load_metric = "tss", -#' user_ftp = 280) # FTP value is required +#' plot_acwr( +#' data = activities, +#' activity_type = "Ride", +#' load_metric = "tss", +#' user_ftp = 280 +#' ) # FTP value is required #' } plot_acwr <- function(data, activity_type = NULL, @@ -73,62 +77,67 @@ plot_acwr <- function(data, acwr_df = NULL, group_var = NULL, group_colors = NULL) { - # --- Check if first argument is already ACWR data frame --- # This allows backward compatibility: plot_acwr(acwr_result) if (is.data.frame(data) && "acwr_smooth" %in% colnames(data)) { acwr_df <- data } - - # --- Get Data --- + + # --- Get Data --- # If acwr_df is not provided, calculate it if (is.null(acwr_df)) { - # Check if data provided when acwr_df is not - if (missing(data)) stop("Either provide ACWR data frame from calculate_acwr() as first argument, or provide activities_data.") - - # data should be activities_data in new usage - acwr_df <- calculate_acwr( - activities_data = data, - activity_type = activity_type, - load_metric = load_metric, - acute_period = acute_period, - chronic_period = chronic_period, - start_date = start_date, - end_date = end_date, - user_ftp = user_ftp, - user_max_hr = user_max_hr, - user_resting_hr = user_resting_hr, - smoothing_period = smoothing_period - ) - } - + # Check if data provided when acwr_df is not + if (missing(data)) stop("Either provide ACWR data frame from calculate_acwr() as first argument, or provide activities_data.") + + # data should be activities_data in new usage + acwr_df <- calculate_acwr( + activities_data = data, + activity_type = activity_type, + load_metric = load_metric, + acute_period = acute_period, + chronic_period = chronic_period, + start_date = start_date, + end_date = end_date, + user_ftp = user_ftp, + user_max_hr = user_max_hr, + user_resting_hr = user_resting_hr, + smoothing_period = smoothing_period + ) + } + # Check if acwr_df is empty or invalid after potentially calculating it # Check if required 'acwr_smooth' column exists if (!is.data.frame(acwr_df) || nrow(acwr_df) == 0 || !"acwr_smooth" %in% colnames(acwr_df)) { - warning("No valid ACWR data available to plot (or missing 'acwr_smooth' column).") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No ACWR data available")) + warning("No valid ACWR data available to plot (or missing 'acwr_smooth' column).") + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No ACWR data available")) } - + # Drop rows where smoothed ACWR is NA for plotting purposes plot_data <- acwr_df %>% tidyr::drop_na("acwr_smooth") - + if (nrow(plot_data) == 0) { # It's possible all rows were NA after smoothing warning("No valid smoothed ACWR data available for plotting after removing NAs.") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No smoothed ACWR data available")) + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No smoothed ACWR data available")) } # --- Check for group variable --- has_groups <- !is.null(group_var) && group_var %in% colnames(plot_data) - + # --- Plotting --- message("Generating plot...") - + if (has_groups) { # Multi-group plotting - p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = .data$date, y = .data$acwr_smooth, - color = .data[[group_var]], - group = .data[[group_var]])) + p <- ggplot2::ggplot(plot_data, ggplot2::aes( + x = .data$date, y = .data$acwr_smooth, + color = .data[[group_var]], + group = .data[[group_var]] + )) } else { # Single group plotting p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = .data$date, y = .data$acwr_smooth)) @@ -148,31 +157,30 @@ plot_acwr <- function(data, ggplot2::geom_ribbon(ggplot2::aes(ymin = sweet_spot_max, ymax = high_risk_min), fill = "#F39B7F", alpha = 0.15) + # Sweet Spot (e.g., 0.8 - 1.3) ggplot2::geom_ribbon(ggplot2::aes(ymin = sweet_spot_min, ymax = sweet_spot_max), fill = "#00A087", alpha = 0.15) + - # Low Load / Undertraining Zone (e.g., < 0.8) + # Low Load / Undertraining Zone (e.g., < 0.8) ggplot2::geom_ribbon(ggplot2::aes(ymin = -Inf, ymax = sweet_spot_min), fill = "#4DBBD5", alpha = 0.15) - - # Add annotations only if there's enough space/range - plot_date_range <- range(plot_data$date) - plot_y_range <- range(plot_data$acwr_smooth) - annotation_x_pos <- plot_date_range[1] + lubridate::days(round(as.numeric(diff(plot_date_range)) * 0.05)) - - if(plot_y_range[2] > high_risk_min) { - p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = min(plot_y_range[2], high_risk_min + 0.2), label = "High Risk", hjust = 0, vjust = 1, size = 3, color = "#E64B35", alpha = 0.8, fontface = "bold") - } - if(plot_y_range[2] > sweet_spot_max) { - p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = min(plot_y_range[2], (sweet_spot_max + high_risk_min)/2), label = "Caution", hjust = 0, vjust = 0.5, size = 3, color = "#F39B7F", alpha = 0.8, fontface = "bold") - } - p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = (sweet_spot_min + sweet_spot_max) / 2, label = "Sweet Spot", hjust = 0, vjust = 0.5, size = 3, color = "#00A087", alpha = 0.8, fontface = "bold") - if(plot_y_range[1] < sweet_spot_min) { - p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = max(plot_y_range[1], sweet_spot_min - 0.1), label = "Low Load", hjust = 0, vjust = 0, size = 3, color = "#4DBBD5", alpha = 0.8, fontface = "bold") - } + # Add annotations only if there's enough space/range + plot_date_range <- range(plot_data$date) + plot_y_range <- range(plot_data$acwr_smooth) + annotation_x_pos <- plot_date_range[1] + lubridate::days(round(as.numeric(diff(plot_date_range)) * 0.05)) + + if (plot_y_range[2] > high_risk_min) { + p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = min(plot_y_range[2], high_risk_min + 0.2), label = "High Risk", hjust = 0, vjust = 1, size = 3, color = "#E64B35", alpha = 0.8, fontface = "bold") + } + if (plot_y_range[2] > sweet_spot_max) { + p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = min(plot_y_range[2], (sweet_spot_max + high_risk_min) / 2), label = "Caution", hjust = 0, vjust = 0.5, size = 3, color = "#F39B7F", alpha = 0.8, fontface = "bold") + } + p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = (sweet_spot_min + sweet_spot_max) / 2, label = "Sweet Spot", hjust = 0, vjust = 0.5, size = 3, color = "#00A087", alpha = 0.8, fontface = "bold") + if (plot_y_range[1] < sweet_spot_min) { + p <- p + ggplot2::annotate("text", x = annotation_x_pos, y = max(plot_y_range[1], sweet_spot_min - 0.1), label = "Low Load", hjust = 0, vjust = 0, size = 3, color = "#4DBBD5", alpha = 0.8, fontface = "bold") + } } # Add ACWR line(s) if (has_groups) { p <- p + ggplot2::geom_line(linewidth = 1.2, alpha = 0.8) - + # Apply custom colors if provided if (!is.null(group_colors)) { p <- p + ggplot2::scale_color_manual(values = group_colors, name = group_var) @@ -192,21 +200,23 @@ plot_acwr <- function(data, y_breaks <- seq(0, ceiling(y_max_limit * 5) / 5, by = 0.2) # Breaks every 0.2 # Add reference lines (optional) - if(highlight_zones) { - p <- p + - ggplot2::geom_hline(yintercept = sweet_spot_min, linetype = "dotted", color = "grey40") + - ggplot2::geom_hline(yintercept = sweet_spot_max, linetype = "dotted", color = "grey40") + - ggplot2::geom_hline(yintercept = high_risk_min, linetype = "dotted", color = "grey40") + if (highlight_zones) { + p <- p + + ggplot2::geom_hline(yintercept = sweet_spot_min, linetype = "dotted", color = "grey40") + + ggplot2::geom_hline(yintercept = sweet_spot_max, linetype = "dotted", color = "grey40") + + ggplot2::geom_hline(yintercept = high_risk_min, linetype = "dotted", color = "grey40") } # Customize plot appearance p <- p + ggplot2::labs( title = "Acute:Chronic Workload Ratio (ACWR) Trend", - subtitle = paste0("Load Metric: ", load_metric, - ", Activity: ", ifelse(is.null(activity_type), "All", paste(activity_type, collapse=", ")), - ", Periods: ", acute_period, "d (Acute) / ", chronic_period, "d (Chronic)", - ", Smoothed: ", smoothing_period, "d"), + subtitle = paste0( + "Load Metric: ", load_metric, + ", Activity: ", ifelse(is.null(activity_type), "All", paste(activity_type, collapse = ", ")), + ", Periods: ", acute_period, "d (Acute) / ", chronic_period, "d (Chronic)", + ", Smoothed: ", smoothing_period, "d" + ), x = "Date", y = paste0("ACWR (", smoothing_period, "-day Smoothed)") ) + @@ -214,8 +224,8 @@ plot_acwr <- function(data, ggplot2::scale_x_date(labels = english_month_year, date_breaks = "3 months") + theme_athlytics() + ggplot2::theme( - legend.position = if(has_groups) "bottom" else "none" + legend.position = if (has_groups) "bottom" else "none" ) - + return(p) } diff --git a/R/plot_acwr_enhanced.R b/R/plot_acwr_enhanced.R index 8b1ae16..f9120c0 100644 --- a/R/plot_acwr_enhanced.R +++ b/R/plot_acwr_enhanced.R @@ -6,7 +6,7 @@ #' and cohort reference percentiles. #' #' @param acwr_data A data frame from `calculate_acwr_ewma()` containing ACWR values. -#' @param reference_data Optional. A data frame from `cohort_reference()` for +#' @param reference_data Optional. A data frame from `calculate_cohort_reference()` for #' adding cohort reference bands. #' @param show_ci Logical. Whether to show confidence bands (if available in data). #' Default TRUE. @@ -43,9 +43,9 @@ #' #' @examples #' # Example using sample data -#' data("athlytics_sample_acwr", package = "Athlytics") -#' if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { -#' p <- plot_acwr_enhanced(athlytics_sample_acwr, show_ci = FALSE) +#' data("sample_acwr", package = "Athlytics") +#' if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { +#' p <- plot_acwr_enhanced(sample_acwr, show_ci = FALSE) #' print(p) #' } #' @@ -65,94 +65,99 @@ #' plot_acwr_enhanced(acwr) #' #' # With cohort reference -#' reference <- cohort_reference(cohort_data, metric = "acwr_smooth") +#' reference <- calculate_cohort_reference(cohort_data, metric = "acwr_smooth") #' plot_acwr_enhanced(acwr, reference_data = reference) #' } plot_acwr_enhanced <- function(acwr_data, - reference_data = NULL, - show_ci = TRUE, - show_reference = TRUE, - reference_bands = c("p25_p75", "p05_p95", "p50"), - highlight_zones = TRUE, - title = NULL, - subtitle = NULL, - method_label = NULL) { - + reference_data = NULL, + show_ci = TRUE, + show_reference = TRUE, + reference_bands = c("p25_p75", "p05_p95", "p50"), + highlight_zones = TRUE, + title = NULL, + subtitle = NULL, + method_label = NULL) { # --- Input Validation --- if (!is.data.frame(acwr_data)) { stop("`acwr_data` must be a data frame from calculate_acwr_ewma().") } - + required_cols <- c("date", "acwr_smooth") if (!all(required_cols %in% colnames(acwr_data))) { stop("acwr_data must contain columns: date, acwr_smooth") } - + # Check for CI columns has_ci <- all(c("acwr_lower", "acwr_upper") %in% colnames(acwr_data)) if (show_ci && !has_ci) { message("Confidence interval columns not found. Setting show_ci = FALSE.") show_ci <- FALSE } - + # Check for reference data if (show_reference && is.null(reference_data)) { message("No reference data provided. Setting show_reference = FALSE.") show_reference <- FALSE } - + # --- Create Base Plot --- p <- ggplot2::ggplot() - + # --- Layer 1: Risk Zones (if enabled) --- if (highlight_zones) { sweet_spot_min <- 0.8 sweet_spot_max <- 1.3 high_risk_min <- 1.5 - + # Determine y-axis range for zones y_max <- max(acwr_data$acwr_smooth, na.rm = TRUE) if (has_ci && show_ci) { y_max <- max(c(y_max, acwr_data$acwr_upper), na.rm = TRUE) } y_max <- max(y_max, high_risk_min + 0.2) - + # Add zone ribbons date_range <- range(acwr_data$date, na.rm = TRUE) - + p <- p + # High Risk Zone (> 1.5) - ggplot2::annotate("rect", - xmin = date_range[1], xmax = date_range[2], - ymin = high_risk_min, ymax = y_max, - fill = "red", alpha = 0.1) + + ggplot2::annotate("rect", + xmin = date_range[1], xmax = date_range[2], + ymin = high_risk_min, ymax = y_max, + fill = "red", alpha = 0.1 + ) + # Caution Zone (1.3 - 1.5) ggplot2::annotate("rect", - xmin = date_range[1], xmax = date_range[2], - ymin = sweet_spot_max, ymax = high_risk_min, - fill = "orange", alpha = 0.1) + + xmin = date_range[1], xmax = date_range[2], + ymin = sweet_spot_max, ymax = high_risk_min, + fill = "orange", alpha = 0.1 + ) + # Sweet Spot (0.8 - 1.3) ggplot2::annotate("rect", - xmin = date_range[1], xmax = date_range[2], - ymin = sweet_spot_min, ymax = sweet_spot_max, - fill = "green", alpha = 0.1) + + xmin = date_range[1], xmax = date_range[2], + ymin = sweet_spot_min, ymax = sweet_spot_max, + fill = "green", alpha = 0.1 + ) + # Low Load (< 0.8) ggplot2::annotate("rect", - xmin = date_range[1], xmax = date_range[2], - ymin = 0, ymax = sweet_spot_min, - fill = "lightblue", alpha = 0.1) + + xmin = date_range[1], xmax = date_range[2], + ymin = 0, ymax = sweet_spot_min, + fill = "lightblue", alpha = 0.1 + ) + # Zone reference lines - ggplot2::geom_hline(yintercept = c(sweet_spot_min, sweet_spot_max, high_risk_min), - linetype = "dotted", color = "grey40", linewidth = 0.5) + ggplot2::geom_hline( + yintercept = c(sweet_spot_min, sweet_spot_max, high_risk_min), + linetype = "dotted", color = "grey40", linewidth = 0.5 + ) } - + # --- Layer 2: Cohort Reference Bands (if provided) --- if (show_reference && !is.null(reference_data)) { # Pivot reference to wide format ref_wide <- reference_data %>% dplyr::select(.data$date, .data$percentile, .data$value) %>% tidyr::pivot_wider(names_from = .data$percentile, values_from = .data$value) - + # Add P5-P95 band (outermost) if ("p05_p95" %in% reference_bands && all(c("p05", "p95") %in% colnames(ref_wide))) { p <- p + ggplot2::geom_ribbon( @@ -161,7 +166,7 @@ plot_acwr_enhanced <- function(acwr_data, fill = "#3B528BFF", alpha = 0.15 ) } - + # Add P25-P75 band (inner) if ("p25_p75" %in% reference_bands && all(c("p25", "p75") %in% colnames(ref_wide))) { p <- p + ggplot2::geom_ribbon( @@ -170,7 +175,7 @@ plot_acwr_enhanced <- function(acwr_data, fill = "#440154FF", alpha = 0.25 ) } - + # Add P50 line (median) if ("p50" %in% reference_bands && "p50" %in% colnames(ref_wide)) { p <- p + ggplot2::geom_line( @@ -180,7 +185,7 @@ plot_acwr_enhanced <- function(acwr_data, ) } } - + # --- Layer 3: Confidence Bands (if available) --- if (show_ci && has_ci) { p <- p + ggplot2::geom_ribbon( @@ -189,17 +194,17 @@ plot_acwr_enhanced <- function(acwr_data, fill = "steelblue", alpha = 0.3 ) } - + # --- Layer 4: Individual ACWR Line --- p <- p + ggplot2::geom_line( data = acwr_data, ggplot2::aes(x = .data$date, y = .data$acwr_smooth), color = "#E64B35", linewidth = 2, alpha = 0.9 ) - + # --- Labels and Theme --- plot_title <- title %||% "Acute:Chronic Workload Ratio (ACWR)" - + # Auto-generate subtitle if (is.null(subtitle)) { subtitle_parts <- c() @@ -218,7 +223,7 @@ plot_acwr_enhanced <- function(acwr_data, NULL } } - + p <- p + ggplot2::labs( title = plot_title, @@ -227,13 +232,17 @@ plot_acwr_enhanced <- function(acwr_data, y = "ACWR (Smoothed)", caption = if (highlight_zones) { "Zones: Green = Sweet Spot (0.8-1.3) | Orange = Caution | Red = High Risk (>1.5)" - } else NULL + } else { + NULL + } ) + ggplot2::scale_x_date( date_breaks = "3 months", labels = function(x) { - months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") + months <- c( + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" + ) paste(months[as.integer(format(x, "%m"))], format(x, "%Y")) } ) + @@ -241,7 +250,7 @@ plot_acwr_enhanced <- function(acwr_data, ggplot2::theme( axis.text.x = ggplot2::element_text(angle = 45, hjust = 1) ) - + return(p) } @@ -262,13 +271,13 @@ plot_acwr_enhanced <- function(acwr_data, #' #' @examples #' # Example using sample data -#' data("athlytics_sample_acwr", package = "Athlytics") -#' if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { +#' data("sample_acwr", package = "Athlytics") +#' if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { #' # Create two versions for comparison (simulate RA vs EWMA) -#' acwr_ra <- athlytics_sample_acwr -#' acwr_ewma <- athlytics_sample_acwr +#' acwr_ra <- sample_acwr +#' acwr_ewma <- sample_acwr #' acwr_ewma$acwr_smooth <- acwr_ewma$acwr_smooth * runif(nrow(acwr_ewma), 0.95, 1.05) -#' +#' #' p <- plot_acwr_comparison(acwr_ra, acwr_ewma) #' print(p) #' } @@ -282,22 +291,23 @@ plot_acwr_enhanced <- function(acwr_data, #' plot_acwr_comparison(acwr_ra, acwr_ewma) #' } plot_acwr_comparison <- function(acwr_ra, - acwr_ewma, - title = "ACWR Method Comparison: RA vs EWMA") { - + acwr_ewma, + title = "ACWR Method Comparison: RA vs EWMA") { # Combine data with method labels combined <- dplyr::bind_rows( acwr_ra %>% dplyr::mutate(method = "Rolling Average (RA)"), acwr_ewma %>% dplyr::mutate(method = "EWMA") ) - + # Create faceted plot p <- ggplot2::ggplot(combined, ggplot2::aes(x = .data$date, y = .data$acwr_smooth, color = .data$method)) + - ggplot2::geom_hline(yintercept = c(0.8, 1.3, 1.5), - linetype = "dotted", color = "gray50", alpha = 0.5) + + ggplot2::geom_hline( + yintercept = c(0.8, 1.3, 1.5), + linetype = "dotted", color = "gray50", alpha = 0.5 + ) + ggplot2::geom_line(linewidth = 1.8, alpha = 0.9) + ggplot2::scale_color_manual(values = c("Rolling Average (RA)" = "#4DBBD5", "EWMA" = "#E64B35")) + - ggplot2::facet_wrap(~.data$method, ncol = 1) + + ggplot2::facet_wrap(~ .data$method, ncol = 1) + ggplot2::labs( title = title, subtitle = "Dotted lines: 0.8 (low load) | 1.3 (sweet spot max) | 1.5 (high risk)", @@ -307,8 +317,10 @@ plot_acwr_comparison <- function(acwr_ra, ggplot2::scale_x_date( date_breaks = "3 months", labels = function(x) { - months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") + months <- c( + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" + ) paste(months[as.integer(format(x, "%m"))], format(x, "%Y")) } ) + @@ -317,8 +329,6 @@ plot_acwr_comparison <- function(acwr_ra, axis.text.x = ggplot2::element_text(angle = 45, hjust = 1), legend.position = "none" ) - + return(p) } - - diff --git a/R/plot_decoupling.R b/R/plot_decoupling.R index bc22db3..a8a2481 100644 --- a/R/plot_decoupling.R +++ b/R/plot_decoupling.R @@ -38,21 +38,21 @@ #' #' @examples #' # Example using pre-calculated sample data -#' data("athlytics_sample_decoupling", package = "Athlytics") -#' p <- plot_decoupling(decoupling_df = athlytics_sample_decoupling) +#' data("sample_decoupling", package = "Athlytics") +#' p <- plot_decoupling(decoupling_df = sample_decoupling) #' print(p) #' #' \dontrun{ #' # Example using local Strava export data #' activities <- load_local_activities("strava_export_data/activities.csv") -#' +#' #' # Example 1: Plot Decoupling trend for Runs (last 6 months) #' decoupling_runs_6mo <- calculate_decoupling( -#' activities_data = activities, -#' export_dir = "strava_export_data", -#' activity_type = "Run", -#' decouple_metric = "pace_hr", -#' start_date = Sys.Date() - months(6) +#' activities_data = activities, +#' export_dir = "strava_export_data", +#' activity_type = "Run", +#' decouple_metric = "pace_hr", +#' start_date = Sys.Date() - months(6) #' ) #' plot_decoupling(decoupling_runs_6mo) #' @@ -83,37 +83,38 @@ plot_decoupling <- function(data, add_trend_line = TRUE, smoothing_method = "loess", decoupling_df = NULL) { - # Match arg for decouple_metric to ensure only one is used internally if multiple are provided decouple_metric_label <- match.arg(decouple_metric) - # --- Get Data --- + # --- Get Data --- # If decoupling_df is not provided, calculate it if (is.null(decoupling_df)) { - # Ensure data is provided if decoupling_df is not - if (missing(data)) stop("Either 'data' or 'decoupling_df' must be provided.") - - message("No pre-calculated decoupling_df provided. Calculating data now... (This may take a while)") - # Call the calculation function - decoupling_df <- calculate_decoupling( - activities_data = data, - activity_type = activity_type, # Can be a vector - decouple_metric = decouple_metric_label, # Use the matched, single metric - start_date = start_date, - end_date = end_date, - min_duration_mins = min_duration_mins - ) + # Ensure data is provided if decoupling_df is not + if (missing(data)) stop("Either 'data' or 'decoupling_df' must be provided.") + + message("No pre-calculated decoupling_df provided. Calculating data now... (This may take a while)") + # Call the calculation function + decoupling_df <- calculate_decoupling( + activities_data = data, + activity_type = activity_type, # Can be a vector + decouple_metric = decouple_metric_label, # Use the matched, single metric + start_date = start_date, + end_date = end_date, + min_duration_mins = min_duration_mins + ) } # Check if decoupling_df is empty or invalid if (!is.data.frame(decoupling_df) || nrow(decoupling_df) == 0 || !all(c("date", "decoupling") %in% names(decoupling_df))) { - warning("No valid decoupling data available to plot (or missing required columns).") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No decoupling data to plot")) + warning("No valid decoupling data available to plot (or missing required columns).") + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No decoupling data to plot")) } # Rename for clarity plot_data <- decoupling_df - + # --- Generate Dynamic Title --- # Determine title based on activity_type and data if ("activity_type" %in% colnames(plot_data)) { @@ -130,10 +131,10 @@ plot_decoupling <- function(data, plot_title <- "Trend for Selected Activities" } } - + # --- Plotting --- message("Generating plot...") - + p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = .data$date, y = .data$decoupling)) + ggplot2::geom_point(alpha = 0.7, size = 2, color = "#E64B35") + ggplot2::scale_x_date(labels = english_month_year, date_breaks = "3 months") + @@ -144,17 +145,17 @@ plot_decoupling <- function(data, y = "Decoupling (%)", caption = "Positive values indicate HR drift relative to output" ) - + # Add 5% threshold line p <- p + ggplot2::geom_hline(yintercept = 5, linetype = "dashed", color = "red", alpha = 0.7) + ggplot2::geom_hline(yintercept = 0, linetype = "solid", color = "black", alpha = 0.5) - + if (add_trend_line && nrow(plot_data) >= 2) { p <- p + ggplot2::geom_smooth(method = smoothing_method, se = FALSE, color = "blue", linewidth = 0.8) } - + p <- p + theme_athlytics() return(p) -} \ No newline at end of file +} diff --git a/R/plot_ef.R b/R/plot_ef.R index a7aaf48..2e32ff5 100644 --- a/R/plot_ef.R +++ b/R/plot_ef.R @@ -26,7 +26,7 @@ #' often indicates improved aerobic fitness. Points colored by activity type. #' **Best practice: Use `load_local_activities()` + `calculate_ef()` + this function.** #' -#' +#' #' @importFrom dplyr filter select mutate arrange %>% rename left_join case_when pull #' @importFrom lubridate as_date date days ymd ymd_hms as_datetime #' @importFrom ggplot2 ggplot aes geom_point geom_smooth labs theme_minimal scale_x_date theme element_text scale_color_viridis_d @@ -35,30 +35,36 @@ #' #' @examples #' # Example using pre-calculated sample data -#' data("athlytics_sample_ef", package = "Athlytics") -#' p <- plot_ef(athlytics_sample_ef) +#' data("sample_ef", package = "Athlytics") +#' p <- plot_ef(sample_ef) #' print(p) #' #' \dontrun{ #' # Example using local Strava export data #' activities <- load_local_activities("strava_export_data/activities.csv") -#' +#' #' # Plot Pace/HR EF trend for Runs (last 6 months) -#' plot_ef(data = activities, -#' activity_type = "Run", -#' ef_metric = "pace_hr", -#' start_date = Sys.Date() - months(6)) +#' plot_ef( +#' data = activities, +#' activity_type = "Run", +#' ef_metric = "pace_hr", +#' start_date = Sys.Date() - months(6) +#' ) #' #' # Plot Power/HR EF trend for Rides -#' plot_ef(data = activities, -#' activity_type = "Ride", -#' ef_metric = "power_hr") +#' plot_ef( +#' data = activities, +#' activity_type = "Ride", +#' ef_metric = "power_hr" +#' ) #' #' # Plot Pace/HR EF trend for multiple Run types (no trend line) -#' plot_ef(data = activities, -#' activity_type = c("Run", "VirtualRun"), -#' ef_metric = "pace_hr", -#' add_trend_line = FALSE) +#' plot_ef( +#' data = activities, +#' activity_type = c("Run", "VirtualRun"), +#' ef_metric = "pace_hr", +#' add_trend_line = FALSE +#' ) #' } plot_ef <- function(data, activity_type = c("Run", "Ride"), @@ -71,7 +77,6 @@ plot_ef <- function(data, ef_df = NULL, group_var = NULL, group_colors = NULL) { - # Match arg here as it's needed for plot labels ef_metric_label <- match.arg(ef_metric) @@ -80,47 +85,52 @@ plot_ef <- function(data, ef_df <- data } - # --- Get Data --- + # --- Get Data --- # If ef_df is not provided, calculate it if (is.null(ef_df)) { - # Check if data provided when ef_df is not - if (missing(data)) stop("Either provide EF data frame from calculate_ef() as first argument, or provide activities_data.") - - ef_df <- calculate_ef( - activities_data = data, - activity_type = activity_type, - ef_metric = ef_metric_label, - start_date = start_date, - end_date = end_date, - min_duration_mins = min_duration_mins - ) + # Check if data provided when ef_df is not + if (missing(data)) stop("Either provide EF data frame from calculate_ef() as first argument, or provide activities_data.") + + ef_df <- calculate_ef( + activities_data = data, + activity_type = activity_type, + ef_metric = ef_metric_label, + start_date = start_date, + end_date = end_date, + min_duration_mins = min_duration_mins + ) } # Check if ef_df is empty or invalid if (!is.data.frame(ef_df) || nrow(ef_df) == 0 || !all(c("date", "ef_value", "activity_type") %in% names(ef_df))) { - warning("No valid EF data available to plot (or missing required columns).") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No EF data available")) + warning("No valid EF data available to plot (or missing required columns).") + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No EF data available")) } # Rename for clarity plot_data <- ef_df - + # --- Check for group variable --- has_groups <- !is.null(group_var) && group_var %in% colnames(plot_data) # --- Plotting --- message("Generating plot...") y_label <- switch(ef_metric_label, - "pace_hr" = "Efficiency Factor (Speed [m/s] / HR)", - "power_hr" = "Efficiency Factor (Power [W] / HR)") + "pace_hr" = "Efficiency Factor (Speed [m/s] / HR)", + "power_hr" = "Efficiency Factor (Power [W] / HR)" + ) if (has_groups) { # Multi-group plotting - p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = .data$date, y = .data$ef_value, - color = .data[[group_var]])) + + p <- ggplot2::ggplot(plot_data, ggplot2::aes( + x = .data$date, y = .data$ef_value, + color = .data[[group_var]] + )) + ggplot2::geom_point(alpha = 0.7, size = 2.5) + ggplot2::scale_x_date(labels = english_month_year, date_breaks = "3 months") - + # Apply custom colors if provided if (!is.null(group_colors)) { p <- p + ggplot2::scale_color_manual(values = group_colors, name = group_var) @@ -131,7 +141,7 @@ plot_ef <- function(data, name = group_var ) } - + p <- p + ggplot2::labs( title = "Efficiency Factor (EF) Trend", @@ -139,12 +149,12 @@ plot_ef <- function(data, x = "Date", y = y_label ) - + if (add_trend_line) { - p <- p + ggplot2::geom_smooth(ggplot2::aes(group = .data[[group_var]]), - method = smoothing_method, se = FALSE, linewidth = 0.8) + p <- p + ggplot2::geom_smooth(ggplot2::aes(group = .data[[group_var]]), + method = smoothing_method, se = FALSE, linewidth = 0.8 + ) } - } else { # Single group plotting (original logic) p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = .data$date, y = .data$ef_value)) + @@ -158,12 +168,12 @@ plot_ef <- function(data, y = y_label, color = "Activity Type" ) - + if (add_trend_line) { p <- p + ggplot2::geom_smooth(method = smoothing_method, se = FALSE, color = "blue", linewidth = 0.8) } } - + p <- p + theme_athlytics() + ggplot2::theme( @@ -176,4 +186,4 @@ plot_ef <- function(data, # Helper for null default (copied from plot_pbs) # `%||%` <- function(x, y) { # if (is.null(x) || length(x) == 0) y else x -# } +# } diff --git a/R/plot_exposure.R b/R/plot_exposure.R index 3f0deaf..0f650c4 100644 --- a/R/plot_exposure.R +++ b/R/plot_exposure.R @@ -37,31 +37,37 @@ #' #' @examples #' # Example using simulated data -#' data(athlytics_sample_exposure) +#' data(sample_exposure) #' # Ensure exposure_df is named and other necessary parameters like activity_type are provided -#' p <- plot_exposure(exposure_df = athlytics_sample_exposure, activity_type = "Run") +#' p <- plot_exposure(exposure_df = sample_exposure, activity_type = "Run") #' print(p) #' #' \dontrun{ #' # Example using local Strava export data #' activities <- load_local_activities("strava_export_data/activities.csv") -#' +#' #' # Plot Exposure trend for Runs (last 6 months) -#' plot_exposure(data = activities, -#' activity_type = "Run", -#' end_date = Sys.Date(), -#' user_ftp = 280) # Example, if load_metric = "tss" +#' plot_exposure( +#' data = activities, +#' activity_type = "Run", +#' end_date = Sys.Date(), +#' user_ftp = 280 +#' ) # Example, if load_metric = "tss" #' #' # Plot Exposure trend for Rides -#' plot_exposure(data = activities, -#' activity_type = "Ride", -#' user_ftp = 280) # Example, provide if load_metric = "tss" +#' plot_exposure( +#' data = activities, +#' activity_type = "Ride", +#' user_ftp = 280 +#' ) # Example, provide if load_metric = "tss" #' #' # Plot Exposure trend for multiple Run types (risk_zones = FALSE for this example) -#' plot_exposure(data = activities, -#' activity_type = c("Run", "VirtualRun"), -#' risk_zones = FALSE, -#' user_ftp = 280) # Example, provide if load_metric = "tss" +#' plot_exposure( +#' data = activities, +#' activity_type = c("Run", "VirtualRun"), +#' risk_zones = FALSE, +#' user_ftp = 280 +#' ) # Example, provide if load_metric = "tss" #' } plot_exposure <- function(data, activity_type = c("Run", "Ride", "VirtualRide", "VirtualRun"), @@ -74,91 +80,94 @@ plot_exposure <- function(data, end_date = NULL, risk_zones = TRUE, exposure_df = NULL) { - - # --- Get Data --- + # --- Get Data --- if (is.null(exposure_df)) { - if (missing(data)) stop("Either 'data' or 'exposure_df' must be provided.") - - exposure_df <- calculate_exposure( - activities_data = data, - activity_type = activity_type, - load_metric = load_metric, - acute_period = acute_period, - chronic_period = chronic_period, - user_ftp = user_ftp, - user_max_hr = user_max_hr, - user_resting_hr = user_resting_hr, - end_date = end_date - ) + if (missing(data)) stop("Either 'data' or 'exposure_df' must be provided.") + + exposure_df <- calculate_exposure( + activities_data = data, + activity_type = activity_type, + load_metric = load_metric, + acute_period = acute_period, + chronic_period = chronic_period, + user_ftp = user_ftp, + user_max_hr = user_max_hr, + user_resting_hr = user_resting_hr, + end_date = end_date + ) } - + if (!is.data.frame(exposure_df) || nrow(exposure_df) == 0 || !all(c("date", "atl", "ctl") %in% names(exposure_df))) { - warning("No valid exposure data available to plot (or missing required columns).") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No exposure data available")) + warning("No valid exposure data available to plot (or missing required columns).") + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No exposure data available")) } - + load_ts <- exposure_df # --- Plotting --- message("Generating plot...") - + plot_end_date <- max(load_ts$date) metric_label <- switch(load_metric, - "duration_mins" = "Duration (mins)", - "distance_km" = "Distance (km)", - "tss" = "TSS", - "hrss" = "HRSS", - "elevation_gain_m" = "Elevation Gain (m)", - load_metric - ) + "duration_mins" = "Duration (mins)", + "distance_km" = "Distance (km)", + "tss" = "TSS", + "hrss" = "HRSS", + "elevation_gain_m" = "Elevation Gain (m)", + load_metric + ) latest_point <- load_ts %>% dplyr::filter(.data$date == plot_end_date) p <- ggplot2::ggplot(load_ts, ggplot2::aes(x = .data$ctl, y = .data$atl)) + - ggplot2::geom_point(ggplot2::aes(color = .data$date), alpha = 0.7, size = 2.5) + + ggplot2::geom_point(ggplot2::aes(color = .data$date), alpha = 0.7, size = 2.5) + ggplot2::scale_color_gradient(low = athlytics_palette_nature()[1], high = athlytics_palette_nature()[5], name = "Date") + - ggplot2::geom_point(data = latest_point, ggplot2::aes(x = .data$ctl, y = .data$atl), color = "#E64B35", size = 5, shape = 17) + + ggplot2::geom_point(data = latest_point, ggplot2::aes(x = .data$ctl, y = .data$atl), color = "#E64B35", size = 5, shape = 17) + ggplot2::labs( title = paste("Training Load Exposure (ATL vs CTL):", metric_label), - subtitle = sprintf("Acute: %d days, Chronic: %d days | End Date: %s", - acute_period, chronic_period, plot_end_date), + subtitle = sprintf( + "Acute: %d days, Chronic: %d days | End Date: %s", + acute_period, chronic_period, plot_end_date + ), x = sprintf("Chronic Training Load (CTL - %d day avg)", chronic_period), y = sprintf("Acute Training Load (ATL - %d day avg)", acute_period), caption = "Data from local Strava export. Red triangle is latest data point." ) + theme_athlytics() + ggplot2::theme( - plot.title = ggplot2::element_text(hjust = 0.5), - plot.subtitle = ggplot2::element_text(hjust = 0.5), - legend.position = "right" + plot.title = ggplot2::element_text(hjust = 0.5), + plot.subtitle = ggplot2::element_text(hjust = 0.5), + legend.position = "right" ) if (risk_zones) { - if (!"acwr" %in% colnames(load_ts)) { - warning("ACWR column not found in calculated data. Cannot add risk zones.") - } else { - sweet_spot_lower <- 0.8 - sweet_spot_upper <- 1.3 - danger_zone_upper <- 1.5 - - max_ctl_limit <- max(0, load_ts$ctl, na.rm = TRUE) * 1.1 - max_atl_limit <- max(0, load_ts$atl, na.rm = TRUE) * 1.1 - - if (max_ctl_limit == 0) max_ctl_limit <- 1 - if (max_atl_limit == 0) max_atl_limit <- 1 - - p <- p + - ggplot2::geom_abline(intercept = 0, slope = sweet_spot_lower, linetype="dotted", color="blue") + - ggplot2::geom_abline(intercept = 0, slope = sweet_spot_upper, linetype="dotted", color="orange") + - ggplot2::geom_abline(intercept = 0, slope = danger_zone_upper, linetype="dotted", color="red") + - ggplot2::coord_cartesian(xlim = c(0, max_ctl_limit), ylim = c(0, max_atl_limit), expand = FALSE) - - p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.05, y = max_atl_limit * 0.95, label = sprintf("High Risk (>%.1f)", danger_zone_upper), hjust = 0, vjust = 1, color = "red", size = 3, alpha=0.8) - p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.2, y = max_atl_limit * 0.7, label = sprintf("Caution (%.1f-%.1f)", sweet_spot_upper, danger_zone_upper), hjust = 0, vjust = 1, color = "orange", size = 3, alpha=0.8) - p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.5, y = max_atl_limit * 0.5, label = sprintf("Sweet Spot (%.1f-%.1f)", sweet_spot_lower, sweet_spot_upper), hjust = 0, vjust = 1, color = "darkgreen", size = 3, alpha=0.8) - p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.7, y = max_atl_limit * 0.2, label = sprintf("Low Load (<%.1f)", sweet_spot_lower), hjust = 0, vjust = 0, color = "blue", size = 3, alpha=0.8) - } + if (!"acwr" %in% colnames(load_ts)) { + warning("ACWR column not found in calculated data. Cannot add risk zones.") + } else { + sweet_spot_lower <- 0.8 + sweet_spot_upper <- 1.3 + danger_zone_upper <- 1.5 + + max_ctl_limit <- max(0, load_ts$ctl, na.rm = TRUE) * 1.1 + max_atl_limit <- max(0, load_ts$atl, na.rm = TRUE) * 1.1 + + if (max_ctl_limit == 0) max_ctl_limit <- 1 + if (max_atl_limit == 0) max_atl_limit <- 1 + + p <- p + + ggplot2::geom_abline(intercept = 0, slope = sweet_spot_lower, linetype = "dotted", color = "blue") + + ggplot2::geom_abline(intercept = 0, slope = sweet_spot_upper, linetype = "dotted", color = "orange") + + ggplot2::geom_abline(intercept = 0, slope = danger_zone_upper, linetype = "dotted", color = "red") + + ggplot2::coord_cartesian(xlim = c(0, max_ctl_limit), ylim = c(0, max_atl_limit), expand = FALSE) + + p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.05, y = max_atl_limit * 0.95, label = sprintf("High Risk (>%.1f)", danger_zone_upper), hjust = 0, vjust = 1, color = "red", size = 3, alpha = 0.8) + p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.2, y = max_atl_limit * 0.7, label = sprintf("Caution (%.1f-%.1f)", sweet_spot_upper, danger_zone_upper), hjust = 0, vjust = 1, color = "orange", size = 3, alpha = 0.8) + p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.5, y = max_atl_limit * 0.5, label = sprintf("Sweet Spot (%.1f-%.1f)", sweet_spot_lower, sweet_spot_upper), hjust = 0, vjust = 1, color = "darkgreen", size = 3, alpha = 0.8) + p <- p + ggplot2::annotate("text", x = max_ctl_limit * 0.7, y = max_atl_limit * 0.2, label = sprintf("Low Load (<%.1f)", sweet_spot_lower), hjust = 0, vjust = 0, color = "blue", size = 3, alpha = 0.8) + } } return(p) @@ -167,4 +176,4 @@ plot_exposure <- function(data, # Helper for null default (from purrr example) - avoids direct dependency if only used here # `%||%` <- function(x, y) { # if (is.null(x) || length(x) == 0) y else x -# } \ No newline at end of file +# } diff --git a/R/plot_pbs.R b/R/plot_pbs.R index ad923dd..2c4c479 100644 --- a/R/plot_pbs.R +++ b/R/plot_pbs.R @@ -35,44 +35,54 @@ #' @examples #' # Example using the built-in sample data #' # This data now contains a simulated history of performance improvements -#' data("athlytics_sample_pbs", package = "Athlytics") -#' -#' if (!is.null(athlytics_sample_pbs) && nrow(athlytics_sample_pbs) > 0) { +#' data("sample_pbs", package = "Athlytics") +#' +#' if (!is.null(sample_pbs) && nrow(sample_pbs) > 0) { #' # Plot PBs using the package sample data directly -#' p <- plot_pbs(pbs_df = athlytics_sample_pbs, activity_type = "Run") +#' p <- plot_pbs(pbs_df = sample_pbs, activity_type = "Run") #' print(p) #' } -#' +#' #' if (FALSE) { -#' # Example using local Strava export data -#' activities <- load_local_activities("strava_export_data/activities.csv") -#' -#' # Plot PBS trend for Runs (last 6 months) -#' pb_data_run <- calculate_pbs(activities_data = activities, -#' activity_type = "Run", -#' distance_meters = c(1000,5000,10000), -#' date_range = c(format(Sys.Date() - months(6)), -#' format(Sys.Date()))) -#' if(nrow(pb_data_run) > 0) { -#' plot_pbs(pbs_df = pb_data_run, distance_meters = c(1000,5000,10000)) -#' } -#' -#' # Plot PBS trend for Rides (if applicable, though PBs are mainly for Runs) -#' pb_data_ride <- calculate_pbs(activities_data = activities, -#' activity_type = "Ride", -#' distance_meters = c(10000, 20000)) -#' if(nrow(pb_data_ride) > 0) { -#' plot_pbs(pbs_df = pb_data_ride, distance_meters = c(10000, 20000)) -#' } -#' -#' # Plot PBS trend for multiple Run types (no trend line) -#' pb_data_multi <- calculate_pbs(activities_data = activities, -#' activity_type = c("Run", "VirtualRun"), -#' distance_meters = c(1000,5000)) -#' if(nrow(pb_data_multi) > 0) { -#' plot_pbs(pbs_df = pb_data_multi, distance_meters = c(1000,5000), -#' add_trend_line = FALSE) -#' } +#' # Example using local Strava export data +#' activities <- load_local_activities("strava_export_data/activities.csv") +#' +#' # Plot PBS trend for Runs (last 6 months) +#' pb_data_run <- calculate_pbs( +#' activities_data = activities, +#' activity_type = "Run", +#' distance_meters = c(1000, 5000, 10000), +#' date_range = c( +#' format(Sys.Date() - months(6)), +#' format(Sys.Date()) +#' ) +#' ) +#' if (nrow(pb_data_run) > 0) { +#' plot_pbs(pbs_df = pb_data_run, distance_meters = c(1000, 5000, 10000)) +#' } +#' +#' # Plot PBS trend for Rides (if applicable, though PBs are mainly for Runs) +#' pb_data_ride <- calculate_pbs( +#' activities_data = activities, +#' activity_type = "Ride", +#' distance_meters = c(10000, 20000) +#' ) +#' if (nrow(pb_data_ride) > 0) { +#' plot_pbs(pbs_df = pb_data_ride, distance_meters = c(10000, 20000)) +#' } +#' +#' # Plot PBS trend for multiple Run types (no trend line) +#' pb_data_multi <- calculate_pbs( +#' activities_data = activities, +#' activity_type = c("Run", "VirtualRun"), +#' distance_meters = c(1000, 5000) +#' ) +#' if (nrow(pb_data_multi) > 0) { +#' plot_pbs( +#' pbs_df = pb_data_multi, distance_meters = c(1000, 5000), +#' add_trend_line = FALSE +#' ) +#' } #' } #' #' @importFrom dplyr filter select mutate arrange group_by slice bind_rows summarise distinct rename %>% left_join @@ -91,44 +101,47 @@ plot_pbs <- function(data, date_range = NULL, add_trend_line = TRUE, pbs_df = NULL) { - # --- Get Data --- if (is.null(pbs_df)) { - if (missing(data)) stop("Either 'data' or 'pbs_df' must be provided.") - if (missing(distance_meters)) stop("`distance_meters` must be provided when `pbs_df` is not.") - - pbs_df <- calculate_pbs( - activities_data = data, - activity_type = activity_type, - start_date = if (!is.null(date_range)) date_range[1] else NULL, - end_date = if (!is.null(date_range)) date_range[2] else NULL, - distances_m = distance_meters - ) + if (missing(data)) stop("Either 'data' or 'pbs_df' must be provided.") + if (missing(distance_meters)) stop("`distance_meters` must be provided when `pbs_df` is not.") + + pbs_df <- calculate_pbs( + activities_data = data, + activity_type = activity_type, + start_date = if (!is.null(date_range)) date_range[1] else NULL, + end_date = if (!is.null(date_range)) date_range[2] else NULL, + distances_m = distance_meters + ) } - + if (!is.data.frame(pbs_df) || nrow(pbs_df) == 0) { - warning("No PB data available to plot.") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No PB data available")) + warning("No PB data available to plot.") + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No PB data available")) } - + # Ensure distance_meters used for filtering/plotting are derived from pbs_df if it was passed directly # Or ensure they are consistent if pbs_df was calculated - if(!missing(distance_meters) && !is.null(pbs_df)){ - pbs_df <- pbs_df[pbs_df$distance %in% distance_meters,] - if(nrow(pbs_df) == 0){ + if (!missing(distance_meters) && !is.null(pbs_df)) { + pbs_df <- pbs_df[pbs_df$distance %in% distance_meters, ] + if (nrow(pbs_df) == 0) { warning("pbs_df does not contain data for the specified distance_meters after filtering.") - return(ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::ggtitle("No PB data for specified distances")) + return(ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::ggtitle("No PB data for specified distances")) } - } else if (is.null(pbs_df) && missing(distance_meters)){ - stop("If pbs_df is not provided, distance_meters must be specified for calculate_pbs call.") + } else if (is.null(pbs_df) && missing(distance_meters)) { + stop("If pbs_df is not provided, distance_meters must be specified for calculate_pbs call.") } # --- Plotting --- message("Generating plot...") - + # Ensure activity_date is Date type pbs_df$activity_date <- as.Date(pbs_df$activity_date) - + # Create distance_label if it doesn't exist if (!"distance_label" %in% names(pbs_df)) { pbs_df$distance_label <- dplyr::case_when( @@ -139,10 +152,11 @@ plot_pbs <- function(data, pbs_df$distance == 42195 ~ "Marathon", TRUE ~ paste0(round(pbs_df$distance), "m") ) - pbs_df$distance_label <- factor(pbs_df$distance_label, - levels = c("1k", "5k", "10k", "Half Marathon", "Marathon")) + pbs_df$distance_label <- factor(pbs_df$distance_label, + levels = c("1k", "5k", "10k", "Half Marathon", "Marathon") + ) } - + # Ensure required columns exist if (!"time_seconds" %in% names(pbs_df)) { if ("elapsed_time" %in% names(pbs_df)) { @@ -151,7 +165,7 @@ plot_pbs <- function(data, stop("pbs_df must contain either 'time_seconds' or 'elapsed_time' column") } } - + if (!"is_pb" %in% names(pbs_df)) { if ("is_new_pb" %in% names(pbs_df)) { pbs_df$is_pb <- pbs_df$is_new_pb @@ -159,30 +173,36 @@ plot_pbs <- function(data, pbs_df$is_pb <- TRUE } } - + # Sort by distance_label and date for proper line drawing pbs_df <- pbs_df[order(pbs_df$distance_label, pbs_df$activity_date), ] # Create the base plot with Athlytics theme - p <- ggplot2::ggplot(pbs_df, ggplot2::aes(x = .data$activity_date, y = .data$time_seconds, - color = .data$distance_label, group = .data$distance_label)) + - ggplot2::geom_line(linewidth = 1.8, alpha = 0.85) + - ggplot2::geom_point(ggplot2::aes(shape = .data$is_pb), size = 4.5, alpha = 0.95, stroke = 1.2) + - ggplot2::scale_shape_manual(values = c("TRUE" = 19, "FALSE" = 21), - name = "Personal Best", labels = c("TRUE" = "Yes", "FALSE" = "No")) + + p <- ggplot2::ggplot(pbs_df, ggplot2::aes( + x = .data$activity_date, y = .data$time_seconds, + color = .data$distance_label, group = .data$distance_label + )) + + ggplot2::geom_line(linewidth = 1.8, alpha = 0.85) + + ggplot2::geom_point(ggplot2::aes(shape = .data$is_pb), size = 4.5, alpha = 0.95, stroke = 1.2) + + ggplot2::scale_shape_manual( + values = c("TRUE" = 19, "FALSE" = 21), + name = "Personal Best", labels = c("TRUE" = "Yes", "FALSE" = "No") + ) + ggplot2::scale_x_date( - date_breaks = "2 months", + date_breaks = "2 months", labels = function(x) { - months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") + months <- c( + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" + ) paste(months[as.integer(format(x, "%m"))], format(x, "%Y")) } ) + ggplot2::scale_y_continuous( - labels = function(x) sprintf('%02d:%02d', floor(x/60), x %% 60), + labels = function(x) sprintf("%02d:%02d", floor(x / 60), x %% 60), breaks = scales::pretty_breaks(n = 2) - ) + - ggplot2::scale_color_manual(values = athlytics_palette_vibrant(), name = "Distance") + + ) + + ggplot2::scale_color_manual(values = athlytics_palette_vibrant(), name = "Distance") + ggplot2::labs( title = "Personal Best Running Times Trend", subtitle = "Showing best efforts for specified distances over time", @@ -202,8 +222,10 @@ plot_pbs <- function(data, if (add_trend_line) { # Use linear model (lm) instead of loess to avoid errors with sparse data # and to better represent the overall improvement trend - p <- p + ggplot2::geom_smooth(method = "lm", se = TRUE, aes(group = .data$distance_label), - linewidth = 1.0, alpha = 0.15, linetype = "dashed") + p <- p + ggplot2::geom_smooth( + method = "lm", se = TRUE, aes(group = .data$distance_label), + linewidth = 1.0, alpha = 0.15, linetype = "dashed" + ) } if (length(unique(pbs_df$distance_label)) > 1) { @@ -216,4 +238,4 @@ plot_pbs <- function(data, return(p) } -# Helper for null default (from purrr example) - avoids direct dependency if only used here \ No newline at end of file +# Helper for null default (from purrr example) - avoids direct dependency if only used here diff --git a/R/utils.R b/R/utils.R index 2fc3cc0..12634fa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,9 +2,11 @@ # Internal helper function for English month-year labels english_month_year <- function(dates) { - months_en <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") + months_en <- c( + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" + ) paste(months_en[lubridate::month(dates)], lubridate::year(dates)) } -# Add other internal utility functions here in the future if needed \ No newline at end of file +# Add other internal utility functions here in the future if needed diff --git a/R/zzz.R b/R/zzz.R index f5d0282..2ab1d34 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,18 +1,3 @@ # R/zzz.R -.onAttach <- function(libname, pkgname) { - - pkg_desc <- utils::packageDescription(pkgname) - pkg_version <- pkg_desc$Version - - startup_msg <- paste0( - "\nLoading Athlytics version ", pkg_version, ".\n", - "Analyze your Strava data locally with ease!\n", - "Use load_local_activities() to get started.\n", - "For documentation, see: https://hzacode.github.io/Athlytics/" - ) - - - packageStartupMessage(startup_msg) -} - +NULL diff --git a/README.md b/README.md index 773ef87..8f1e780 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ # Athlytics [![CRAN Status](https://img.shields.io/badge/CRAN-Accepted-blue?style=flat-square)](https://cran.r-project.org/package=Athlytics) -[![CRAN Listed](https://img.shields.io/badge/CRAN%20Listed-Sports%20Analytics-orange?style=flat-square)](https://cran.r-project.org/web/views/SportsAnalytics.html) +[![CRAN Listed](https://img.shields.io/badge/CRAN%20Listed-Sports%20Analytics-orange?style=flat-square)](https://CRAN.R-project.org/view=SportsAnalytics) [![CRAN Downloads](https://cranlogs.r-pkg.org/badges/grand-total/Athlytics?style=flat-square)](https://cran.r-project.org/package=Athlytics) [![R-CMD-check](https://img.shields.io/github/actions/workflow/status/HzaCode/Athlytics/R-CMD-check.yml?style=flat-square&label=R-CMD-check)](https://github.com/HzaCode/Athlytics/actions/workflows/R-CMD-check.yml) [![Documentation](https://img.shields.io/badge/docs-passing-brightgreen?style=flat-square)](https://hezhiang.com/Athlytics/) @@ -18,7 +18,9 @@ ## Overview -**Athlytics** is a research-oriented R package for the longitudinal analysis of endurance training. It operates entirely on **local Strava exports** (or FIT/TCX/GPX files), avoiding API dependencies to ensure **privacy** and long-term **reproducibility**. +**Athlytics** is a research-oriented R package for the longitudinal analysis of endurance training. It operates entirely on **local [Strava](https://www.strava.com/) exports** (or FIT/TCX/GPX files), avoiding API dependencies to ensure **privacy** and long-term **reproducibility**. + +> **What is Strava?** [Strava](https://www.strava.com/) is a popular fitness tracking platform used by millions of athletes worldwide to record and analyze their running, cycling, and other endurance activities. Users can export their complete activity history for offline analysis. The package standardizes the workflow from data ingestion and quality control to model estimation and uncertainty quantification. Implemented endpoints include **acute-to-chronic workload ratio (ACWR)**, **aerobic efficiency (EF)**, and **cardiovascular decoupling (pa:hr)**, alongside personal-best and exposure profiles suitable for **single-subject** and **cohort** designs. All functions return tidy data, facilitating statistical modeling and figure generation for academic reporting. @@ -65,7 +67,7 @@ remotes::install_github("HzaCode/Athlytics") ### 📥 Step 1: Export Your Strava Data -1. Navigate to **[Strava Settings - My Account](https://www.strava.com/settings/profile)**. +1. Navigate to **[Strava](https://www.strava.com/)** and open Settings → My Account. 2. Under "Download or Delete Your Account," click **"Get Started"** and then **"Request Your Archive"**. 3. You'll receive an email with a download link - this may take some time. 4. Download the ZIP file (e.g., `export_12345678.zip`). **There is no need to unzip it.** @@ -90,7 +92,7 @@ cohort_acwr <- cohort_data %>% ungroup() # 3. Generate percentile bands to serve as a reference for the cohort -reference_bands <- cohort_reference(cohort_acwr, metric = "acwr_smooth") +reference_bands <- calculate_cohort_reference(cohort_acwr, metric = "acwr_smooth") # 4. Plot an individual's data against the cohort reference bands individual_acwr <- cohort_acwr %>% filter(athlete_id == "A1") diff --git a/data-raw/generate_sample_acwr.R b/data-raw/generate_sample_acwr.R new file mode 100644 index 0000000..50fcc71 --- /dev/null +++ b/data-raw/generate_sample_acwr.R @@ -0,0 +1,59 @@ +# Script to generate sample_acwr data +# This script creates a simulated ACWR dataset for package examples and testing + +library(dplyr) +library(tibble) + +set.seed(123) + +# Generate 365 days of data +n_days <- 365 +start_date <- as.Date("2023-01-01") +dates <- seq(start_date, by = "day", length.out = n_days) + +# Simulate daily training load with weekly periodization +# Higher loads on weekdays, rest on some weekends +day_of_week <- as.POSIXlt(dates)$wday +base_load <- ifelse(day_of_week %in% c(0, 6), + runif(n_days, 0, 30), # Weekend: lower/rest + runif(n_days, 40, 90) +) # Weekday: training + +# Add some seasonal variation (higher in spring/summer) +day_of_year <- as.numeric(format(dates, "%j")) +seasonal_factor <- 1 + 0.2 * sin(2 * pi * (day_of_year - 80) / 365) +daily_load <- base_load * seasonal_factor + +# Add some random rest days (illness, travel, etc.) +rest_days <- sample(1:n_days, size = 30) +daily_load[rest_days] <- 0 + +# Calculate rolling averages for ATL and CTL +acute_window <- 7 +chronic_window <- 28 + +atl <- zoo::rollmean(daily_load, k = acute_window, fill = NA, align = "right") +ctl <- zoo::rollmean(daily_load, k = chronic_window, fill = NA, align = "right") + +# Calculate ACWR (with protection against division by zero) +acwr <- ifelse(ctl > 0, atl / ctl, NA) + +# Apply smoothing to ACWR +acwr_smooth <- zoo::rollmean(acwr, k = 7, fill = NA, align = "right") + +# Create the dataset +sample_acwr <- tibble( + date = dates, + atl = round(atl, 2), + ctl = round(ctl, 2), + acwr = round(acwr, 3), + acwr_smooth = round(acwr_smooth, 3) +) + +# Remove rows with NA values (first few weeks) +sample_acwr <- sample_acwr[complete.cases(sample_acwr), ] + +# Save to data directory +save(sample_acwr, file = "data/sample_acwr.rda", compress = "xz") + +message("sample_acwr.rda generated with ", nrow(sample_acwr), " rows.") diff --git a/data-raw/generate_sample_decoupling.R b/data-raw/generate_sample_decoupling.R new file mode 100644 index 0000000..a3a1dda --- /dev/null +++ b/data-raw/generate_sample_decoupling.R @@ -0,0 +1,46 @@ +# Script to generate sample_decoupling data +# This script creates a simulated decoupling dataset for package examples and testing + +library(dplyr) +library(tibble) + +set.seed(456) + +# Generate ~1 year of data (not every day has a qualifying workout) +n_workouts <- 52 # Approximately weekly long runs +start_date <- as.Date("2023-01-01") + +# Generate workout dates (roughly weekly with some variation) +workout_intervals <- round(rnorm(n_workouts, mean = 7, sd = 1.5)) +workout_intervals[workout_intervals < 4] <- 4 # Minimum 4 days between +dates <- cumsum(c(0, workout_intervals[-n_workouts])) +dates <- start_date + dates + +# Simulate decoupling values +# Good aerobic fitness: <5% decoupling +# Moderate: 5-10% +# Poor: >10% + +# Simulate improving fitness over the year (decoupling decreasing) +base_decoupling <- seq(12, 4, length.out = n_workouts) +noise <- rnorm(n_workouts, mean = 0, sd = 2) +decoupling <- base_decoupling + noise + +# Add some outliers (heat, illness, etc.) +outlier_idx <- sample(1:n_workouts, size = 5) +decoupling[outlier_idx] <- decoupling[outlier_idx] + runif(5, 5, 10) + +# Ensure values are reasonable +decoupling <- pmax(decoupling, -2) # Can be slightly negative (rare) +decoupling <- pmin(decoupling, 25) # Cap at 25% + +# Create the dataset +sample_decoupling <- tibble( + date = dates, + decoupling = round(decoupling, 2) +) + +# Save to data directory +save(sample_decoupling, file = "data/sample_decoupling.rda", compress = "xz") + +message("sample_decoupling.rda generated with ", nrow(sample_decoupling), " rows.") diff --git a/data-raw/generate_sample_ef.R b/data-raw/generate_sample_ef.R new file mode 100644 index 0000000..a6b66e2 --- /dev/null +++ b/data-raw/generate_sample_ef.R @@ -0,0 +1,52 @@ +# Script to generate sample_ef data +# This script creates a simulated Efficiency Factor dataset for package examples and testing + +library(dplyr) +library(tibble) + +set.seed(789) + +# Generate EF data for runs and rides +n_runs <- 30 +n_rides <- 20 + +start_date <- as.Date("2023-01-01") + +# Generate run dates (2-3 times per week) +run_intervals <- round(runif(n_runs, 2, 4)) +run_dates <- start_date + cumsum(c(0, run_intervals[-n_runs])) + +# Generate ride dates (1-2 times per week) +ride_intervals <- round(runif(n_rides, 4, 8)) +ride_dates <- start_date + cumsum(c(0, ride_intervals[-n_rides])) + +# Simulate EF values +# Running EF typically ranges from 1.0 to 2.0 (pace per HR) +# Improving fitness shows increasing EF over time +run_base_ef <- seq(1.2, 1.6, length.out = n_runs) +run_ef <- run_base_ef + rnorm(n_runs, 0, 0.08) + +# Cycling EF (power per HR) - different scale +ride_base_ef <- seq(1.8, 2.3, length.out = n_rides) +ride_ef <- ride_base_ef + rnorm(n_rides, 0, 0.1) + +# Create the dataset +sample_ef <- bind_rows( + tibble( + date = run_dates, + activity_type = "Run", + ef_value = round(run_ef, 3) + ), + tibble( + date = ride_dates, + activity_type = "Ride", + ef_value = round(ride_ef, 3) + ) +) %>% + arrange(date) + +# Save to data directory +save(sample_ef, file = "data/sample_ef.rda", compress = "xz") + +message("sample_ef.rda generated with ", nrow(sample_ef), " rows.") +print(table(sample_ef$activity_type)) diff --git a/data-raw/generate_sample_exposure.R b/data-raw/generate_sample_exposure.R new file mode 100644 index 0000000..37509e1 --- /dev/null +++ b/data-raw/generate_sample_exposure.R @@ -0,0 +1,59 @@ +# Script to generate sample_exposure data +# This script creates a simulated training exposure dataset for package examples and testing + +library(dplyr) +library(tibble) + +set.seed(321) + +# Generate 365 days of data +n_days <- 365 +start_date <- as.Date("2023-01-01") +dates <- seq(start_date, by = "day", length.out = n_days) + +# Simulate daily training load (duration in minutes) +day_of_week <- as.POSIXlt(dates)$wday + +# Training pattern: Mon/Wed/Fri = moderate, Tue/Thu = easy, Sat = long, Sun = rest +daily_load <- case_when( + day_of_week == 0 ~ runif(n_days, 0, 20), # Sunday: rest/easy + day_of_week == 1 ~ runif(n_days, 45, 75), # Monday: moderate + day_of_week == 2 ~ runif(n_days, 30, 50), # Tuesday: easy + day_of_week == 3 ~ runif(n_days, 50, 80), # Wednesday: moderate + day_of_week == 4 ~ runif(n_days, 30, 50), # Thursday: easy + day_of_week == 5 ~ runif(n_days, 45, 70), # Friday: moderate + day_of_week == 6 ~ runif(n_days, 80, 150), # Saturday: long run + TRUE ~ 0 +) + +# Add some complete rest days +rest_days <- sample(1:n_days, size = 40) +daily_load[rest_days] <- 0 + +# Add seasonal build-up (increasing towards spring/summer) +day_of_year <- as.numeric(format(dates, "%j")) +seasonal_factor <- 0.8 + 0.4 * sin(2 * pi * (day_of_year - 60) / 365) +daily_load <- daily_load * seasonal_factor + +# Calculate rolling metrics +acute_window <- 7 +chronic_window <- 28 + +atl <- zoo::rollmean(daily_load, k = acute_window, fill = NA, align = "right") +ctl <- zoo::rollmean(daily_load, k = chronic_window, fill = NA, align = "right") +acwr <- ifelse(ctl > 0, atl / ctl, NA) + +# Create the dataset +sample_exposure <- tibble( + date = dates, + daily_load = round(daily_load, 1), + ctl = round(ctl, 2), + atl = round(atl, 2), + acwr = round(acwr, 3) +) + +# Keep all rows (NAs are expected for early dates) +# Save to data directory +save(sample_exposure, file = "data/sample_exposure.rda", compress = "xz") + +message("sample_exposure.rda generated with ", nrow(sample_exposure), " rows.") diff --git a/data-raw/generate_sample_pbs.R b/data-raw/generate_sample_pbs.R index bb68c5b..05cb452 100644 --- a/data-raw/generate_sample_pbs.R +++ b/data-raw/generate_sample_pbs.R @@ -1,5 +1,4 @@ - -# Script to regenerate athlytics_sample_pbs data +# Script to regenerate sample_pbs data library(dplyr) library(lubridate) library(Athlytics) # Assumes current version is loaded @@ -56,7 +55,7 @@ all_data <- rbind(df_1k, df_5k, df_10k) %>% ) # Calculate cumulative PBs and is_pb flag -athlytics_sample_pbs <- all_data %>% +sample_pbs <- all_data %>% group_by(distance) %>% arrange(activity_date) %>% mutate( @@ -73,11 +72,11 @@ athlytics_sample_pbs <- all_data %>% ) # Convert to tibble for consistency -athlytics_sample_pbs <- as_tibble(athlytics_sample_pbs) +sample_pbs <- as_tibble(sample_pbs) # Save to data directory -save(athlytics_sample_pbs, file = "data/athlytics_sample_pbs.rda", compress = "xz") +save(sample_pbs, file = "data/sample_pbs.rda", compress = "xz") -message("athlytics_sample_pbs.rda regenerated with ", nrow(athlytics_sample_pbs), " rows.") -print(table(athlytics_sample_pbs$distance_label)) -print(table(athlytics_sample_pbs$is_pb)) +message("sample_pbs.rda regenerated with ", nrow(sample_pbs), " rows.") +print(table(sample_pbs$distance_label)) +print(table(sample_pbs$is_pb)) diff --git a/data/athlytics_sample_acwr.rda b/data/athlytics_sample_acwr.rda deleted file mode 100644 index 020c57cfa2c9e5900194692713dd2f3577871561..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 24928 zcmV(xKvQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&q6Gu8x7u?P0@;5q6h&N;GK{%YOJoSR|AS?b8Ej zS_7rb8-BN@4%qS(*1UWtbQ-u!5e*?W7mD7+a#ol*>jpk>QysKIpB>`mAkd&U>u-)8cB}Q`U6sC!uPE zIMtf^Mx6f^-Ye+=&yF2cXlpoUDGIvdCxk+#nkfV5f+6o+s^#(~0RkY?wYy+f48J51 z>&HAUM4%l5Gl9X~!_Z{lo5UYz_2gd_d*_i@(Dv4p(#Oq8{GiCWG5oWoZ3>6IMp^vc=-dMcp#(|z$gcGGnC zx}AhmvvJSY2u^USQFSL#nQ7W7C9j$mZ@+bQ@V39&8CREyK8y-0BjFP^$qouk?H*2F z;$1S5P(?3NM}qFIXhMB(NcPOB#!5NS-`aEdeF?3nIXqSfg3HwXqOl!b$1t-%LlkET zUnFp6N=@3r9BiixH1nKEzip(4TCSRfM)Qb*QIb@nJgW!Ym@VxA`T!BKS^XKf5cc4m zejBd|Ni}S7ovAe`4cH2r?c%GL*TOc}-WqzT7&soz1oUKM0*MpaV5otf3RA!S5f?+H z&vS7g9CupEqNcdWwQEhLx2YqL$lkUX;8gh3l;i&pq@Rir03KlfY>|~J*jNE_uoUco zasom567P!cG4cI(!YYGt`eyG{l&Sye?t0N6!pVu%j8Dp8;5dQ63}B7QO+k2;a(&~q zB{IHAHDdle_~Rj(UbTcUwFXqYTv%= zz~wVs+M%^Vfq0n%{3NiF(?J8k^yG`=K5-gp%a*&8xlkluJmN&|r=>;FsG!UrYJ7t$ z4aP{-X)}C9mbKou;c5TZo#!r`5>*4Vf1WCG*M*|YaUV+(8$|KKlavl#&wEDvER|Md z+~%&&W}n~y&0*oMacuu(S*i#EL6v1)lnr z85WejAwyx+70^zmIOu02L&5@weIyI#()pMY!&(hbrJ-=n03k5mE_fVd4L$ zWB>415l;iNAl{0Eyb1Czs*E7q*pnBr9Lx0v91bL$gu-^;S5G_(<=6n-xmYnfd!ZJo z<>MQWy#3=-c`!>yCD{>+t>bNr8G|?0Z#n|aEU+f*a&iolz~M;d5Jh(BL#`=nKGkl# zn@w>;14BB0RHG}2FB}In!$iejhoDkvn2*GkCmIS$_RMFT3vCGG(4Rk;Fn2XXB@7@1 zw>fTJ1dOxzQX5j6EsjO5jXWnyHulFbMQOc3k$MW>UPU%n@-Xs?s81lkp1f>$pysz zV4;2R@GT6J-(gp|iFik81%lHMpg#Ua`j=Z+YDC=@FFS44TU2a=>nTBdBC|>!WjZtY zih#gB0(Q{Q*#UQFPvKwge!+{pWlJfL-oYa5Cz8`y6=SdjALXIR8rr*=&9DesJ#rA( zQU9p#(&N22Qh%!t>s47i={mt+FWNuxSklu;c3mw;%Go-i(1!KH0PF4BZz9NXi5_*C z;EX2JZFnlH6iP=KSJxR)k5ECP4))T-oUQW2oT!5BNtT?hksgqJI#l-4^LK%GV{fQz ziDl!lv_?OrhZ6zN5GbktA7^Whtt1H~G{ErL_B<~hM6CmgpkX!YSN4WB3^oTk3+){aP43|m^^%5GF8vwoHW37LlIMU{61=(x(o&%xO8fVn z5CCwfp-IE>B-FA?f$n6@rBGLszacPpo*AY%?{O$R=J&-h5XseR0Wyw+-KneT;DO`+ ztx`q{njH9z?2Z?ZH5z)KLRS#3WB!*NTZum{@(O|RYUj{5tgPcs`gqOK*U9U{VDG7N zg;3FN1lVsvNrQmKo;tE=8Eu*k_>^8*`2!cpvX>oLm3d8S2|#JLZ3;ZYmhyUt+n(wb z4haT=dJ{M3I5$f3w}#P9eNvxR2b`=UE4Jl;pFOYurnw!7F}yA8ombmLK3geQdL8$$ zSEw<{IF8{DaXUdo96DmjEO$Md0Wt{#{#=Bj29>h7?I)-AHh&%014zI(oK%+yikfqd zYh}*zd<}WE2Tp0PJh9;vsR}m@yYh)-w(8sYY&Wdh#3!u4c8Lt$g~ut2VDCVWv-lRc~xZ$!0WAH_L2b)9=3vzg6*uL>+^qqud3 zmYI(AStqs(W~ad@*Ks)!+b?SeZgCPc7X#jU|Cyy~*fJ#im`5UsCZVQvc4W zE1DTr)o#yWg+FN|1-?gQ;SJx&tfHW?(CC=SI>RY4dLS5ngU=eLkQOW)rLWOMIHB@X zh==Ow?@_g?!uI>4=6;3jl9c)0gylTjJAZttn_Ul^Pk=BGLUiYcyRe2rRv;W>pM^ign2`zK zI}~;()f)9Rx;=kiQRh9{j$d@QUIy5K6VY>WnqDtsx{4zJmN3`xHgYP{lnZEucv+v3 zO9dwojuCtm70NDvWftLKfW?4>Z0_k<=*^kV5|)f_RWJH2Aa1Wa8cXOHZ3(J&Jw5xE znA|Xx;RcWwu*FM=-#de8L^g&$n_U1`b+AHi>j;*V)$&o!8HC9A$ap`hc);%uL>L_( zy;3GW4V6pJdOnuLB$WFpxJUC?*Q}@(FJkvQbtat zgI(*y5R@t_Mmx=NnIK(Qu|tu1A4TX)P4H7wkb52d*b4PRI}9r2 z6-31$>wBzcjHs95SSo5JQdHZcGQXMTTu~PRW@WM~qSM1@H#x&R_0)CjL_K2Cj_cFs zK_xq}go5W=+IY1Dc0dW);|z_359iCt#Xx#%hx-uV7ohva z873UE9}1LiVS`9PTO2L2>kk&`sqj@|u7Tt06e zkW~Gdj6W@U7x;MjxNRt;0?{for&rlkI+4FMFe?Pm(_+;eSxeUU3>I2Y6cdg#Ht#L| z?Z`6nA=Wa>Y(_`h48JN~@+#ICRqI;2nItA`#fa^h`E{ayntf_-K+7sOj2qd7zkF!% z92b9ZQO7c>m&@3WRWu`|B0Y|Vy?IXOv+hs4IuX=5pX={s&2#hI^^xHkE-dy*GdjD+I&*W0&d&%+a19KSL_Ywd(l_xQGlc$#9seO&Zb zTTD_FSbWL)Y7=d6zl`V_L%;Ctl@7owS3bh6=|i;?dFz7v{T^KbOPt4OYTx&J&O82jEK2$#L6yw%8m zeODIOHKlybNm>ASrve6DJ}W>cA7^-fuf`}LOZ$>nE~rn@Xl*4s)NN878%9G{Dm>;- zv^?iSEYx<%@uRRZD=IIAduV5vcU-0*q??*lq!E5UqZ^4Z_j&^lVneQ$rb2Z4(aES! zyY{|Hl!K@Jq?{u$vpBdr9t%J`wM0Vc(`2628gh`K7A9fQGd@-sefF)+s|xJB@HUY> zCI2cvA1xUBMtLgh;y#_&(L4-GVbt2x&#hbJamUWuAA+|+W5sG77dWJCq$Z`59wwn9 z&^zP{CvmYnIlAgk2?y*4P@vs#(oFLS?>M6VN7!Sug?QZp>t%w zC({byJQ{bL=s8n4JQ$W6APS$KpZN5_g3`v!PeQUu%Seq|(@mGwLO#5|{ocq7d@x#9 z4k}mhAILfQ*&V6=x<}2X532}0gnP@;pZ%Q9ls|pv(WGjb-1mvx&G4i#EnEuxC#U{Q zAUi#z$F1xsMC!i%mMzlT9eQMNuQ1AKbQSZ8Y7hjrCD!ob(99J6mm*S%G;bJW9!5h5 zuoO94Ev4E~A(o8nSHNGz%vE@lc=cNGwxKFkDA84_K!!$)A^)ovlzhhu69!Je#%155 zRNC?wypP5(gIwv`*BQK~>M2npm-GKtDLDf?b88`5S78U?jk~`eh!x3YHo_{nn+dE> zhlyRWRo}rfE{8o$jtjT$%g~3n+sIClGp~U)>-{ZKAM^Uo7ZVjzKH z@oCRzBpo@16gb5;n`mgtY(_gplX(aRV_8S_WgU)Ead?X^=Za6Q;0wSuc?zXxEF4yc zd({JtTZR2B^dU+!d6vD2!8T5sKrasuqgv8taNjqDT0XpI-6Eap4|~J%Vx(OYO1$Y< zO=&%zL*CZC8fqa1ry;@wFchcq2plG5^Q*fG3(Osy+ue_>Qo$u9K$g#=)UIpbRHs&e zOgStxHg0pWITA%bq9n!t-ByTl-0SR~1H_t|M^@8|22c^|z!~izS-Xx`QaydLJ=Q14 z9XV?zdgFWlfP~s2(d|;A2VZLmXoh^!jj07gU;8hw`<6|s)5~6t_pV)PEQyH9=e&)C ziAi$CKFtXQdXR1SX!F^p;BMA_IuoC#B#u$D+kgfU3lvG=j;B60l-c<-TG%G&4WBf2 z18^^I%=)$#??s0HC(MMoyxm5hCqpLZ>NZ;@#5uJTzRbsrcEK`5jX0^_0cR|m7j&i} zgn<*vF&q7K^fGlp_3psAlFG)qvw~*@%=$f2yQ;u0Q6u-3qOt9P*{V#=sA{eK5SS+5 zmUwj#W3w*5uzhyiP+Uniw(FU$K%vR~#j_C$2;nH@U%=(tb1wN6PwDG1Yq6|C#QHa$ z89*oI#T6~}j-WUD*p8^2AKWz_w~j7CuTkS~sUZgS7JWAs_jpzos)Ftf`pCAF9D&2N|Yb6$^@2zC8^_r7_+VSY_G z4I8LPXqX~liORRPU{flzM1EE;X|sA`%#CrVr!fO4_HAM9cwA@@COqy(-S|BEl@_8= z5%i@h0@~`nHQ!HCO3mH%05oK>c zf_cE~VQwA~S0BE`zx)TXeA5MX0S4kNIw58h3Gsp(r>o8}G|q7D<5q;3MpUQTX??$X zVrqM~oef)C(sDGTkoObfM7x3PG7G|sfEf>FB$2+25D}H^Skc07K0T0)zOB2Mz1@MP z?P+6SUrp(o?}Bc48#B|Nh;r@94GC##vQf=n`gHBLK}4T$trmI>tet=MBbw8R4{fP$ zCqFlzpV55I+M;;5Y4i~R3>s%0n=ntgkS$I(iX3OMQTG19_XAT_Ae0putlCD5;hcC5 zsKNu$rI&1B4duOoWdVaGgC#zsk|5}w&|*n}WK!CN^Nzs>0$e^Mc}1-D$fL>V7r4D4 zy4`t!Q#&PzHDikGB;1!r6ePiM-L6@7yz^kujAB3QEtZl$C;cY9vn|NF+jFfk6Xv|Q zt1eBjoQyUK^J(YX-^=63`7blUpU-@%y@_{iIV&2f=Ca6;a^N%@{$`qeuy*-S683z? z=}Lw&^h(E`TN0ixo~MLD5>xb;$%M1&CDE9@M_`DcFUQS7d|?@Y3c|mCcCRq_8 zJ|)|Y>VhDVr*rBU`fo;`U*#E?ul6>KBPa!~HP zGLJ9b)q0WJT_VnP2mIAcjv3c_=itT$)z{0kaU`GW5&jWk!6O@lK}x^xEuxYpmlhJnvT^qAiQ&WIDkGwg94fO>;)g4%KHG!om66WGXHrCfa#%}N({ z>3fD@+~x2y24i(6?zEb_7s}(H+pGnxxsA0&F=lOop~*{J0KdhqD;mwBpqCZB z%l;0VR1YReYv=_XfEnn3wartZjPZCK-}rw0_0WJ+5B2>dOxyge13U9ett{0BkvP;L zZ>r5JDha8@vblv*$Nfb6cI*O-+?5kbf&RXsNyCmgdUk8tN!B%rLEU$D%eNm_ zrQDdJoT?I4^zIkoB^t?=?Xxho@(;pb^H$WFh6V14mMD*LQ}f8lYF!S=t;5r8nUkG# z@`EmLe0lu5S8*PhU_wk~m7@YoN-~Vjjt%h^##Juw+{qJx$jI*3cY9T;hDf zNh6R6&dS#J5J7)uKZ5W_veUwUSJtQm7S7Ti*=L)sH&ne&LzS|FmE z#f7JGG?5LmuhbK5=Ys@3W&)~Kd6qg0fS97R%he27(9?S5*F_Et4@DN{k7#^Z0QaoD z1!qf^`BemYiJ(@Nxh9R1%EXLrKCD-yb8y4E;0zw8yLPs(D{u2pEh3j}MR+1OB}pT5 zc}Xq4M{j&iXzAU=lg93dE}&c~`_H<@762X1qWbubi;{BN+Ii#G^K8hZn`XYe&9^Ky zDT~x0MO9V$;0Tfu@3EmDXk!X>X|{Hk>uZI?KjyI#FShHB0Mp?MdVKL^^x>WJyn}dk ziQl%xH>WBbe{ixmeSAXO<7SrBx)-UhoDre@jN9RtRERAY+$2{+%#JV=+7`21#{Ygf z_d7jYC}?;;knv&J2@}w^Sa(ooeMmKH{s@ZJPl+sLG&Up`&rYRKnq8=j5#B^)8!pF( zGB<9%MXMZq9Mh@gn;Kx?+b;8p?%Ts#5lf;P@S2VqSeD_38K4dhT;QP-)OU=U!%o^j za?0N63yQT@U;gTaMa-q#rkkf1Hc?q{MYan#Yk=)0sP3eD~ew6yuRV{kIN!a}qk{$wS>FNSnlliMnl!LUI9 z&^6B^O^KL*2*Beuqw;7YhZU(Bas`hpGc$T#EW9G45U0>v5W0snyJZMAhS&s;eYCy8+Vp)peK73!o3#F{a|e_aR-07TdVN!WPXT|Z z1n;x!+>mI3k-FJhdBmwFuaPm_OO17FpPF{Y+dbNpj=t6lH)=l6?e_)ybaD6;UMX=9 zwtU)5qDtyM3$yFfOyn7c^VGG4&H-Cy0S6b}cp=2JX3T`9v1mCbOsiX;YQI8;7`{sO zr8Ns_&l)b#keR-J)igWhKU)%wUhx^<+x?U)-{5^n!4!2 zXF~za_SakcldGKKvR+61`{rvZJu*bHI27KzA08%rh!99W0UPovVi_#n*Ct@zm{JX} zCE+OjhZ$QUjO{H>>ibK1>J0O!*uw_-bBWU8xbQz%tJCSXv4>Lg_Qu6!VM9d%_rFjO zf3_4y@CY7;IM8t3hx%Z8BGlcz2p_ED7%U78cEC>4}msJ|11z|wwoFK30 zmmPI4fIPC0McQ*fWos@3Qv_3novUT%r31NEF^}yOG*C%f=>Z-6v>XY+Ie@#A*%!jR z)-NRpR@CJx?jY*VT;I!XAYJZQXXdPl)|rIE?mS{1P;Nz(AVlQVHDpvQB9?I$$)%X_ zpse+q77sqW2};PC7p=b?ZE6bsNPwEcg{SOL0XGw;d9?is3J}h498g$j13*b}ColdW zKrQCF)7iPLWAo$bjml8-BVFWl@Tl{eU`3GZs5Wrwo2UWhm~-_Ah$~8m1qF>ej<5)$ zZR8FGvnzn7tW??;yHL=7?Bi=c&nEf(*eAOu#T_u6w+vv)X(`al709l8TX3yj{nI>` z?>Wsb`u*TP!EtAjSSYK5ivuiaF)clT@Ieb$?S4W(4?@@nXkMPFNkURLGkItJK7Q)9 zWqt!<_3gS0Sch(_(3~{E@d;b;288Czh5LSae>at-L}!kZKaJ;mbNnqLx)iI%s>zv7UMWyb{$UeiveJ3oANPII)|^zD^D*Y+ z_&bOf>^S4R34bgwH(Y;q2e%Db%a<^m%IyNcZC#Kxae4Cg3$@baIo6OQ)s>p5V)(<< z@L7;pJ(FAXwN=b)FQTC?GO?gA3t(QN2bdIf>=ZRx@O8?i2IMuqif-w<%9N{a>aXM% z+548`Z?`&p$_h~?#sM@?yq4&39-~h{6v2bE=?3U7cyz~rtdmxha#M@GQ{e2Cm;5l& z7YXjdUm_A00{}B8Doy>LR?>@m=Z~mkW-}w$3oa+@_ZHja`Jdq-wB&KveCmOPU>q#U zIQnfH>Q61#FPo;K9tr~m*>OQ%EhD*$*{>j-y1ut5(c} z90UY~HkZ(12LXK#6KA#9lOX=ix6MVE{x|lNJ^@a`E&b}Qht;la4_Q1rGJ7!Oa(QO$ zNjx{_AO$%LcZgqJZO8(YM#8}Jb=Z7aP1u91c(cdDU9d{PDWJIgxeF5m%&(o@cKRlX zhfDr<>(HTTB^*oq<8jC_6crme&g7R%%4V$_i*kucBuglg*sGF}oLLU;Qy~?k9Wa_{ zgWov!YdHD-$V-@NEYMzZuW1L;@l32TOXxi#kz(%(^rdz63sFiQEBhrgYC$)Y%ZG*f%Jx+A{egTpu!WySYF95C6T) zosv(>w*F0lhku2RMF6-4p>0T_o5S}=c>!5>I~uK2vYZkoR9dT@v`*YU3dJrLzI(d7 z62;jCY^*kIV1-?*&Va#edljFKLkb@tU&8_U3aY>Zg?x+_I=b60@MsBqCH6ry?2a$5 zYvVA4xp_lqSP{91OQ1bm<^)1crb<#WH8IWdJYGFbJ^x>aiFGUl`5MkI<)KU zW`@-JZ(R?aHE2iV!sJj$l~(jq%idfioYJMQ0Wh7qI7tLi4H>mC)xpzL&-eRS4#lXi zBoATxboggX;Zc2{e%-;!I?y@pPs;f9B-8aZdnxV!iniR)ss);JEz^s2DDQw$ zeiHHV6yn&^###H`SfKLV)2bs$r%~Ram5H-3cql5XYmd;!YdkNo_AWLsVU<*-O3*Pf zs7;i~4ximf>>!4*r1S_TVgCjK){0}q(i~pjEzH2E?Zx0?#XuXC&KarRj7Up=-khI+ z;{d8fCf45z$aV?SaOCW+Al8~c=AR;(7EBJQV_&|Kkz3=y+v=)!43MP-P%g~hnQ>+l zujbQ;QttC2Xn`$uN6imYFT8!Sloe*Gio?r|=>10j1|%aT7A0G_wsYu{6$`#byo#@6 zHmE9?S=L2TUJ2WTy7~nOfbg$dn3Z>Za)&4EeNI{$eNmb5xloP*`gE?TZsI~1-_U#x=Xy4TV-l0L5Mv*J~3uc=dp?k56RxpFfV0nX3t`5`lSf6 zDapo!FpiLdOaT@i7#?TJ2lx}mgS}8=~v?YW(_~6&EpXBOD-`hCCyt<)v?{ zTuFP0@>N#ZTQ!6eejIH8Wl2pYy-K;9C|nbGfI~wF|0ko93pa-@i94H0scFQYM}DBqjwP`Cf7Krg{A4dj+qV^6$8IA=psOQ-=b_n*OH z3)PR3F7d541=5jmwA&r^?KjDc@wA(h&}aGE9hr+gPIO9#n{h+# zWfL?@F}1%3=Q>0p`8WP~Wds=Of+NY4Os-6TEr8792wlty(QvMnq)9@C#!?8ev!OTi zw%lFjZZZDKFefUUWJ))~>a`J74ddRGKezC8Gq=t?kPM;6pa(4=d1!%HV=cmb1dsz) z;$aogCTfFCnZ*9{8pXD_?XC}y?k>U=j*TrlHhVw(*A`Pd}0V;1-HBC_* zS_!;dV#hOjss%m4hAJ9_j#M>Fs_0o~!-sQkU!D5c!BjYCcX|zhSB03@Rlho9vPpCK zUyvrN7LJ+PdSJXXpag3PyuBg#KJ=rnd!k7l#OW?GluvXo7EO>*Fzrn%s&UzG?L>6v z>r2rp(k+ocQURxAhWHp+bglqG;;Q|1JQjeF+QRx)6`GPADu@18A}(eos}n8A*N2wY zyR7gxUjuausk}X9i_F3>ZdmR_Lfy7n->(W-BG+t-rw_;H)JW#-l4aa%Tc zW}&4L4RDmnY01#+J)ZH9h(7YZW*&1#6$o4Oq9H0QT^R~Jq|-;&0-!;oaR=*)jaO&6 z+{yEx0F6O0xEo2$$`GPDZU;oqzQI*8Lm2kFI)};|^}oQSeASXPP6fm64M+EN4a1{1 zcju(DW8sV~V5&~BUORRvNeQ|Hkvi`gB5OehW!4Ldow;17M84k_APU#AI9NXw3S((I zP)?;jJ4+WW9sg2dZr|G0udyXJRx&Fi9pUj@`8IbwZ-?RI>RyZGxKkKNAYQWm?zsdk zK9dw%kx!Rnymh9tu}_-vl?XQ^wQUS(BmWVVEn1oGaHuxe3|8y|85@9*Ika$wyN$&8 z(PCzXl91|co%R@nCYoQ;Bxs{9o%nwJJYRbk#h1zv;BhUk0+V;>4`eGH`?2wA`8F+v zTPerGrH+fVAQ@Xok7xgx-T+>Dj@LULmf+|t%kO6^!J~^xtWx`eQwsEFJ zrNm{nqgL;_iuaE;Gd8WUIq*b;XpL%LW zU{Qdw8eQ`gHfM{j5TpKD1g1B()EBJ=7HLKi?sr@Po?{dx1I3<|peF0BQv|f4q4iTsm_t>~%;T5RvrSBgmEuzh08$Mfy z(=Qs1>r-51ao+UUhW{);hU`RT5|bHjz2@3v=0DJw2i^=3kglJ?h7h*JN~6AtHy*|~&L%{}ru@=l3NekU8z>B}+QEHuvB zxqJH1?mS#FuaY3$@${GNTmAWir4KbR>0M^vL{2W!i8nZel7@&*H0ypjCN zY0306TbFV-(**>u(03x~qR3CF~OYxXTa{^oVys-+NXzdv_DR}RPewH)TO}`o9 zoe4vnMkfDl&7u8@5>(8c+WX0F-&IDf_C;LKgSlwh*4V^etcoO28=A`#l~S_S!OT1U zR6T9#ZjBMR)`lYCXVLn@+aP=nIANgqP#^q{zOh=mSd&Cp>C`c&GHVXNPX0Y*1CRC}T9m#s-v2G+R?z*S8!l8EoKUoXguvKjos51~VIR_#)@{>!J$vY0*%b*bJ34vv?6NHMWS$waVZ zjXRR6T0bKFu?Y+U#XTWkAn?{j1=otKK0Vq8`+KKiBA&&EGbAr-e_F-E0oChYrQ8UH zTU|MHv|XF4=>^sk#B^3onqiLZ9Qr@ls<&HpyF^`>svAc`seE+ypbd?|cN7c_N@Lkv zmxn7m;6?Ll5mLuWCy2L$7cCjabi<$tVIkkNva6)PU>7u596rN0N(8W*Vd zs%;#kP?|=vf-3c%(7Vy*?xe2MhineF#f|Ff{m)$XLNNHXf8qmEDQWv30-4Yt$mxV* zPz}F#cUeX@6kCV)9oN1bS+RJR8&?_*GpKhGQ(ZX|L0ve zxZqPAO&Kx^H^N9`KjWFpUW=7*GX-|fbzT&P)CvMI9TAk}2XCn-xxLHzeeEH)b(=r2 zCrVUSM#C^M#POV_ToaCdbYylnA;Y8qkNY6QB~y)%U;d6&rK>S`{G{+-LElablfQjr zBIIl@3l#C2gBU@l#perWoNqh?kkm4g*^di}zx%xM%!BC-CMxQ}Yd|OPuoL?pL{JFd zps8ShEgtxgebx}T3SWDRj5~#!Xdk@I_?u*iLli1zaV^S@A%))R3s0eXSQ;RCJF0oS+ifGyR8<4=oucLaT5^Vo_YK?9W#EG%;a z%TJ#HwWuOtqXlO*3*+`_;aWXB@;3^g13b>9=6v}4>W;4+I4zVildtL-(Gr!dn**1k&H9iBri zDHcFtsU~4dtWf@#gY%&iA_cF9VzN=1E!&o;xY4y~-ZnbaetlAGE%iy!55jL{H7czw zTc-3oG(eW^KL-$iZkS%tp?)we?24iimi?wOnLCjsgC|dkF-WlZzcoW0f;%{S{aTfz zmzy&m7Tfh4fCCJ@+on1-s=VAm{<}n%<<`)d9sqk7L`Roa5bZVQwRqI5J1!SH1fi-{ zuGVaOolTEmG)yiV@L^mV-gz_6hbhfkTeJgA?5W#-8AqL13hJew(Q+-tUC7o%>{Ac) zP4RAh3F{jcnOT+)%Qa?C^xW(CbijKyn$BMKK;`W=<^x0|-}t{JlqeoFBooFV%p)lY z#9DmyLP${WqOhVAx%o=d5ux*^t{oYQF;(Re{VY*sbx!;MSC^T877#Ow%cu>WIhxNo7Vy_)5FP`6Bx-H}nFhL1 z%YV~m-S_#Tydk^Fh1y9Qv_r*QJd7LGJ$>`PA`iEI0n$`PWo8(3J-93onjD^*rdA0Q zTsud#I#Q!;rQ{?W6qr8i)qZIztSG!to!WpiIqsGhNIXiUv+A9WdxCj&mCDZ)yy%?A zLujCcVU?j8i+>x(YaD8>c+~!o-Nz~3S&4yGnpz+?}fXC7!;Ps+(FLnVI$^z zntj;?(*YBT5XCK$Q!og)6xlq=u6U6A;5GbWIogt*>j=sQ&1!!`;7%!UaLiRqmxqZ# zvT86|8uDkwyhC&9YB$`>-j@1_Qz+m#gogMR_Uy}XZSvi4s->~Gn+wVi%0l7d3LZ(3 z>+m`8oDCz2?LNL6;=qiP$g{!+ta%!QTP;PcA5nVZ9)L0R(V`60x1jAkD0!&iqK!DprQ$P^1Vkq_Z`h^b6$r1*kzhhL05!>9g9)q9WpMl!>%SP z(Hp73QbDUf7@;QI{GD|8XRPMO+rdMqTdE?!dX7WMh>j)83LoLfoUJOq zU{L2IP64JBvAI<8C7x`ruGQ=k*W`&44)I~5lS!gn6LWyn+QFAei9d7Tbyr<{;a%+R z>$pr+nZiR4xhD;=-JLs{Orv%i2o>|I&%;}QK!JoD4=f#WWIihx9y1`=rVKN@@PIkF zZo^bDaKu#0H`dSwXV9Ae*w7x$-@IiW;;e_|W}j(MmY~nm;i+ehEXaXp@NpyR}-d zsph^s9&%75z~fH#KM3?ooMrj=!v_lc26kq2xan#2Vmrm^rEuR)lC=35QOL#%;eaXG z!w6`JqBo(7h;gpBR~r^0&#Ilo3?Ap0?!7K2atvhszMWR*{^*e$XNF8t7{TQmGTC0a zyz!k}&8#GlFt2w~n-X7d%QqFg_d++Tl=8bgn6h2)qE>OAEo|2cvwulz_;jDcka$t+ zZZu@@GuRFTGyCY;Aq>U{Ge@d4ze=dVgKDO{avE8J+yKiuh;tP#o}fl_!iSA$@@c#s zS%vq|oOSmD&hJ7LJ$K$9AJycZ!<(GSX)eO6ydC&Yk_F#Sky4OB16^rF03GBVLVbh% zisCmbG>*1_-1{PAq}HHGTiSm>L8GPF*?PX3WzSxpI3-Ur5wU;RZ&G5&;@P3C-M>J7ES%;w9(h+`YRBCzqjLaE=&U@}DTScNd(NH5F z!)n;-=u^#!vv-BfBT#t$4nI7@6(|_?+JqLMP+M~KT!Eo2)V;m8>}cN1D=bbsAnc@i zTY&ScX!Sv%h_(EyzkgG6g_DWa$*D}ngc|`wD`2iKHy;c}-2^0qfz?R&9WS998{_dg zRjWUcr@0~I>3U5Ahp~li`ce@oV5=}m8{&@fo)$=YTA?Eys{<+pqgD(0~Y^$oN`rKbtTL`j#KvI`Ye?Cat zpF(6}(p%)&Td>TAd($D$nApnd-zJ$T$f-vm*)0P5O&Ufj)prCQ)1 zzlR#^?JU3AG4R`>Jp={3T=$zlw@7Vy-5sHRF6(5PaMAn&dRDY`4uEVr&UP;#LabaKCwW4pHD`$!G`jBs*SZOa|j#wmh`_FpEG!Bz(xD+ z|I3If?R6PMiy_MlbKa1!TxE-hTf9HO3Mc;sqWw%M!1I9NyWsBtqNQc~W`h&nGtZ-$ z68}Yb53UknG7Vozv%aW!Rm1RYwmSIW(@0rim^`6ox$bx;m-c>?xLB%Zm~ufIzY6~& zP(*kG5l9i}S!M((tVlAmxa4KAAtX8mT% z*Zqifr1EA=M3J0+90=TbZKd74*hXuB;htlYJ2Zjz;L z&eCk$Tv~!SjW_F#Gu8tEcr^FnP8+?l1E5G;vt&!+?}~#0?`^i3AM0T}i>`ejqHa%s zl>IR02$1|j-*xA_1%zgKLP#vorvOWlqPD%ZWed;EuW3rZhfG1AF%)H=?{vTwt!49JF&nbdaDG>KanQ35OwdQ|kzO^s4g?8$ z8^Nxma#1Sc&>~J~>kGhrAN|<%wG#sX%3lRg#4{yY8tTMLW}&a+$G9Qc59NrDLFUgc z!+;wZt$_#Z6US`Np?qFo6uPK~_#5Ycm!W6Z*mJ_`rVWw@-UzizCYuPrxil2SmGyME zS?^(0ZD@wg4_@pvtxuBs-3Rdt3zdpr2vk#$oFyc{I8-yD5S4oD;iA$Xt+9@9l@4Ml z7$hMQd+43m&f-^(Q<#YVk-Q!pVL33Le*=Spbm8rV_*@h)l|F_Vzz8s=@^Z=wYaT-Z z&^^M;slRLl4#-MCh?Gg(ervInxw`}5KKeP5KU%6Eb|BW1L_8%z^|wx{PJYt{ALfWc zs851sSL;Bx5(Z>*C)~RT4eo3!?%*g2U`1|Ti{NS4l{tRvyjXPE^`D+~EnW|Ll?CkW zB&F3bE@M263|q7G^`LOkjd5!YaTA(B`J(mql!D=ak2t>)5tx*4CxMN9`djS4aZ;Ih z;Bb!)q$MLaLLM}igOH5ijnf&<&-r95jaX|8z%Mf4X9{Hk4syU)r?w80{_g9N>1t{h zZxc)!`@oK3AmjdCj3tp-sTzDGXH%l*GC!{^+#kD+9t&HMHQo>w1;Om)$jja9&s7=e zMsM#Y0F~75b{~dsLO5N8mkXEsFX;u{NtKKxUla1CoZnaJSpld?XY+QA5t@mY&g;t0 zwIoldOed&d?ABtimB>8bysZjBp{GdmVHl`JU6T=*_^5uV;wjZ+=y7aGBIaI6vkP!KUOU?HyoQD~b0=bV zDYULjsy2a!gu*sIra>9uFY~vxgTY^ipKAmrXXvH9a`sDqPXI?2lOMcMqS|o*@6K{A-3K-$-?}_FuT4Uaye3A}u>kX1Yg$ZMA^e06)*G;AV`XLkZPpa%1{R4VdByH-xN2;vmw01O zGp@e8ReWs}&owN5{>~6^38Hd|H{4wZTru&~X2YLOxdb@CT~Xj49|%rtnV%+nL9&f( zU9pW;TK~0;-RcI#$WP_MY{mtRK?91{2XD4Yj#X`4IEXJ-iWxkB4sz&}eqmttY*dd{ zj{}M9cXQl}jr5&Q9c7XE3-0Nuow}EGEGSQs5IsTEFw4gp#2~f5>n)GEs1Wb{Q8(Zi zdwGz@SSu`JX~IPIaC@vO;zX?5KW)VOTob9XvI90py5%6^8>i^`%w6VmGJW5Vgg2Y{ zE%TzV{1io;;CSD?BemT0tLG@^l9u18o201Q1{~X~EiiJjAxbjE3W@746(G+IfaR-L zdEY8H1iDaJ=Xj}h(?NKKue0r2Q-atc@8(NvbVFggc96t9gg66yzJ z7uUE8SoZL@Y-(CUPp=_jg`fiLn0y*eSq~#^biex_8P47pWIddtW~uPDPM>uCsYmyh zcyJv4uwub{cAM-Kh~v|(El;l#+BTWzYUM8^Hv?JdA#;1t3Wn(pG+clHhiMuc)VHP5 zcFzF(lQpi3rI#^O9KA8Or+bFSshnZ^rX;0=ZNqYK=B4@ivNEYOyiLhE+)329A|ynyi8$? zqd}F|N+&?IFJZ{&(p+UskYkqQ=ZeX-sf=y>M&&z*v)58tcP_jk8J(cKdb7U%jyHFxf2zpl5kbFHBXU{SmXRI`D=%`BmfhCXx-Kj^#}5y{uPS~qcfTK`AF?)1?U23 zIVoww9!d-!>g0Vm1mBOvmi6ZHp?mQ1FHH)RqBj2O-3B{wvJig82#$5pRFsunrwPI;}e> zZ+FKB*2@DmIp>o+;wqk=Y6!YJe55*MHV_}`wDsxOA(Oq+(c49{GLq&qB_t`&I&m=Q zTu-Isf2=C16XK+XM2y5U6}YZ2Cs)PJ_r+Z5Czrb4lrsy_f&r};Bcn?;nW^N&@4Q$s z)%%5Nbf5Qr?YrPCl!Pnx98j!>BekkX2EC*sfZ;_2Plwo1f)dlEkQ}q}M>t+C>ugxWtS+E}UZuO=#1A;~1%XtKn40aK9_wAWaU-(_lnxok+)3dauWbQ+lAJy+xlsblW_RgZq_nYv6*8fu*H%s30S0mOHn#{IU_X z#LEnn2Bl>){Jp3syn8T)-Mp+_6hKrp>9zp+>ju1`^&MKRroO_$v;65G;O#Pc^3>X8 z1f9y67kG`D6i__Fu^Iaw|7&bGP2jbeA*l-63wDUJi^|EBwtwQpI#I+TUU=aHPfqjY z-xGi5tJG~@`7+}6*Y$}@8@>&@s+OaVvTS!U{*x$* zF)qAxc%DkTP3al(kUydZ&I+UF59i?Rc;FaMG(J3Hl{XLE;N!=3L@Co@I-M*irGESB zHBNWKACT}d-L)PF_T!-o`<{9B-)EQ#_6#y)dEy+(ZSf=11!V}|5M?_r#X~S8EpR%M zFOYhB#BOsRG4+Z2Gbc?P=D#|5PzzJe4+Cpttcj82tqxe0Osjz16AU-WhxLTt^Ey$i zFC!uZ35`8$jNy@{wAA|ax*ppl;ZdYv!vds4mS2uxml3sKzTu!(pwbaMxL==~l0@GOTp-m<};Rr4WAqv5G?*tN4~F+wG? zyrWab-{57Nj^ZOxW{e4j=6iL~R?PgE2MQ@$HF(cje2kZ*HGdT2!{8klv-l-j?!zS3 zY7H=Xv;}8RJX-Kc>%{C*96<@Z)f_uspQ8$NK_2KQiBcifFRG|Wx=3xrzl%!k*DTlX;5i_PYkoUAWPNxL%g35uzjj%yw*yd*qYsjF#B-jx|7% z8Q?!<%FnjR7^EkKqbD;Is(iU(@xbW_2;VmO?5@7Ri}^N{do*O=E8MrWZn3atSoR#y z7OT0|ve>r4Kv=V-X%aiMF$VcDG~WcLigKIVq*L*6kW#zjI4?DyD{)aSwZ09aKCQPf zF@7HS6OA<)o)z1K&tmbzwh%zWgg5)X34)s)K{_X2H#)SaF*LKK`k3O)jfo1AbpjKx zR?S_ITvK5`1_1ZsGEmV-K29d&kl$Q`heeCwalNZsUa!Hgvp5EwC;WeJ04I$pDe{yw zt-NFIXknjI;`X-VXSzW63NAmhM;Mck3^iuP;HOCwwxe8Q`nzhvT~Rod!z3iaY~Z;w z09Y0OwYQy(3TVubQ8j7&u`uTE*#{rSZs|7K75eyONUSWckNrf_m->%Hf4l+uUF=EL zJ}Rwky8AeR>@K9smE3mi4|esKT*~wz9`X^3dG-%rTakn=djz(EWHIrK0JzyBl1Yd?r=#V}xPnQ- zwP>SPFcfTA^;v|kJLjPU=yBz$#?itbsL~|&8+1@95`5F4lPBw4YeroNW&k`^t~b5& z|1X)2H0X2jE1a#|q^l10uv$K22G7UsN*@CBNgoE}BMTqjF%=Fbl_EBkarA&sw1OJP zT9Q>BEO2%cAk)@UKy@?J#<`=x+%S5IV6TZf`9%eNgY*aZrrQ=UZomDzfqDiwnU7xR zEXI{zm`Cu%?=^&$3F$vAlg7D<#UkmTc~UjOd`_`-f(FjEW($riHb){!RJO%vx*~fP zgnx>yr~Kz8ujg2Nu=C`D)ZuU^Wl^n8eOW8*NSY8-Q`+f zAGnvIUBQAja)=m}he($(tV6j{j{RwAX7q8ykgJE!^&o-4Ov1Xvw;{FXVmsu01!!_Z zen22v;3$AlvMzvheXG!Vmi>=?T3@+ZgRf8?LEMf7c3ImYp_vA>kPTP`#~9VY->q8 zV2F$Q>jnF4K2DbZXm#7}*?@mPk@rM2fkFJ9x7PjzbNXyWz>=38i|+tXau|1|Kj-$a zZ`m-2W4a)5CPc6TMc!ge2UxKE!Dh`iId#fZ$wd?Tudvs`z~?7@gLlaR!l{Y{EjbQk zD&ElcCApwWOzWjK_- zN1Gg+z1vlc>xZFm+*xiI^kKg`ZllP!Piutj|C2O}5zM2|ad-Fce)ufGBg6+iRfw(| zozf%U_?qOsAfH(VdlY<+_BfyRhm4iZESVe_8>bxLE3h|E(U7NYyi^bSS!b~gcNa=U z=zSIxq_|VB&+)Z=12%~-UvA4cV~mEAw3}tIVtr4kXOXsY!~SL2%(3H+Cd}I&?bj=* z$4K3T+bgd2vEOjay;|!-1r?*AKgvKrn&p{rS+^Ap)m(x10RzIBPc$@W_H_Rb{i4v1 z#D5)~z6YDLW7fnX)+Xo0cNWYkn&BQ_50)#}RjAq=UZPB)i9f`V-q!`O5dO)*!7V?H#CAFFu zoMES_>O-~GS|l*?0He!mHZX-)i;`B*Eoy+U`__a%ms<0mGhn(r0r(~@tSGLR3ID{> zd%YQ^iv=4{9=b?`_a+b`rWNjcL!pwZ+#(!J+{0yjJzMlzBMXC!S zz&ly_;CSls04gs2QFYVcj=1l;traEbF-9;2A%6@F=KJbm7ilue+)B+%-k2tt#)R>v zTiz1L2%l*DIOupV9Z`mr5H?G%G*HFW&;zR;dSWJN;zoZ*hd?yt)KhjRfYlRTrnY#oW_?ZN+t>-g#V(`+*PZFdUyM$?MOX zsHsMSJjTLib$YRu3Zj@8PSMYr4erAspM8{C6n=Hqw_Ysr?ex!h>dr`TMu86==0Ky1 zW_uq*<;c1Y)cY0w-!od}J6YqFg>T}6M*rV^eKTQ1(^|7Wm4YmGlxkIk!JI1#QcQcMbpMzGIluM(51pf5DWx8s zUjjgi)qYPgiQy2W+4wtQ36E8kd{AhDqF|zWM6yJLW2oajMd?5T(!wHSOtK-1 zOvbZ#Fbb5$uX>|ATiK9CI%ZAxnjIP^h@PjKn$EV4Dn6jN9iUiOrf0kC9xoU?rD3|+ zO8QaU>L$$V-m3}jyh6WRq4)_V=Ti}gM3FpN@y{D|{0TJBxNID^z>TM()#1^a5lzk& z+V#|zr8gqbO4tKC=96MtKx`80L}^;%2?;~xvNAHR@mKpbU;?6+?al5Um#qk}q#r%X zZ*V{X9He}}QkOThaoY%4O4o2|{FQ_civ7cZuyrt44Pkd1e*+M$M+ICGKLU3ToSzMr ztSN#Fjo~tBPc-YjP3wDdtMbSRrm5|54TvjW_T?+gc&6xQioMh`KbS~07X09y+g4%z zo0D;x_j9XMSp5l?@yJz5LwZP#fUcL3HuJuRTRCNUlX$nCS1|MDF1^g@J4csPQ-@p| z4~L#o!D`f3uK&m$n!ok#X05<;E`;z{iN}tiK$W>KPblwXihyQpJ3*oN+KrPc>sK{3tT|ZJmcn z-&kG{S{J>U>1baED6+YuX&M}ANkBxxc-&q28!L#vMb&##`|7en>U7U?>F#?r%dP9) z>gXsAq@KkxKtt990|u85^f`UI? z&$>pAyR0pdl$4!Pq=M#U!MuB)2p|1ub^>zJ@MYnb4_GVkB97r( zcAB*u0(Q}!79Tzg!^MUGrpWP!Ah|A1QXzNup|oq352v#UGS*m#-#JY>JFL13xZWQC zzY@~10I+!3@p(={fpv`$tfx}V1JWo^m>DAbM#RmwumQZNC!0?lXTT7dsar8%vtOB$ zej_y(1ZN<`y~*4qD6T*CLz1|MNkLSo?okS)fA$ZPX$E|T;=zRB>ZA|Obw-||C*Aj4 z0QmCL$N<0fjt9%KhaAxUIEJ!=b)*qb>L7ft&&lh1<8dXlEVul@Sqk!)nKmh7isYFn z2X}i{NF}Gr!{={i85Eo$7T~QiSXBa*`h3m2xZ0+4Iug5Z_L@IWT=7aAV$0~Wz1j9d z0I=!iUcpFO^(7l@c;0i~eq6?((3`|SXASpMw~cR-3m1JY2gj>f6Wh>+2&7B|^iKYQ zvcUpcKU}I=Gw=`TOCEUwqjt_rgVsw_zeeB7A8fvaYc}}i4Hx0}>`_#~K5fr-du0ar z-hc9wrnVS5j)))%2XL{U%P!sND|EqOW>e#w(lZgllZDp^+Aa(eUxIL;PK8nbm?KVw zXs2e z&MKeGpitRd$EKOC&Lw&aq&mXDX3dAGDS)N5hOIPDU7{707rTZmSHyQJnV5holLF-j zjw;F~)lQ7;BXEk}T2f-HlW9ixHIZe}l^1wMqTI(yRkYjJ5En}H6=eUgT0s?KWdOXe z#ibmfnTJsUMRyKPCuWQc!*s-17&`-?F)eK6VtBXWQlUfuSxQim?0Ix4?RAb9{_f|I zC^uivR_x`EnQYYcV-3y@t)TWqobt`*%q-N=Hfk5)fE?_!-(By;N5}6#6JMHIZ1gMR zSPsT8im{cQc3uO7s$vc#NDXf6JJ4~wFYz{c)vGOt21<{#rEsd_F;<)A8BmZHsu!|^ z814bMuwCy9ge;=w=4VnVqWvRZ+>b!tK`SGZ(tMAe%>UP=4S293!Ejb3^oSosABU6( z&q*$66Yz6SZRX=0k~W#|osY6+=ps)-^GQA8QHnBV>HmD8)Wzb8I#o-#OWrLNWFB!U zB~@=MSSexT)xg2_05i-pC83=ugFIxmk}z;g`j|7_$itlM9X`~vZ!2IOz6q5NtsaJT zbxWyh!=!<-C21R^0GU?|3n*o3dMHmNEGo>wQeuGDB`boneeD;FCNiJD0_!jFL47H-X0##Yko;vV@e!9uaF6D z8`5&LVdt}&x;fz@%M*GOGU~ByDums-VZRoj=P{-0EFg>}Q5-r;JP4T0h;Tw_y#vB@ zE(e=zK^lG8jHrD|j{6c?Y6S5&z1^KKtv~QkY>^*BXez|MBB(TUmK8B56}js(62ccC+UlF zv)?eh@SJ6=yi7_~JXU!5c|c{%+<}?Xx*f>?^kjCQbBZ^-<8mJNJ~b@R*CPoDiaq`u zri*cM=mtcgSd#)pMs0hjZLb6`iq|t^tdMi#2+qojOFO74Cd+(DH-5if4*X}7o03oG zS|jA0?+DAc0^l%3fdSq1tl24?^nK}+T?lq0q&ro+C=Qht-6V2Z`KirBhX1GmvK~cQ ziMCiK-6OuYf+g&)L5=4xliwq{ms7+Q00tE3`R-*)vX~gmjo>X0pL@$8x(YKKwz0PO z2@8RI>=Oh~TsuqCOTs7z^XX74L-!XI1pjneYX2y5+5k@}B&)mTC0yJs zHauCDOaVSUm3cvhXxAFYDjRSNaBAu!fL0P3aZAB{Q8Ek17LMEI6fm?W?7cCvPMvmG zhb)92xBQ9@bb3Ty!h}Fy=hX7Y?Nr6!G-&V~y{{00aO(=#jN|D^v2+{nJtA^GoDJK#?A) zz{!}sbyYI=d9S&BaohMG=vvqz@CBbi@ZiwlVEa}2u69`wQel`dd=W-Y5!J7q;cS(@ zZ$~-TEWNe;$flT62-p<-j`=}xbb|R1w%t~&;fo&-HbC8c%unHi>nz2M1G@WU`}`5+ zLj-=T-Puh-)J2`rBePY#4fUMGH&4b-KyxRJs&l6b@N!!bF2qdF3SQr8;E307x31

_FVlT|gITUlrhnz?&qU?1a3Y{qzl&Q& ztMZvI(@E(8{y74pj_j?7<)<95nZ|4pzP%r3?sF9_Crp$j?=>T&rfo#2GJ7qI;Ra+e z4(l6uXfBhuoP77DDeEG*TiOscx(a!=r<;r32~cBI zzK^x*6IqgHIv0SdA2=T($mg6}z`0V01sK;KTz!RR+au7Q3egkat@$1tZ`T$K7FvDa=N>&a-DCz*E-VWkyb-74amce-dn*pUp|i`|hhH zQM}8Am4yi3i0dkSd9E#BWc_gNxztHI#kXWjoF=uslyV;&mNmjZnxNWwm}MWcT^+lYxI!^2Cz`I`*0aCybnW@tc@qv6_qr^Qh17R%Q{sA|nk z^1|tY?FRoK8Vj>?n``|a;5fBIB;oheo3*BQe+L+i9c(&vW6m`J4?WrBpK5m(R{a=m z2EXuvf*LIZ0>a#CQF+WrzvI&&{tx~aO(bZUlB*3i&JnuVCT$?tq`#4D3(&(NTzQih zrixN)w(vz*|4}*BQE3A?Myjs_IXkN%ic;pm%stBq;O&qv)F7LQ-Cm;0gr?~&=2Bl{ zFKC-^VnzoR)w>|-3OLyEG)8T)Q0RbncV^s&uX~4{zFq<-*GPS*_f1=nHM#0nF=dJKcZ~=r!wy3h!vxG z$PiJ%_BQYfyHK+ZEG2t#+5S3s1x+Gej_-btz(DtT#u}fq&Y)>}u{L4COtn{2|F^hk zE3klGHpc-Ltct+@@yc0*MLxm9FFx(7pG!Z!BDp@6YK!!nWjoq*j%*#9++O_R%My`J zZ9GL$Lg54)w@ou&+TL7FHeefZo*4O6uNnJH#cL)5kR+uOI+e=AH#8Thw$$?f-4A9D z)pWhkfgk@asO}AugweI0In7UGvksgiW58G{iAaw@H&_|Jx@%51o{KgGk~`$EKAx>3 z0j-*F<%QQ+BWi`(DXVuZ?JecaaL2n*(-uM01t*-+B4`=)1mwA*cItJmFCH|JCw}_M zXHfgUdjsl$Jh3tbg5oMjW??Fgjo;k`zpDoQ{ccv1p=bX)L#R8@Jq3*Q1685bZ>{sN zdtDp><$x=Pr<`8@NINIqZV6fsfhU8gD_?vOUra1knPT+0#L*ikE(4wCcmnIeeznUAW8=84yYU#2XPqhMQfx!u0 zr}VU>x9C|0&x0r?h0t*5{H{Yg1@!23nJ`lRmCYBZVA)RlOV}&@vGGZrZ8KG8HjNF8 jrw9N5<8e5qMT>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&qA#RSq2LEIr8{=A1M2Xs-W9kr0k9o8VoazV=(1 z)h*ajU&BtTG)cvQ_a63oy(__>-}wLlKk-Tl!l2;OkJD?Je}?xi^;WX}M=5f(Q`fn8 zB8u=k?^fP{p0+VIbEr}~z>96(Dw z0dKKC$eE$pw>sdzV%ZT%G8QX3T^x)Qi|Gn%XR0^EQP*pnD^j8aK%6BB9P;frE!~NH z#}=ECtoAO~*Ru6b#207Te@{b_2IbL+s@3JR=B0THzzP+}Y7>|qUR9HR-YB^=D>>%% zouCtP?5cJ^=|OkKBlC^kb`N0@LNvqoVs>ABp+XKwH5-J_!oBPKNp(u)R8vFa31W%n z(bG4=8;`LLjw6MgYehD{j~|g>jd+||kH#9|59q?1N%C`nBo3ch-e+-8m^`}}K$tcm zq&;6$s+~A<%|KEhV$R5a>K>b|U2-61b&?t`7vpfX4XusGKlcs`TFL)^F%8OkC8xhM zKLSFLY(NC3`>nXM(e-(BOmWTVwL}X$B8itF4ZqhRjrck#dsQpD*=TS5GPMXj-`B za;SF-Wy!u9^jANrDQMoAV5Yi(ltsd&79?smI&;zzIw{f^5oH{2zZnq{3** zN5g&~aqrL+LeIRwohP!rAFYp}_*Q?eEzY99Gte)J;WT65nQy zagKsAu=Z>lWowv{Qsl&)Q8!OFj))byu_IFLk|LV-C}VrmxK zhn;n>xqij;q(~}4wc!BO=0u00=_2e&L-+4Gv`4+_vIrT_;_rSQiVbC;yRAsBo7tL77&Y#7=B z=>k6gMh#|f1pKq&HV%DycjplJX;?xd1iysQ9J)lrIDc4XQsf36F-i&`6cxx7R$*uN z9Atk3Cd%}Ix^5Q=D`H@~X>Z9aSw_a@+rPGm@B7+G&xgl5f?Tx^Xp9EGoQiz6G?O|{ zS)M9*qqaBN)sl8yvFr7C%&~ogElvEMTUU#UUji)?ooPa6JjP$k5!HA$fLN@-)VzwNZ mXO#ke?EnDEPblvI0rLvaBme-Xw}}frFb#_W000000a;pxf41iU diff --git a/data/athlytics_sample_ef.rda b/data/athlytics_sample_ef.rda deleted file mode 100644 index 5b39c038025a9f7d767e1f7bfc9f85139a13a9df..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1544 zcmV+j2KV{>H+ooF0004LBHlIv03iV!0000G&sfah8)5~@T>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&q4v%?=#uEIr8{=A1M2Xs-W9kr8Q=$K9$?6`Cy- zmLCy8gN;3(^=SW20GyW?A7v;{R!)8z_&THY3Q;7-v-+tcbSll+CO2jav|}dr527-G zMJ$qrdc+Aov=XAYLS+X@6$ed5J$IcXRbu5>E3Z%=$&thrhw)kNp;)!%pt-h3-S%mH z|4%@dn?ZH{RR<*iEFW>_My*6eknMg}?6T4MQ%wsI-~_&0rqf*uxBGl9SfTklt<2Mg z1AvWQP-=~EY8yIuLIGi-)>G{nRiT%^LNCclhkFtjnEwj!`1>fcYT*}rrY(n3Zve#> zaL6Bdzqu(6RmtGj9&}R;5++C>uh!ZnShi8)AIE|pLHX=7>2>DC#2osZeg&ZMb1 zTP~N#s5Q&A6D!1WIbc$0VnlY%-&Nd5h8Jn9!kDZ~>L34+oxF$%0uQab9h6E1n#T$! zvnLF1vx5O=h4`vu7P(}BG%bV0Ppxn&`w<#hUV%5Xz;#%L{PpJJNm6vwGZ4jW{I-J& ztuna8L)T8*=k50wLUCTCI>r<>UE-<((VbK-=0=S*bh|k`{RZ*$k%pK*8OP%)R>RCB zBZ#J$juA(aTR0|2I!8YmZTQ|3DH-x|%#LcAoJ{A$^8e|}&|^;CH@8D1LgtzwKt6@( zcsVWN{INS#UP7{jf59pm4YN+LuYA4Rw9EG4e`gp6b$`|$A>@&u%5_m_ufUCd`agm! zO!m0l?k`*@@z&b<72gKg(E=usS7e z-+vaq;{&*qc(-2wE5KH3tcK(D^zm2*``RQH%x?5eBK^W^)bVxwf28ePZ!m1| zo&ynfiC8k81xq=Cwir!HjC(E|2`n;7zdQCH-NxT?7cbx%K?LM(i*j?;1;zipc~;9? zwc$dAgDml~_^5RPhTL%>z`_ycZ121Fz`>UTWBK zf3)!1AJC`9%(LV%7<{Q`KoQobESS^ly1#qZ&V|i}X43M4^4CDNm#5A1U&EA!P2~d8 zD&@1wh)#^^A=@7spmaA~VKUV+$xS}#8vX=DNtSo>dMzT7cv;W*dumQ#svhacbBN!5 zl9P<_TVj=i_ljOy$0@`zo94#f9PKrZsPX-E4HDoy*A?YM;}3ov`r!GKMTjnQs8a@6 z+UrN-)P~BgN56^id9A&~`*z4RQAAZ7B9sZ|lg}MHhzZ*#nI2B!L4y=S*OYluAo1UF znxpjV!8PO~QH{bSf!ADyjXzNL{|R~?@X5Y7d(z2w;fNX3B-AJ&=Y;C9q|oPw;B`gt z<1@c9Z=@XYb8}U5eLzo=VdgaJEiA_hYl)Z5fvhH~h{NiX%udJ1<)h1D41$hTl7Tsw zbhYxu1$I*(asZga8E_EkU310JS9xJ9yW?1;l@8zjvFcX3D~B)bTYgl>(y5?@8v}~s z>Vh(oSVT{}oRlAegVTm&IzyebykzX#D3C3Cl4&>CY3q1Z_8_m*r8}G%F1f_^yP}AD zsMDZ3xf#lIn$V(IuHI*hMs3;dSCb}U!gcP&Cd3b&1?jR7G{&!OeFAOI*MyyjHGqy- z$~GavQCsOyqCk^=Ay80pbheHUI#zC?yL%Fb#_W000000a;ql{Q0;5 diff --git a/data/athlytics_sample_exposure.rda b/data/athlytics_sample_exposure.rda deleted file mode 100644 index bab0eea1a639705020a8b3f11b7337c6f889622d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5580 zcmV;-6*KDnH+ooF0004LBHlIv03iV!0000G&sfah9x4@(T>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&q9Ja*lz{?P0@;5q6h&N;GK{%Yu1C8@tVuy^_=S zA-Yx5Z`dHpP>49PY87oY{hW>sJ=D(DGb7RW@T2i-oD%4)=&nA#tw^>^qVn#5HM3}N zV$YrwvHl^qTo-xtUXIRKvX*R9;L#tcLowPZNPeT?GwjbU4aOF^xGM!HmR3gO=h7_B zRPz>7us9ST%i31^#4#Ge0!Qqw3kJdR@+LRfpU62lhf7=2s>8xSH9&Q*D#L5rrFmef z;Cme#OD&PXqGE`HG|fX>hrMNZE*(DzFb{@QFgd*`a_ZxaQEIE)(_m3p+a(BH_T zz>k>#@gRp+8_EqNjoAmvs;hPDJKDVjPWxw}Nn>aKa-ab>CXY;j**Winls&@Wby;>w zo!E$NwGwytt6)LD7W=;4&Wjm0m|vYMs+j}V7klD6;o~1M4r`1sqpemC2G}%!5rF0tE>HJL?ZH-s^S_kg5fL_C>a~S zmi|DQKv*Obr$HNW$GT1ud>6T7tEF3%4g<0p?*kK)uFRSLK+M){NZTp#bZtC*Q8Cyq zXSYSiG0B1>P@!Nr+IAx)M0pM*U7?BQsG!k2=26*)8z=AIfVncSm{8O{3Z`M82C>i7i$aDj&eudo@hX0a{N zcDFX6&hw6+f#+RaDA#~V$>e|y>n$Z)U|HV*7HLmf@z_ktUvChsZ@OE0ZMI6`POK(L zw_ZK1zW3gF71AmVxR$xK&$FZ(G}RZV2Md_Q zw<2LjJ(N?sb3~DF{jgp56s@5*t@dVSq*t1%kU9QR662Pv8y?uuAgGhorpP}H(muBL zO8?Q4%L)b(-Vc0HBU`47H+{_1CFf!aPrKWhu$$|Cx>1tpoB<;fOiuVl?KQ zfy?yW&h7Y&`{m58O;0yzv6ty!5umP4El&(0s7y?wDYVG*3wKM3>Hb_agEaIT98d&L z-YBUaQ;<7#xBm)CIiyvOt7z=#L!uXVcfD-qhe^U#l=rN0XeiY!Lc=Tw6?V1wS|H6ci73eE+G6Th&Z!r2L>D!Lz;SGt{Hg?(c|d zIw*hE-=jama-qoGRox?Q;C-kjVdtObp4)!S_?3d_+j*Nt3DVWR$dJd} z|8Zu|bu?aQzvyN8@Rhm#h;#LhRz6W>g!EYceD5wIr^TW#6Acp#GfMn_?1^kLHKj-R z*z)}?X69ts6PfTboNsyogU8k|WKu0$0;_W%h1Ry)MS*gIdCK~HQ^55qic}7E>M8hj zB5YFat^Acgy}l|X*O0noQu%F5fh|Y3`4uD$&J-eqKaHBn)yHQP&(>Dw?`3l3-|({z zE9jL#6y;|^5nWI&PIv$)(M;E~U7~z|zcr8wTtt}Uu8?5xb$0;?Y*JN@1P3j4%Qf&Y zb_vZt8EtLfnCQN+2%4_O$`vnw_s47m$Y;s)j2f@LCVOpd+Ckq@NEy7DXI8}-?fhlB z)FdgNsnq0niYoh{XIc&pTl)#{RHY*lkm+nAIH>i+S*~u@r--AFD$FF^Y-egvcPBm; zzVf5Hy8COP8PfBG<e6cek*im7!|4@RY43FKA{Hv(=tZn!x1dq;PSRRJuQ9;hJ z{LY&u1^0OjZ&x$K1Rw?y2x7TmD=|=8>O%Q4)Quo+zSh098v5!OicG&IaNcH~s+e5A zYSj#0t1NXK@moizFL&o?vcZ}3yx1Xu^WcVv&=w>m!4+XF{JYrcUG)gOgMTH`Cp)53 zLa7;}N1gD*JX4#BNQ!o0m~?Hq9{IL6UmSnvB^YoinVOxk>^6hK;itj#^R{H4`fCE_ ze$YAUC%YME=xD~a9BXMP)U4zwzQBNs90#75lX51*FB8W4Ne~7q`10Q7vWulcjC8!! zn*+u@d}G#P)#cPPoC@a;HW?WQBq&8-is6Zj0pH4m$e&WD^jUUlsgFOJi7wdSYq~qC z3lIX5TPVxMVF&(i*ImZl?O`#M-)JB*jNR}%OjBpU+@8Yp=|V97QkLMJ@QC9 zDpXq)EpsK8sh~ILue=!M)v4}EK;{B|5QA+hIa!LrJk&!60T+;HVQCtfX%jNNDclkS zU^p&07%oIwNG_55&KoBO(SZd}RUtuxX^3O>xOxoK0{QjY*4Ho=#Ps(+*Ff}Cy!KGQ zWWO+iVGV5`sSb>8A`$M$JE{YQQx0gf7X-CR6owwcBqJE)Z+=sHG{PZ?{l&;o$83)ixDf?zu>W-V8+Z;YH0Ey_HS!zJe2(=Oqv_TOj* z;ChTY>?@30+zRbuM(nagsE{?QJf)jqpgY&PFEBM7&S3dT)$K*py1B47!UVaVXL-rC3d|OynFaM(6d?nXsXRNPmclrqKEhDTc#Hym1{U;iw6pm}u z2+8X+%F@ALJFk(0a_9Jem>-aezcnedtybzUpn&^jfSrny799op)2s1_9b1M-*h~C` zn;KE-E^7y3WA-M>0WG^3rj+qA+2iQ5GjaLp&_VTgpEp-Fj4!cJmg%n01ey6d*|O8& z|Jy39po3v*Tma0`X_P2d4i|lBJ(m(lf&{6`AqcLp^})r)8xT=VwlJ`)9>`)HA6OZZ zNjH2gwj${}f<#3-gbL!$6@majJD0N;3!^U}76Y;*?AtU=uTii#Enw=Peyb`zqrJFN zJbHo{9EL7)9QOBCl~wSmzh!(ilq7it4e@l~Q~panE--N(V-vsnjB_=l_sJjTr}N2ur`2`Fr6@t2b41mxXWOfv9#*%{*&EMc_54pOon zk{YuqGz#=WklxnwAJTAqNb<7!aj7!=6V)(IBi+U1{ou{CzIf&A!w$Cpxj7d>){xVAsku%;$45cmZ zqF6x+-GOkDb6ttL-uf5O{QJe{+s><|T|@?y_sW2iUmFO2z|FL-f9`260R*vIpNuRp z=sESuY5S7y=%W9mvg)(ulS-733V5r&I;;fGK z3Z))BzvOgUcGLAS{G98S-n|dSm4MK^WOwXaad?itMtAoP{~^h6_^s0NVc2?>S2bek zWu+9w%uwF8)IS8zbI3T)&X_}(%&^<{4h}(lNw?$$@Yu4?&TCG{?os!khxf#W)!Z-$ z$0Kb+Ea1uV9LHuzGkUw|D{FSa_4U0|rDWQg(*{`RU;10k#4@K^RbAnW%M; zd_LWjhqJYv?hT7xoB{OA?TO3T#X+_-zD$xw$yGLfImRg8e1b8?jD; zmJxD@C1de+q8On}^YV&si>3{-=pX&dzxIKmC$3;_meoc>1T;Pm>W~!Lf?TPwmq%a$g!j^4U_w0@mU!W~L&toBl?}&XlF&!E}^BP*I*% z?s*aEQ(n1A&j^CIwc`z~SWlMukCUmLvnKjKtU9 z^x@wffP0V8*NJ8gKa?1g0q7$+;8j6mgS6EP#)8$znEe-oT!mL2gz<@+)Z@(M21gU77Pq!J>bZc(}fcSs=<11;dIfmuFZr~adX3f!z&ck=?q%Rfld zi-{*7G1T0*YZGaAB**@iH}n7<%Of{q)>jF9?W8O#vQBM^R{+zP{G0|DN!sk;Af0g<(Je2crO*qE-QKVC3dh#Uf^a`=}= zYiyJybH0PlC{c1syY-{3u2;}clhSoEr(U#8@;EiLuLky7ng>N;Sj^BlW!@(&j)VOQa*vJL9+V`K>M#3}#JIs{;b{7$x0n?*Wd_agjO%V zrXhr67~y(z`CtWxW~tSTt1x%W90yy-p?8N7=Lg$0uL(A?@a6aP)dxcD*~)`Ix#s9^kju{4VFGO7;X!y8Nb<{qEuMYlw_t7vr<1*0 zH_w~u1{n!r0KyRG17^Vz8Y)m&d);a+^z>d}{$*ChKU-Xu+Z*~opisSo$4^V-%^96N zEx&Evm!k9kJELwRDd+Y^a4)F z>g=;b;p;$9Vi80WOBK`rzGf^5J~(BqICGN) zPHRAh^J#`rm7eGdI|oZRTO)8am26wi1P>EI%TNt;GiPO560JU{GPU|j6OY4lwq#Ds zzK791cT}>WjwB`d!lE^RfQh7obV^02EP2gtbQcnCfYkqT_7^_I&@=cqk5kZgy@+Zl zl{N*vw6REf=`Y)cuN}W4>#F>MYLY`ZfGLzOz~`5jom*)W*onQTiZ&k^k1bQF8LkV5 zb-BsWANQQJtY+clJHw?JE&)RKiUt*C@aO0)qTQ?;1sLNr7lMhx{d(Fp&6Sw%V*N|> z)WFX{=p7ZYd0sN(c|;{H2u%xipr*rc_+F)uO+x2}h3YEZl;ca%04$@9=O)$ zs{1f4wU_kP%3kw0{}e1bEP&^uPL&EeaMJwA*s!aKK<;6E>!T^?d6RU{SZ}IL-K=sG z4B$;h@=bX(R>x2QVy*vdMgwKxXO!K)+JH=KX;&H`kx&^M-Rd*-a1G`{wY#oM~_@~0IM-6wV(r^IevQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&q5bK8}IT?P0@;5q6h&N;GK{%Zt5~xD@l`fp`T~ zB+;$sn3#lmy+qfs+|!U9RpX-Vj*0GMmu`3ba$;*?mabS6oB$tpg|2jUB zjE!@Y!5S+!2oQl|i(a=vWA6~`OyCw;yINNWo79=@YXH;Q&6Zn zpWNbNa?wy(SiQMl#4{vE?j>@O(Cd-RM~d^n3ma-VquIk*e#E$Zh1(H# z2&c2DV5}B{h39%i$n3mRg|;*iR8p%}->l-PqP#=)7&L+akd?Zgs3+dKza|oFtf=;3 z5tByuO)cZt@J8K14s@xJYgV?0+8TMZzum9O?z3u0a=ElR>+x9a!h;+W?W|)lAb+&! zZ2^sk==bp?NR-9hBCf%I(!9FC!bs%<5A-aabq;EmOSxTn^1_7 z_l=(C*2w7|X5_ABT53s~EDGd)ckgUF5U6<=M!4o$h9fSiCIH0-2_y!PvvY@OuBdlW zej}0+0j5oQs($s8Fb45tNa$D^tYohBYvh{4rby1unNn%#5dvQYtC=5|t$kWcNfo}g zgCdY>pJ||;!EkJ65re4tyX+eVG!Rc|=t<2>6Gjf9cA;!VqV$}O!5d{`5k-t!susyf zSuA_k%m2>Wt4J?`y>r4qQ6>d_K2MGnfMOe;Q3-SP9BEhabKsc_N)QzC0WwmTF0w|0QXJS90>W=aC5I7@#(Fy$4b&(!b>KLqgp!$OLGOS%xMX z6D78xCr zbOe7ZRDkXUjI^p&zije+hU-6dCqc-+N5HY+Pw;_VQ>x2BEd)2^5h+^wWdHz3!ngAP a0mlcK8~_0O((I@{Fb#_W000000a;q4c;X`f diff --git a/data/sample_acwr.rda b/data/sample_acwr.rda new file mode 100644 index 0000000000000000000000000000000000000000..6b373228c318400850fffe8a1bfa9a5282e7454d GIT binary patch literal 3436 zcmV-y4U_WyH+ooF0004LBHlIv03iV!0000G&sfahH9ZY4T>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&p}JU~r|S_+Nj@s>sFY^T@Ocn!Kb4EmK-y7UMNo zV+N|14Hb;Lm+X6=t8__pN%ipRxw5}GMvR-D zcP{-P#dq3)nt{$er)-4&Bu6GBSQe{al0Xe zjqtXXQ%Cp1yXimOM?T|vJM?Z?kyBueqR@($$Edu;4$B(XW%tgkZ(K@Yb_rH?Lre)K zjuD;&7wxq%;(=30HYADa;omdoK=}A85>^17diaw>j228U$#sGGq(A6L(annrOH&Ul zbi^gmcy_Gj@wlYMT)7kcmSL*skkAzG4GY>XhDoReh(4P`nwgAw)pFc%g%EQLFlY9& z4i!at3S`< zM4R`#@xzlD$CzBnSmmop{!$*%f8$(6p)VG*e7BJOWXF2TR>d8Vg-q>j z;w!^9$y|U4OhMC1umG#RH-$AQ`tDZ{e`yD%)!~#y8ro2Rh;TgGvEv0&gq%j+g~rp_ zluTwZn4djjCKcn0M&ww_3i;aU+;Fg=8x}a~eZO`xpKcMNcO&E%Ll|U^Lk`Wx6=Um+ z_$_&6{9f?jm=F7p$`fLKXmKW$xzI-GQnGqk>;0T7>*az@a zwI)PU@<8Gx61}fvV}Dacb^8a}rQPeG1L?qUWvbFlzcmX|$PbX}DQA8#rXLkK#Cv?K zq{I#=WITpu#gmL$vvD*q`ga3gR;c{)pCz^|$=7@G-s_t$n?^;0`VceDCF=xTfU(0# z4eDmq#xJ?s`1y4BJoYQgp~(VlmgZ2V1|oySj+wurS$~TY8v|Wdod@?iBn}WU_56VN zD3)~y!HK0&QZJdYlspBt{NrBt{Amv(BH*=2p+!|L0;I+9a(iPF%?hrFt!J=-lXyD_r9NFlXU+plzamBK}Op9@hq+K7Dnc4u0uTJiYY z;w$-c)dMh9B*tR(AxdC7{o#2DGn>n!Yq_3%LyEdg*>EiZK}c67;k&3*WCJUjTbt#O z5+spz|96=;$B|E<+@%JtcD2`y`MRnioMIY(AoHraFRO2o?>P37$8rjL@{2b^od4*) zh?GdZCWgBV7h1?UXA8WrsryZdsQt{v9dSj0Oa-|OX`NY~Es0)|N7Q#AwVLH&J_b65t$1$etDt&v8 z;F}9TzLD!VV^%kI%RgUNWw~^xRt#g{S4hG?I`tBFAUD?354YVr#$A)g`|cm5KEEr{02#DOJD~ zL`Q2Dd~B5LnrF%R2HATOv9^=guw1VbIa75_}V2Di7oKV;eP*|77SBH|XwU$gVY^d$GK!b1R-C9XxPj>D%Od6Pc&WPRG23qx!Y4^1S#B#3kR$#X6@F(Yo)Y3Sl{S&ksl*Dj! z9HSFc5c^O^vq2g&E^IWsPKXi@Fki+;`5A^3;grIKe0u$7(v8(XtG2zEh>c7q3iK$o zIp{U`gjZSoP8#+5`3@*kAKe7DRprYalaZyGzsqoL9{>NZCC+NM?_2n)t0T$2RPN9%cYtebUQV&3_Ip z?A%5Bc7POeq(`0{Lm0N|+BvzbUc-fvz~j2H`=g-MneuGzm%Vc_qKPRu-|_I{DVaYXADe_z^TPQ43tH}dY#^KI81@0DAeN$de`7J zeHx4tHmqOW zhG33CH^Qb^T>$Bt7Y>|MDMq1jp76WoiI5)3?W+r7F<7cB9xh%PlA!_RTA9Je@aNX^ zK*DrbXvDPVU<>tiY$HOUYSPeSA|W>$Rvb${vUZCtUI|Z%=Y5Tbv$r_aB4O+iKuq9L z>O4W)G9tk2N<~2Hn1*K-BR9xmzJtLEo$9xpo1Ol`95VFc$YB{)|2#-gNYg~=A236Y z;A@Ie&zEq4^8;k+77cmcjt)uBGqb2AlW(1o?Rsej+YA@mXRsOBwnWCylWBL_kNpVI z@5YlWTX2>&vIO!d>kP+oro6vehh;lFQ}Z>tP_Ec@l9WK|yXI|}$YOOBkP zwBjQ6BBKB-2=yarb;WgljzxdBs`g4PRMfGSPCdb9QA=!?7bD1*@i5I&q8OU*{?*R0 zhp3l+PO$y~Ie$Z~P)ZR(Y%+oe>WgMid!`FmlGK@q@-2<5+uU1;J6#sKVUeC#Tx*CE zOVD{C41waD)wQR2LN9D-X7TM*S-rkKu&G2KRA>?{i~f;|PMlrmQz7*u&=!_?s?3?f zp5?~lU<`v~qoYyo!6N%_q^9=AU&JBLJ)4!eBNo+NXl62y`ITQgo>gLwCq!a^@m?av zz_kgRHl0ua>Zyuiwt703R@h*C+yPVmjHfH;(w{U=Sw=UYs!_X7&$<>*#7c0%oEDkq zbe?2Ympu)~9F8SP_ggo3eV8#imib04l|#&uU$SF&x(@DyJ$a$A`(A zvBu1O>!ds`oCgd70{^oFtrtHJ?rp?tnIMf;Me{camJ6%|CVQx%^QLZ)BuP0p1NzFG zBUvQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&q3GKla9yKS^jUFFjNB_LOi`i;YpF?wi*w9?1m= zeaQ0aSkMIrD$x@7MX;PKyEs&a>|N+|OFMYo1RK0uk4TA*kIhTb#UMr2oBywT2EmH3}sUB5gE(KK79eVz~*hu6Nl zN@S#4fM(~KgyFe3{CbK$x~tg70@ zzz~3;;3HbR8eaBtSUy)yNv-Dba!)VCr40fYqU2mk=tdyp1BFb#_W000000a;pcy#q`D literal 0 HcmV?d00001 diff --git a/data/sample_ef.rda b/data/sample_ef.rda new file mode 100644 index 0000000000000000000000000000000000000000..d0e6ac79f7f3f19f6115ffb222c0668a10123731 GIT binary patch literal 656 zcmV;B0&o5OH+ooF0004LBHlIv03iV!0000G&sfah29*L+T>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&p{anE3Dbuc%Vwtlo_PbZ!HR-YM3{U}ev=d81mF zR7y1GEvM#O+@=QRt(p?bKI@P#qA9TZzDC0|)TCnPMphIwl=O2T1Rvt z1I^_)k2?{+s{*b^)|sjJ#4Gvd@Yj=UW3KVJaA-by@6KI0?nQ1T(? zQa6Xd*{D5KL!;5euF%Lsh*_2n} z*rdcH-6k82WBnwAMwE9)u80}}P)8rC+NM1vY{uuO9J?OQn0jMcsi)6MmgbEHcMUno zR=5gAoo4FCXlw58fUFb#_W000000a;oC^fXog literal 0 HcmV?d00001 diff --git a/data/sample_exposure.rda b/data/sample_exposure.rda new file mode 100644 index 0000000000000000000000000000000000000000..79d377bc7c16f72bb72cf855e05bd562675cac3a GIT binary patch literal 3804 zcmV<24kPjXH+ooF0004LBHlIv03iV!0000G&sfahG_($$T>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&q1qMeI*lI<15m&HJZX8#*aSf$b`vrDWv>SaGw4DQ&IjDgu-J)M1^g1sf1R-bl;|L3eHGud zW9dy1*RZ1x#d42Ow2=n&lx!NQC&#T54#YAsMAg}-vZ5`Q?T6MnnS547M{I(q%!2W&}@*%r>N|ul6F@=&ldu8lU(?uv`Oe|b-B*4P@Mb+eN)-`IZn2Db5h>m zf}#<$y3=Lcblfs zNWSh5_V}Hnz3gIYFvu`1M_IJYM^l*-aWkg4#?QJX!*9H@J9wR(qvhYpzEXCk6l9Lz zf6?wOV~=M`)g@hMo%Hu!V=lV`?;j-$zYT`}oHVj}SNbQ2x#5PzK*)SUJ59$-1tg`O z_~ao6>NyLGE>&t6`!TWBL+@vo6g(G+br)LION8wY>=7e(W23B&@Zcm%2uGuNS zKUgK>+&wTF5br$1HD6E8)+BM3*v^#mp^E>fvd}R6z5?woxk;>bxkK@Hfji;Iz z4R#H*nP z5jhoeh<-2V8sYDBGz%lJde3Nz%{LM&jTEvc`_UHOE&{iyMK^cd8DlmQL z!>QfN_Zr9vFfcT>_K~r==f@mHJmOFSwisa7Bn6%Yim(B2jbbC;|$rG6xIkD@CX3z3PEJ@Y!6< zyp~h>VazP1;AwFFE*I|dj8%OWxVQ1Pj8X_-zXXKn6*v&c;X6DZNg@n!ed4QC=ZdX~ z-Mq)kZFx$AdOfGvkwbV7o;(j&Pj`^X$>sE+ zB!{!IZV#dm$f_9tt#h(|@E`#K)NaiH@nmp7bMV|crzB8^6eKguB^n`ljpwuSXZ8aIJ=z#qNkhd^h|Zp`4w={^ z`q*sc_f|jjYUc8_=9?ePn0!$`UX`)hWX{s{NB0l!B^Ioayo87e3+*AivTI0&&&(X} z#jnm(b6L@I2#f}s74LVITTR*$l;(!bl3mrZ>w3Swh!<=&@cDf~uqy{$Cr`7&Dg7Ly zhEUsJCednraufk-1~ty@gw~Sl+kD)k2O5vN?e)2>IY)%1=BJdPSxG%ZO=V9Ql_qaS zw76MHPslYLv6lw647l(7Qg`(F*|*}mc{+GNU7cVcm*g(td$zHXPnGb~A-XCnX7|9a z9~dQRS^;s2+V3ASrU3B!z_p2WC1>cZ6F=?Xyt@fu9lLqRDdif2iSQfy#@Y_=>N0;z zi-C;pn2em3>Y^KOJAkH{)2vi_}Z~x0pgSM{pK9z=^a!0 z{9tqTjwt$zq$swHP0KIDa-Yj~Vic&7D2#opd#CO=l0#v|E3C$>@j?lGqkhcfrQDj& zpC*q8bIlAfNvc#iNNZvvKZ~Z)tme9oFmR;+K8HlR{5SsM^(B`&-#th@)l%IGeZH>U z=g^R39Bx|yD&Ic@IWjUdiD7zvM{e3o<@l!`^h(K(0B)Q!xL7Y~H6G+|7HM)wjIUtr zh3mnX?nPCoy3$zM5eUHkNC`OEYNS8?2zND9y9XSKBvI@}T(Q1QW1|l?&qe`a7AGiw z#ntVf4KrXW4=eT-FD$pyJp~Hj^elYDmAT`@uAe*9AZr{ar$+q~L`Ccr#MrmRT-h`y zlwrTY3xuH0H{DKP+K%YOz&=S$L|8>>2v~+W><-#Oh?-Yvn%LzUT>n#)l``Qn_ohn# zy=L}M#_B?>-&pS!Ur|>M>awTWABk+J)5#d_Gsut!xEC^l{id%qLaWU76UGeTyFg+(-+cyG>vc0K2~^Yq=*m|$x z9=0&vB@`1_WiN2GseVBS%v1$B@QUH+EmZ5IvYS>GWEs{RAk(!9+jhWm-&1p*06Qj;=bgAH0iclUH8ZFAc}Iv|GPkq=@~96bXHqnY^+OXX1g4cE#48Wb;->kqdrta+ZL*ztx8e;TR=;#D1X+*=DqPRj>kO#54|=i~>M`hLUxZJeTw#cF z2{*Si(R4t4-p^xXuzdE?b5qqfP^Ql~NN~62@HiK7Vw1ws13slK-N2>{mLW9E+4vDp ztGC=ZM&=!P_m6HOF?XSofN0{IGsTkkApAWm=X$l<`iR^L(^9< zNRcXr3S#0S<(8F#9R-tbk0ZxR{qdd(F9UJ^ef9x!hKaQ1h4`japH)%3or!Y~Kows` z@?2BzCYcVlY?R$Y>F%13T>^3#9;&h%qmn77@P~~WktkJ`I{%Q?r@DPEUVl`#kx%b2 zs|`ei2s#J?R-r1KcEfrQkp1O(Zfi#Bg&8zKgV#d4i#=!kb;rx>=J{Fofa$Jkpwn6$urxs8tFVeR0`p@0&L$PS;233$_K z(~;ERs-6FX300Y2?xM;Q1ux2#ztij@8EJ9mR^<~Op12%FjP&z0B@Bv;?q$xU)~6DR zkN)9rydaK`EdV!%2tOqan15QLZ2y@xPn`i(XtLihkXL9bS@maBPNI(pPJFUe`34)= zH{GuD8nJtGT%5M^3L`po+Nuu-oD@yqy*Y?whUOi{T0YR+hO7>sXpmea1jG@58&y65 z986z~Hwik>i~X;rMht}-C-e+&`I&EeVNXE!wzSqo@`~ILDjTkok!8g~sw>Tw`)Ody z<+wymBSG((-Z5So{M?3+Eg%;--N~4dcb~7dA2cQHlI##h0NwCWZmuf% z2o98Ks@u6|S>P-TpBsiUk4!u>ide@TmwAaT_`3x@DYosAcH2iXiqd;n`BNRwVMT0C zTI*fTm`#j>%rbH{_5@g3(EP-tQ5!E92|?9nFMB4_4GA#Qa`~eBFTffEMOh&eN>p1NokUq~ zo5e1=vHkt&jVJR$$y`UZgt4o=5vThCx1MQZHhYJ-N&fNay=lxiR7X{*C;-ijoEK28 zQxLK>M5+5K9iyGt_~}w|N+^C=QC>!LD*hpiMcB9&%UdFzq;aqpF@G|T7A zM?^bGL|T_*m2GSfHq>`QB0@sEr>^;I&Y1@r$E2F?Uajf?0001FiCo(N0k$2rX#fC$ SIUM>vFb#_W000000a;q{nNubJ literal 0 HcmV?d00001 diff --git a/data/sample_pbs.rda b/data/sample_pbs.rda new file mode 100644 index 0000000000000000000000000000000000000000..ad10179f22ba80984639dfaea170c5d027fc761a GIT binary patch literal 992 zcmV<610VeTH+ooF0004LBHlIv03iV!0000G&sfah4h{pPT>vQ&2UKVgRpfklJ z?~=1r{AJ%Ati2SL%)4qkW}8sx6&p|UkI<#1_+NkC*WZNR71f5dGyiK{3-YDdjsrUJ znTzMsd2LT3*w=+8nbBi{v`KuDt`11SY{F6Sc}*Jyk5|1+f!AX6WyDyBoR{%ij*BDt z-Xe&O0do+mrUfz>e+X5)X2c-}LB>zAfJp8@=G0h_+ggynHA_1N=2Nw0cfy_{PPq0o zjNpcdNG?Uv-wyu`>e8DmJ2@hsMx%FS7lQ|Fs_lMF3(^7zgRk1uaI^99;eFzDMYg^r z4k(S5^HO8?l$NB&NLxM7VY9D@SKY5f4o75u&D(#?-|Wj9vgcKJcnh&9`b2~NCRdEZ z{{Bs*^KjsQaB1%sZtyehD=!+t@SYRuN$UG?#0^~Nv7tlZSP?UR?jR`6F9VD)``6yM zA|!2(hg$mtp?Q#+A^J5$9Nk<=5wRFb2B=8Y8`k(tcbY>bRQJBn-V~qXCa}i z5i&4!bUI+?TfpAT3vthUb>9uYC;cPnusxOz?+`h`i7HR7vkXL$;Bpxa0?pv%kgmje z3}+u5I+>P&Z*o9dHU&a8DxG1(Wy>)1f9cJwDElgZpW2J>3+VmF0+VpZuJsgB|$nYTR`PuNpY zC&*}+;k>5X$`K%6%!9GE3zO>&EkFqy9%&1vG$a;-$mjK>1C&g6BRSHUh54!$QoIu3 z>J^LGLiI14hG1DtkuFi-EA94iG4j>O`d8#rCT%2AmlpMpf&1H3OVh>8>gsSw=Wmd3 ziJaP(qlFE^!kmbsuB$U{U32g({^qX>UJH|@#lMY(Y>@n2m~{ik@kjOOQBES)VO-tZ zNkOc&2BvrqzC_rgJ(AjCXE@HjhwBE~RotS5c>hGXf(iVUoZ1EL{uzcbg&N28PON=b zLf#PiA7^hvX1o_X>vwTuB07IzZzvC3xlabPtl;=H5yEjsr5edGYK(gDo@JJm`FqX` zM9B*2#8*`c-wuJ^_y8%_PkaK^Im2Ef7zq_+Dv>sDkFiNqxOhu_jmSn0OuKA-TajZ$ zPWi#A_Jj`_glIKAoY%&C{JEm4OwSfmp3}n@Y89c(L(}S*jBMGyxOWb=OKydwsg6U}S 0) { - p1 <- plot_acwr(acwr_df = athlytics_sample_acwr) +data("sample_acwr") +if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { + p1 <- plot_acwr(acwr_df = sample_acwr) ggsave("man/figures/example_plot_acwr.png", p1, width = plot_width, height = plot_height, dpi = dpi) message("✓ Saved: man/figures/example_plot_acwr.png") @@ -24,8 +24,8 @@ if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { # 2. plot_acwr_enhanced() example message("Generating plot_acwr_enhanced example...") -if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { - p2 <- plot_acwr_enhanced(acwr_df = athlytics_sample_acwr) +if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { + p2 <- plot_acwr_enhanced(acwr_df = sample_acwr) ggsave("man/figures/example_plot_acwr_enhanced.png", p2, width = plot_width, height = plot_height, dpi = dpi) message("✓ Saved: man/figures/example_plot_acwr_enhanced.png") @@ -33,13 +33,13 @@ if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { # 3. plot_acwr_comparison() example message("Generating plot_acwr_comparison example...") -if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { +if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { # Create EWMA version for comparison - acwr_ewma <- athlytics_sample_acwr + acwr_ewma <- sample_acwr acwr_ewma$acwr_smooth <- acwr_ewma$acwr_smooth * runif(nrow(acwr_ewma), 0.95, 1.05) p3 <- plot_acwr_comparison( - acwr_ra = athlytics_sample_acwr, + acwr_ra = sample_acwr, acwr_ewma = acwr_ewma ) ggsave("man/figures/example_plot_acwr_comparison.png", p3, @@ -49,9 +49,9 @@ if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { # 4. plot_ef() example message("Generating plot_ef example...") -data("athlytics_sample_ef") -if (!is.null(athlytics_sample_ef) && nrow(athlytics_sample_ef) > 0) { - p4 <- plot_ef(ef_df = athlytics_sample_ef) +data("sample_ef") +if (!is.null(sample_ef) && nrow(sample_ef) > 0) { + p4 <- plot_ef(ef_df = sample_ef) ggsave("man/figures/example_plot_ef.png", p4, width = plot_width, height = plot_height, dpi = dpi) message("✓ Saved: man/figures/example_plot_ef.png") @@ -59,9 +59,9 @@ if (!is.null(athlytics_sample_ef) && nrow(athlytics_sample_ef) > 0) { # 5. plot_decoupling() example message("Generating plot_decoupling example...") -data("athlytics_sample_decoupling") -if (!is.null(athlytics_sample_decoupling) && nrow(athlytics_sample_decoupling) > 0) { - p5 <- plot_decoupling(decoupling_df = athlytics_sample_decoupling) +data("sample_decoupling") +if (!is.null(sample_decoupling) && nrow(sample_decoupling) > 0) { + p5 <- plot_decoupling(decoupling_df = sample_decoupling) ggsave("man/figures/example_plot_decoupling.png", p5, width = plot_width, height = plot_height, dpi = dpi) message("✓ Saved: man/figures/example_plot_decoupling.png") @@ -69,9 +69,9 @@ if (!is.null(athlytics_sample_decoupling) && nrow(athlytics_sample_decoupling) > # 6. plot_exposure() example message("Generating plot_exposure example...") -data("athlytics_sample_exposure") -if (!is.null(athlytics_sample_exposure) && nrow(athlytics_sample_exposure) > 0) { - p6 <- plot_exposure(exposure_df = athlytics_sample_exposure, risk_zones = TRUE) +data("sample_exposure") +if (!is.null(sample_exposure) && nrow(sample_exposure) > 0) { + p6 <- plot_exposure(exposure_df = sample_exposure, risk_zones = TRUE) ggsave("man/figures/example_plot_exposure.png", p6, width = plot_width, height = plot_height, dpi = dpi) message("✓ Saved: man/figures/example_plot_exposure.png") @@ -79,10 +79,10 @@ if (!is.null(athlytics_sample_exposure) && nrow(athlytics_sample_exposure) > 0) # 7. plot_pbs() example message("Generating plot_pbs example...") -data("athlytics_sample_pbs") -if (!is.null(athlytics_sample_pbs) && nrow(athlytics_sample_pbs) > 0) { +data("sample_pbs") +if (!is.null(sample_pbs) && nrow(sample_pbs) > 0) { # Prepare data - sample_pbs_for_plot <- athlytics_sample_pbs + sample_pbs_for_plot <- sample_pbs if ("date" %in% names(sample_pbs_for_plot) && !"activity_date" %in% names(sample_pbs_for_plot)) { names(sample_pbs_for_plot)[names(sample_pbs_for_plot) == "date"] <- "activity_date" } @@ -109,7 +109,7 @@ if (!is.null(athlytics_sample_pbs) && nrow(athlytics_sample_pbs) > 0) { # 8. plot_with_reference() example message("Generating plot_with_reference example...") -if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { +if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { # Create a simple reference band reference_data <- data.frame( lower = 0.8, @@ -117,7 +117,7 @@ if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { label = "Sweet Spot" ) - p8 <- ggplot(athlytics_sample_acwr, aes(x = date, y = acwr_smooth)) + + p8 <- ggplot(sample_acwr, aes(x = date, y = acwr_smooth)) + geom_line(color = athlytics_palette_nature()[1], linewidth = 1.2) + geom_hline(yintercept = c(0.8, 1.3), linetype = "dashed", alpha = 0.5) + labs( diff --git a/man/Athlytics-package.Rd b/man/Athlytics-package.Rd new file mode 100644 index 0000000..0b0cc4c --- /dev/null +++ b/man/Athlytics-package.Rd @@ -0,0 +1,102 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Athlytics-package.R +\docType{package} +\name{Athlytics-package} +\alias{Athlytics-package} +\alias{Athlytics} +\title{Athlytics: Academic R Package for Sports Physiology Analysis from Local 'Strava' Data} +\description{ +An open-source computational framework for longitudinal analysis of exercise physiology metrics using local 'Strava' data exports. Designed for personal analysis and sports science applications, this package provides standardized functions to calculate and visualize key physiological indicators including Acute:Chronic Workload Ratio (ACWR), Efficiency Factor (EF), and training load metrics. + +Athlytics is an open-source computational framework for longitudinal analysis +of exercise physiology metrics using local Strava data exports. Designed for +personal analysis and sports science applications, this package provides +standardized functions to calculate and visualize key physiological indicators. +} +\section{Main Functions}{ + +\strong{Data Loading:} +\itemize{ +\item \code{\link{load_local_activities}}: Load activities from Strava export ZIP or directory +\item \code{\link{parse_activity_file}}: Parse individual FIT/TCX/GPX files +} + +\strong{Training Load Analysis:} +\itemize{ +\item \code{\link{calculate_acwr}}: Calculate Acute:Chronic Workload Ratio +\item \code{\link{calculate_acwr_ewma}}: ACWR using exponentially weighted moving averages +\item \code{\link{calculate_exposure}}: Calculate training load exposure metrics +} + +\strong{Physiological Metrics:} +\itemize{ +\item \code{\link{calculate_ef}}: Calculate Efficiency Factor (EF) +\item \code{\link{calculate_decoupling}}: Calculate cardiovascular decoupling +\item \code{\link{calculate_pbs}}: Calculate personal bests +} + +\strong{Visualization:} +\itemize{ +\item \code{\link{plot_acwr}}, \code{\link{plot_acwr_enhanced}}: Plot ACWR trends +\item \code{\link{plot_ef}}: Plot Efficiency Factor trends +\item \code{\link{plot_decoupling}}: Plot decoupling analysis +\item \code{\link{plot_exposure}}: Plot training load exposure +\item \code{\link{plot_pbs}}: Plot personal bests progression +} + +\strong{Quality Control & Cohort Analysis:} +\itemize{ +\item \code{\link{flag_quality}}: Flag activities based on quality criteria +\item \code{\link{summarize_quality}}: Summarize stream quality flags +\item \code{\link{calculate_cohort_reference}}: Generate cohort reference bands +} +} + +\section{Sample Datasets}{ + +The package includes simulated datasets for examples and testing: +\itemize{ +\item \code{\link{sample_acwr}}: Sample ACWR data +\item \code{\link{sample_ef}}: Sample Efficiency Factor data +\item \code{\link{sample_decoupling}}: Sample decoupling data +\item \code{\link{sample_exposure}}: Sample exposure data +\item \code{\link{sample_pbs}}: Sample personal bests data +} +} + +\section{Getting Started}{ + + +\if{html}{\out{

}}\preformatted{library(Athlytics) + +# Load your Strava export +activities <- load_local_activities("path/to/strava_export.zip") + +# Calculate ACWR +acwr_data <- calculate_acwr(activities, activity_type = "Run") + +# Visualize +plot_acwr(acwr_data) +}\if{html}{\out{
}} +} + +\seealso{ +Useful links: +\itemize{ + \item \url{https://hzacode.github.io/Athlytics/} + \item \url{https://github.com/HzaCode/Athlytics} + \item Report bugs at \url{https://github.com/HzaCode/Athlytics/issues} +} + + +\itemize{ +\item Package website: \url{https://hzacode.github.io/Athlytics/} +\item GitHub repository: \url{https://github.com/HzaCode/Athlytics} +\item Strava: \url{https://www.strava.com/} +} +} +\author{ +\strong{Maintainer}: Zhiang He \email{ang@hezhiang.com} + +} +\keyword{internal} diff --git a/man/add_reference_bands.Rd b/man/add_reference_bands.Rd index 3d3d47f..367c04b 100644 --- a/man/add_reference_bands.Rd +++ b/man/add_reference_bands.Rd @@ -15,7 +15,7 @@ add_reference_bands( \arguments{ \item{p}{A ggplot object (typically from plot_acwr or similar).} -\item{reference_data}{A data frame from \code{cohort_reference()}.} +\item{reference_data}{A data frame from \code{calculate_cohort_reference()}.} \item{bands}{Character vector specifying which bands to plot. Options: "p25_p75" (inner quartiles), "p05_p95" (outer 5-95 range), "p50" (median). diff --git a/man/athlytics_colors_acwr_zones.Rd b/man/athlytics_colors_acwr_zones.Rd index 731f000..db71ecc 100644 --- a/man/athlytics_colors_acwr_zones.Rd +++ b/man/athlytics_colors_acwr_zones.Rd @@ -19,6 +19,6 @@ Standardized colors for ACWR risk zones following sports science conventions. \examples{ # Get ACWR zone colors colors <- athlytics_colors_acwr_zones() -colors$safe # Returns green color code +colors$safe # Returns green color code } diff --git a/man/athlytics_colors_ef.Rd b/man/athlytics_colors_ef.Rd index e002662..d91ee32 100644 --- a/man/athlytics_colors_ef.Rd +++ b/man/athlytics_colors_ef.Rd @@ -19,6 +19,6 @@ Colors for efficiency factor trends by activity type. \examples{ # Get EF colors by sport colors <- athlytics_colors_ef() -colors$run # Navy for running +colors$run # Navy for running } diff --git a/man/athlytics_colors_training_load.Rd b/man/athlytics_colors_training_load.Rd index 279ab0e..c565992 100644 --- a/man/athlytics_colors_training_load.Rd +++ b/man/athlytics_colors_training_load.Rd @@ -18,6 +18,6 @@ Colors for acute and chronic training load visualization. \examples{ # Get training load colors colors <- athlytics_colors_training_load() -colors$acute # Red for acute load +colors$acute # Red for acute load } diff --git a/man/athlytics_palette_academic.Rd b/man/athlytics_palette_academic.Rd index b04863a..f433350 100644 --- a/man/athlytics_palette_academic.Rd +++ b/man/athlytics_palette_academic.Rd @@ -14,9 +14,6 @@ Low-saturation, elegant palette suitable for formal publications and technical reports. Emphasizes clarity over visual impact. } \examples{ -\dontrun{ -ggplot2::ggplot(data, ggplot2::aes(x, y, color = group)) + - ggplot2::geom_line() + - ggplot2::scale_color_manual(values = athlytics_palette_academic()) -} +# View the palette colors +athlytics_palette_academic() } diff --git a/man/athlytics_palette_cell.Rd b/man/athlytics_palette_cell.Rd index b300a03..a96853f 100644 --- a/man/athlytics_palette_cell.Rd +++ b/man/athlytics_palette_cell.Rd @@ -16,6 +16,6 @@ Balances professional appearance with visual clarity. \examples{ # Get Cell palette colors colors <- athlytics_palette_cell() -colors[1] # Blue +colors[1] # Blue } diff --git a/man/athlytics_palette_nature.Rd b/man/athlytics_palette_nature.Rd index 0ffdb34..c348313 100644 --- a/man/athlytics_palette_nature.Rd +++ b/man/athlytics_palette_nature.Rd @@ -14,9 +14,9 @@ Professional, colorblind-friendly palette based on Nature journal's visualization guidelines. Suitable for multi-series plots. } \examples{ -\dontrun{ -ggplot2::ggplot(data, ggplot2::aes(x, y, color = group)) + - ggplot2::geom_line() + - ggplot2::scale_color_manual(values = athlytics_palette_nature()) -} +# View the palette colors +athlytics_palette_nature() + +# Display as color swatches +barplot(rep(1, 9), col = athlytics_palette_nature(), border = NA) } diff --git a/man/athlytics_palette_science.Rd b/man/athlytics_palette_science.Rd index 6e3df83..56b494b 100644 --- a/man/athlytics_palette_science.Rd +++ b/man/athlytics_palette_science.Rd @@ -16,6 +16,6 @@ Conservative and widely accepted in scientific community. \examples{ # Get Science palette colors colors <- athlytics_palette_science() -colors[1] # Dark blue +colors[1] # Dark blue } diff --git a/man/athlytics_palette_vibrant.Rd b/man/athlytics_palette_vibrant.Rd index d3d4b7d..91e1e2a 100644 --- a/man/athlytics_palette_vibrant.Rd +++ b/man/athlytics_palette_vibrant.Rd @@ -14,9 +14,6 @@ High-saturation palette optimized for presentations and posters. Maximum visual impact while maintaining colorblind accessibility. } \examples{ -\dontrun{ -ggplot2::ggplot(data, ggplot2::aes(x, y, fill = category)) + - ggplot2::geom_bar(stat = "identity") + - ggplot2::scale_fill_manual(values = athlytics_palette_vibrant()) -} +# View the palette colors +athlytics_palette_vibrant() } diff --git a/man/calculate_acwr.Rd b/man/calculate_acwr.Rd index 264b942..a5fa131 100644 --- a/man/calculate_acwr.Rd +++ b/man/calculate_acwr.Rd @@ -129,8 +129,8 @@ For cohort analyses, add an \code{athlete_id} column before calculation and use } \examples{ # Example using simulated data (Note: sample data is pre-calculated, shown for demonstration) -data(athlytics_sample_acwr) -print(head(athlytics_sample_acwr)) +data(sample_acwr) +print(head(sample_acwr)) \dontrun{ # Example using local Strava export data @@ -145,16 +145,20 @@ activities <- load_local_activities("export_12345678.zip") activities <- load_local_activities("strava_export_data/activities.csv") # Step 3: Calculate ACWR for Runs (using distance) -run_acwr <- calculate_acwr(activities_data = activities, - activity_type = "Run", - load_metric = "distance_km") +run_acwr <- calculate_acwr( + activities_data = activities, + activity_type = "Run", + load_metric = "distance_km" +) print(tail(run_acwr)) # Calculate ACWR for Rides (using TSS, requires FTP) -ride_acwr_tss <- calculate_acwr(activities_data = activities, - activity_type = "Ride", - load_metric = "tss", - user_ftp = 280) +ride_acwr_tss <- calculate_acwr( + activities_data = activities, + activity_type = "Ride", + load_metric = "tss", + user_ftp = 280 +) print(tail(ride_acwr_tss)) # Plot the results @@ -175,9 +179,10 @@ cohort_data <- dplyr::bind_rows(athlete1, athlete2) # Calculate ACWR for each athlete using group_modify() cohort_acwr <- cohort_data \%>\% dplyr::group_by(athlete_id) \%>\% - dplyr::group_modify(~ calculate_acwr(.x, - activity_type = "Run", - load_metric = "duration_mins")) \%>\% + dplyr::group_modify(~ calculate_acwr(.x, + activity_type = "Run", + load_metric = "duration_mins" + )) \%>\% dplyr::ungroup() # View results @@ -196,5 +201,5 @@ high chronic workload may decrease injury risk in elite rugby league players. \code{\link{plot_acwr}} for visualization, \code{\link{calculate_acwr_ewma}} for EWMA-based ACWR, \code{\link{load_local_activities}} for data loading, -\code{\link{cohort_reference}} for multi-athlete comparisons +\code{\link{calculate_cohort_reference}} for multi-athlete comparisons } diff --git a/man/calculate_acwr_ewma.Rd b/man/calculate_acwr_ewma.Rd index 78e02b7..56859f2 100644 --- a/man/calculate_acwr_ewma.Rd +++ b/man/calculate_acwr_ewma.Rd @@ -89,8 +89,12 @@ and percentiles form the confidence bands. This accounts for temporal correlatio in training load patterns. } \examples{ +# Example using pre-calculated sample data +data("sample_acwr", package = "Athlytics") +head(sample_acwr) + \dontrun{ -# Load local activities +# Full workflow with real data - Load local activities activities <- load_local_activities("export_12345678.zip") # Calculate ACWR using Rolling Average (RA) diff --git a/man/cohort_reference.Rd b/man/calculate_cohort_reference.Rd similarity index 71% rename from man/cohort_reference.Rd rename to man/calculate_cohort_reference.Rd index efe8e0a..f61c2ff 100644 --- a/man/cohort_reference.Rd +++ b/man/calculate_cohort_reference.Rd @@ -1,9 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohort_reference.R -\name{cohort_reference} +\name{calculate_cohort_reference} +\alias{calculate_cohort_reference} \alias{cohort_reference} \title{Calculate Cohort Reference Percentiles} \usage{ +calculate_cohort_reference( + data, + metric = "acwr_smooth", + by = c("sport"), + probs = c(0.05, 0.25, 0.5, 0.75, 0.95), + min_athletes = 5, + date_col = "date" +) + cohort_reference( data, metric = "acwr_smooth", @@ -58,8 +68,31 @@ athlete metrics to their peers. Common use cases: statistical confidence intervals for individual values. } \examples{ +# Example using sample data to create a mock cohort +data("sample_acwr", package = "Athlytics") + +# Simulate a cohort by duplicating with different athlete IDs +cohort_mock <- dplyr::bind_rows( + dplyr::mutate(sample_acwr, athlete_id = "A1", sport = "Run"), + dplyr::mutate(sample_acwr, + athlete_id = "A2", sport = "Run", + acwr_smooth = acwr_smooth * runif(nrow(sample_acwr), 0.9, 1.1) + ), + dplyr::mutate(sample_acwr, + athlete_id = "A3", sport = "Run", + acwr_smooth = acwr_smooth * runif(nrow(sample_acwr), 0.85, 1.15) + ) +) + +# Calculate reference percentiles (min_athletes = 2 for demo) +reference <- calculate_cohort_reference(cohort_mock, + metric = "acwr_smooth", + by = "sport", min_athletes = 2 +) +head(reference) + \dontrun{ -# Load activities for multiple athletes +# Full workflow with real data - Load activities for multiple athletes athlete1 <- load_local_activities("athlete1_export.zip") \%>\% mutate(athlete_id = "athlete1") athlete2 <- load_local_activities("athlete2_export.zip") \%>\% @@ -73,10 +106,10 @@ cohort_data <- bind_rows(athlete1, athlete2, athlete3) # Calculate ACWR for each athlete cohort_acwr <- cohort_data \%>\% group_by(athlete_id) \%>\% - group_modify(~calculate_acwr_ewma(.x)) + group_modify(~ calculate_acwr_ewma(.x)) # Calculate reference percentiles -reference <- cohort_reference( +reference <- calculate_cohort_reference( cohort_acwr, metric = "acwr_smooth", by = c("sport"), diff --git a/man/calculate_decoupling.Rd b/man/calculate_decoupling.Rd index dc00ee3..3c9f8d5 100644 --- a/man/calculate_decoupling.Rd +++ b/man/calculate_decoupling.Rd @@ -82,8 +82,8 @@ and the efficiency factor (output/HR) is compared between halves. } \examples{ # Example using simulated data -data(athlytics_sample_decoupling) -print(head(athlytics_sample_decoupling)) +data(sample_decoupling) +print(head(sample_decoupling)) \dontrun{ # Load local activities @@ -91,11 +91,11 @@ activities <- load_local_activities("strava_export_data/activities.csv") # Calculate Pace/HR decoupling for recent runs run_decoupling <- calculate_decoupling( - activities_data = activities, - export_dir = "strava_export_data", - activity_type = "Run", - decouple_metric = "pace_hr", - start_date = "2024-01-01" + activities_data = activities, + export_dir = "strava_export_data", + activity_type = "Run", + decouple_metric = "pace_hr", + start_date = "2024-01-01" ) print(tail(run_decoupling)) diff --git a/man/calculate_ef.Rd b/man/calculate_ef.Rd index 40020cb..dca5370 100644 --- a/man/calculate_ef.Rd +++ b/man/calculate_ef.Rd @@ -142,23 +142,27 @@ rather than absolute comparisons with other athletes. } \examples{ # Example using simulated data -data(athlytics_sample_ef) -print(head(athlytics_sample_ef)) +data(sample_ef) +print(head(sample_ef)) \dontrun{ # Example using local Strava export data activities <- load_local_activities("strava_export_data/activities.csv") # Calculate Pace/HR efficiency factor for Runs -ef_data_run <- calculate_ef(activities_data = activities, - activity_type = "Run", - ef_metric = "pace_hr") +ef_data_run <- calculate_ef( + activities_data = activities, + activity_type = "Run", + ef_metric = "pace_hr" +) print(tail(ef_data_run)) # Calculate Power/HR efficiency factor for Rides -ef_data_ride <- calculate_ef(activities_data = activities, - activity_type = "Ride", - ef_metric = "power_hr") +ef_data_ride <- calculate_ef( + activities_data = activities, + activity_type = "Ride", + ef_metric = "power_hr" +) print(tail(ef_data_ride)) } } diff --git a/man/calculate_exposure.Rd b/man/calculate_exposure.Rd index 1ddd0f7..65f8c7f 100644 --- a/man/calculate_exposure.Rd +++ b/man/calculate_exposure.Rd @@ -55,8 +55,8 @@ accurate initial CTL. Requires FTP/HR parameters for TSS/HRSS metrics. } \examples{ # Example using simulated data -data(athlytics_sample_exposure) -print(head(athlytics_sample_exposure)) +data(sample_exposure) +print(head(sample_exposure)) \dontrun{ # Example using local Strava export data diff --git a/man/calculate_pbs.Rd b/man/calculate_pbs.Rd index 40fbe42..5544b42 100644 --- a/man/calculate_pbs.Rd +++ b/man/calculate_pbs.Rd @@ -48,8 +48,8 @@ must be long enough to contain the target distance segments. } \examples{ # Example using simulated data -data(athlytics_sample_pbs) -print(head(athlytics_sample_pbs)) +data(sample_pbs) +print(head(sample_pbs)) \dontrun{ # Load local activities diff --git a/man/flag_quality.Rd b/man/flag_quality.Rd index dbe6725..ebcdf36 100644 --- a/man/flag_quality.Rd +++ b/man/flag_quality.Rd @@ -73,20 +73,19 @@ The function is sport-aware and adjusts thresholds accordingly. All thresholds are configurable to accommodate different athlete profiles and data quality. } \examples{ -\dontrun{ # Create sample activity stream data +set.seed(42) stream_data <- data.frame( time = seq(0, 3600, by = 1), - heartrate = rnorm(3601, mean = 150, sd = 10), - watts = rnorm(3601, mean = 200, sd = 20), - velocity_smooth = rnorm(3601, mean = 3.5, sd = 0.3) + heartrate = pmax(60, pmin(200, rnorm(3601, mean = 150, sd = 10))), + watts = pmax(0, rnorm(3601, mean = 200, sd = 20)), + velocity_smooth = pmax(0, rnorm(3601, mean = 3.5, sd = 0.3)) ) # Flag quality issues flagged_data <- flag_quality(stream_data, sport = "Run") # Check summary -summary(flagged_data$quality_score) -table(flagged_data$flag_any) -} +cat("Quality score range:", range(flagged_data$quality_score), "\n") +cat("Flagged points:", sum(flagged_data$flag_any), "\n") } diff --git a/man/plot_acwr.Rd b/man/plot_acwr.Rd index 0569a0b..89c60fe 100644 --- a/man/plot_acwr.Rd +++ b/man/plot_acwr.Rd @@ -67,8 +67,8 @@ ACWR is calculated as acute load / chronic load. A ratio of 0.8-1.3 is often con } \examples{ # Example using pre-calculated sample data -data("athlytics_sample_acwr", package = "Athlytics") -p <- plot_acwr(athlytics_sample_acwr) +data("sample_acwr", package = "Athlytics") +p <- plot_acwr(sample_acwr) print(p) \dontrun{ @@ -76,16 +76,20 @@ print(p) activities <- load_local_activities("strava_export_data/activities.csv") # Plot ACWR trend for Runs (using duration as load metric) -plot_acwr(data = activities, - activity_type = "Run", - load_metric = "duration_mins", - acute_period = 7, - chronic_period = 28) +plot_acwr( + data = activities, + activity_type = "Run", + load_metric = "duration_mins", + acute_period = 7, + chronic_period = 28 +) # Plot ACWR trend for Rides (using TSS as load metric) -plot_acwr(data = activities, - activity_type = "Ride", - load_metric = "tss", - user_ftp = 280) # FTP value is required +plot_acwr( + data = activities, + activity_type = "Ride", + load_metric = "tss", + user_ftp = 280 +) # FTP value is required } } diff --git a/man/plot_acwr_comparison.Rd b/man/plot_acwr_comparison.Rd index 6d37d01..fcec85b 100644 --- a/man/plot_acwr_comparison.Rd +++ b/man/plot_acwr_comparison.Rd @@ -25,13 +25,13 @@ Creates a faceted plot comparing Rolling Average and EWMA ACWR calculations. } \examples{ # Example using sample data -data("athlytics_sample_acwr", package = "Athlytics") -if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { +data("sample_acwr", package = "Athlytics") +if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { # Create two versions for comparison (simulate RA vs EWMA) - acwr_ra <- athlytics_sample_acwr - acwr_ewma <- athlytics_sample_acwr + acwr_ra <- sample_acwr + acwr_ewma <- sample_acwr acwr_ewma$acwr_smooth <- acwr_ewma$acwr_smooth * runif(nrow(acwr_ewma), 0.95, 1.05) - + p <- plot_acwr_comparison(acwr_ra, acwr_ewma) print(p) } diff --git a/man/plot_acwr_enhanced.Rd b/man/plot_acwr_enhanced.Rd index a9b436a..810c526 100644 --- a/man/plot_acwr_enhanced.Rd +++ b/man/plot_acwr_enhanced.Rd @@ -19,7 +19,7 @@ plot_acwr_enhanced( \arguments{ \item{acwr_data}{A data frame from \code{calculate_acwr_ewma()} containing ACWR values.} -\item{reference_data}{Optional. A data frame from \code{cohort_reference()} for +\item{reference_data}{Optional. A data frame from \code{calculate_cohort_reference()} for adding cohort reference bands.} \item{show_ci}{Logical. Whether to show confidence bands (if available in data). @@ -64,9 +64,9 @@ The layering order (bottom to top): } \examples{ # Example using sample data -data("athlytics_sample_acwr", package = "Athlytics") -if (!is.null(athlytics_sample_acwr) && nrow(athlytics_sample_acwr) > 0) { - p <- plot_acwr_enhanced(athlytics_sample_acwr, show_ci = FALSE) +data("sample_acwr", package = "Athlytics") +if (!is.null(sample_acwr) && nrow(sample_acwr) > 0) { + p <- plot_acwr_enhanced(sample_acwr, show_ci = FALSE) print(p) } @@ -86,7 +86,7 @@ acwr <- calculate_acwr_ewma( plot_acwr_enhanced(acwr) # With cohort reference -reference <- cohort_reference(cohort_data, metric = "acwr_smooth") +reference <- calculate_cohort_reference(cohort_data, metric = "acwr_smooth") plot_acwr_enhanced(acwr, reference_data = reference) } } diff --git a/man/plot_decoupling.Rd b/man/plot_decoupling.Rd index ef87d30..f562643 100644 --- a/man/plot_decoupling.Rd +++ b/man/plot_decoupling.Rd @@ -53,8 +53,8 @@ used as reference. \strong{Best practice: Use \code{load_local_activities()} + \ } \examples{ # Example using pre-calculated sample data -data("athlytics_sample_decoupling", package = "Athlytics") -p <- plot_decoupling(decoupling_df = athlytics_sample_decoupling) +data("sample_decoupling", package = "Athlytics") +p <- plot_decoupling(decoupling_df = sample_decoupling) print(p) \dontrun{ @@ -63,11 +63,11 @@ activities <- load_local_activities("strava_export_data/activities.csv") # Example 1: Plot Decoupling trend for Runs (last 6 months) decoupling_runs_6mo <- calculate_decoupling( - activities_data = activities, - export_dir = "strava_export_data", - activity_type = "Run", - decouple_metric = "pace_hr", - start_date = Sys.Date() - months(6) + activities_data = activities, + export_dir = "strava_export_data", + activity_type = "Run", + decouple_metric = "pace_hr", + start_date = Sys.Date() - months(6) ) plot_decoupling(decoupling_runs_6mo) diff --git a/man/plot_ef.Rd b/man/plot_ef.Rd index 23a612b..7576dfc 100644 --- a/man/plot_ef.Rd +++ b/man/plot_ef.Rd @@ -58,8 +58,8 @@ often indicates improved aerobic fitness. Points colored by activity type. } \examples{ # Example using pre-calculated sample data -data("athlytics_sample_ef", package = "Athlytics") -p <- plot_ef(athlytics_sample_ef) +data("sample_ef", package = "Athlytics") +p <- plot_ef(sample_ef) print(p) \dontrun{ @@ -67,20 +67,26 @@ print(p) activities <- load_local_activities("strava_export_data/activities.csv") # Plot Pace/HR EF trend for Runs (last 6 months) -plot_ef(data = activities, - activity_type = "Run", - ef_metric = "pace_hr", - start_date = Sys.Date() - months(6)) +plot_ef( + data = activities, + activity_type = "Run", + ef_metric = "pace_hr", + start_date = Sys.Date() - months(6) +) # Plot Power/HR EF trend for Rides -plot_ef(data = activities, - activity_type = "Ride", - ef_metric = "power_hr") +plot_ef( + data = activities, + activity_type = "Ride", + ef_metric = "power_hr" +) # Plot Pace/HR EF trend for multiple Run types (no trend line) -plot_ef(data = activities, - activity_type = c("Run", "VirtualRun"), - ef_metric = "pace_hr", - add_trend_line = FALSE) +plot_ef( + data = activities, + activity_type = c("Run", "VirtualRun"), + ef_metric = "pace_hr", + add_trend_line = FALSE +) } } diff --git a/man/plot_exposure.Rd b/man/plot_exposure.Rd index 9a9e9a4..7d2d1e2 100644 --- a/man/plot_exposure.Rd +++ b/man/plot_exposure.Rd @@ -61,9 +61,9 @@ If \code{exposure_df} is not provided, it calls \code{calculate_exposure} first. } \examples{ # Example using simulated data -data(athlytics_sample_exposure) +data(sample_exposure) # Ensure exposure_df is named and other necessary parameters like activity_type are provided -p <- plot_exposure(exposure_df = athlytics_sample_exposure, activity_type = "Run") +p <- plot_exposure(exposure_df = sample_exposure, activity_type = "Run") print(p) \dontrun{ @@ -71,20 +71,26 @@ print(p) activities <- load_local_activities("strava_export_data/activities.csv") # Plot Exposure trend for Runs (last 6 months) -plot_exposure(data = activities, - activity_type = "Run", - end_date = Sys.Date(), - user_ftp = 280) # Example, if load_metric = "tss" +plot_exposure( + data = activities, + activity_type = "Run", + end_date = Sys.Date(), + user_ftp = 280 +) # Example, if load_metric = "tss" # Plot Exposure trend for Rides -plot_exposure(data = activities, - activity_type = "Ride", - user_ftp = 280) # Example, provide if load_metric = "tss" +plot_exposure( + data = activities, + activity_type = "Ride", + user_ftp = 280 +) # Example, provide if load_metric = "tss" # Plot Exposure trend for multiple Run types (risk_zones = FALSE for this example) -plot_exposure(data = activities, - activity_type = c("Run", "VirtualRun"), - risk_zones = FALSE, - user_ftp = 280) # Example, provide if load_metric = "tss" +plot_exposure( + data = activities, + activity_type = c("Run", "VirtualRun"), + risk_zones = FALSE, + user_ftp = 280 +) # Example, provide if load_metric = "tss" } } diff --git a/man/plot_pbs.Rd b/man/plot_pbs.Rd index f11fe6a..8452a8d 100644 --- a/man/plot_pbs.Rd +++ b/man/plot_pbs.Rd @@ -50,44 +50,54 @@ Legacy API mode is maintained for backward compatibility only. \examples{ # Example using the built-in sample data # This data now contains a simulated history of performance improvements -data("athlytics_sample_pbs", package = "Athlytics") +data("sample_pbs", package = "Athlytics") -if (!is.null(athlytics_sample_pbs) && nrow(athlytics_sample_pbs) > 0) { +if (!is.null(sample_pbs) && nrow(sample_pbs) > 0) { # Plot PBs using the package sample data directly - p <- plot_pbs(pbs_df = athlytics_sample_pbs, activity_type = "Run") + p <- plot_pbs(pbs_df = sample_pbs, activity_type = "Run") print(p) } if (FALSE) { -# Example using local Strava export data -activities <- load_local_activities("strava_export_data/activities.csv") + # Example using local Strava export data + activities <- load_local_activities("strava_export_data/activities.csv") -# Plot PBS trend for Runs (last 6 months) -pb_data_run <- calculate_pbs(activities_data = activities, - activity_type = "Run", - distance_meters = c(1000,5000,10000), - date_range = c(format(Sys.Date() - months(6)), - format(Sys.Date()))) -if(nrow(pb_data_run) > 0) { - plot_pbs(pbs_df = pb_data_run, distance_meters = c(1000,5000,10000)) -} + # Plot PBS trend for Runs (last 6 months) + pb_data_run <- calculate_pbs( + activities_data = activities, + activity_type = "Run", + distance_meters = c(1000, 5000, 10000), + date_range = c( + format(Sys.Date() - months(6)), + format(Sys.Date()) + ) + ) + if (nrow(pb_data_run) > 0) { + plot_pbs(pbs_df = pb_data_run, distance_meters = c(1000, 5000, 10000)) + } -# Plot PBS trend for Rides (if applicable, though PBs are mainly for Runs) -pb_data_ride <- calculate_pbs(activities_data = activities, - activity_type = "Ride", - distance_meters = c(10000, 20000)) -if(nrow(pb_data_ride) > 0) { - plot_pbs(pbs_df = pb_data_ride, distance_meters = c(10000, 20000)) -} + # Plot PBS trend for Rides (if applicable, though PBs are mainly for Runs) + pb_data_ride <- calculate_pbs( + activities_data = activities, + activity_type = "Ride", + distance_meters = c(10000, 20000) + ) + if (nrow(pb_data_ride) > 0) { + plot_pbs(pbs_df = pb_data_ride, distance_meters = c(10000, 20000)) + } -# Plot PBS trend for multiple Run types (no trend line) -pb_data_multi <- calculate_pbs(activities_data = activities, - activity_type = c("Run", "VirtualRun"), - distance_meters = c(1000,5000)) -if(nrow(pb_data_multi) > 0) { - plot_pbs(pbs_df = pb_data_multi, distance_meters = c(1000,5000), - add_trend_line = FALSE) -} + # Plot PBS trend for multiple Run types (no trend line) + pb_data_multi <- calculate_pbs( + activities_data = activities, + activity_type = c("Run", "VirtualRun"), + distance_meters = c(1000, 5000) + ) + if (nrow(pb_data_multi) > 0) { + plot_pbs( + pbs_df = pb_data_multi, distance_meters = c(1000, 5000), + add_trend_line = FALSE + ) + } } } diff --git a/man/plot_with_reference.Rd b/man/plot_with_reference.Rd index 3a82798..5e9c67e 100644 --- a/man/plot_with_reference.Rd +++ b/man/plot_with_reference.Rd @@ -16,7 +16,7 @@ plot_with_reference( \arguments{ \item{individual}{A data frame with individual athlete data (from calculate_acwr, etc.)} -\item{reference}{A data frame from \code{cohort_reference()}.} +\item{reference}{A data frame from \code{calculate_cohort_reference()}.} \item{metric}{Name of the metric to plot. Default "acwr_smooth".} @@ -42,10 +42,12 @@ individual_data <- data.frame( reference_data <- data.frame( date = as.Date(c("2023-01-01", "2023-04-01", "2023-07-01", "2023-10-01")), percentile = rep(c("p05", "p25", "p50", "p75", "p95"), 4), - value = c(0.7, 0.9, 1.1, 1.3, 1.5, - 0.7, 0.9, 1.1, 1.3, 1.5, - 0.7, 0.9, 1.1, 1.3, 1.5, - 0.7, 0.9, 1.1, 1.3, 1.5) + value = c( + 0.7, 0.9, 1.1, 1.3, 1.5, + 0.7, 0.9, 1.1, 1.3, 1.5, + 0.7, 0.9, 1.1, 1.3, 1.5, + 0.7, 0.9, 1.1, 1.3, 1.5 + ) ) p <- plot_with_reference( diff --git a/man/athlytics_sample_acwr.Rd b/man/sample_acwr.Rd similarity index 90% rename from man/athlytics_sample_acwr.Rd rename to man/sample_acwr.Rd index 8224538..9a14969 100644 --- a/man/athlytics_sample_acwr.Rd +++ b/man/sample_acwr.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{athlytics_sample_acwr} -\alias{athlytics_sample_acwr} +\name{sample_acwr} +\alias{sample_acwr} \title{Sample ACWR Data for Athlytics} \format{ A tibble with 365 rows and 5 variables: @@ -18,7 +18,7 @@ A tibble with 365 rows and 5 variables: Simulated data generated for package examples. } \usage{ -athlytics_sample_acwr +sample_acwr } \description{ A dataset containing pre-calculated Acute:Chronic Workload Ratio (ACWR) diff --git a/man/athlytics_sample_decoupling.Rd b/man/sample_decoupling.Rd similarity index 85% rename from man/athlytics_sample_decoupling.Rd rename to man/sample_decoupling.Rd index 488b15a..ab2866b 100644 --- a/man/athlytics_sample_decoupling.Rd +++ b/man/sample_decoupling.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{athlytics_sample_decoupling} -\alias{athlytics_sample_decoupling} +\name{sample_decoupling} +\alias{sample_decoupling} \title{Sample Aerobic Decoupling Data for Athlytics} \format{ A tibble with 365 rows and 2 variables: @@ -15,7 +15,7 @@ A tibble with 365 rows and 2 variables: Simulated data generated for package examples. } \usage{ -athlytics_sample_decoupling +sample_decoupling } \description{ A dataset containing pre-calculated aerobic decoupling percentages, diff --git a/man/athlytics_sample_ef.Rd b/man/sample_ef.Rd similarity index 89% rename from man/athlytics_sample_ef.Rd rename to man/sample_ef.Rd index 2879566..4e8b0af 100644 --- a/man/athlytics_sample_ef.Rd +++ b/man/sample_ef.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{athlytics_sample_ef} -\alias{athlytics_sample_ef} +\name{sample_ef} +\alias{sample_ef} \title{Sample Efficiency Factor (EF) Data for Athlytics} \format{ A data.frame with 50 rows and 3 variables: @@ -16,7 +16,7 @@ A data.frame with 50 rows and 3 variables: Simulated data generated for package examples. } \usage{ -athlytics_sample_ef +sample_ef } \description{ A dataset containing pre-calculated Efficiency Factor (EF) values, diff --git a/man/athlytics_sample_exposure.Rd b/man/sample_exposure.Rd similarity index 89% rename from man/athlytics_sample_exposure.Rd rename to man/sample_exposure.Rd index 9c46ef3..ff5e6db 100644 --- a/man/athlytics_sample_exposure.Rd +++ b/man/sample_exposure.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{athlytics_sample_exposure} -\alias{athlytics_sample_exposure} +\name{sample_exposure} +\alias{sample_exposure} \title{Sample Training Load Exposure Data for Athlytics} \format{ A tibble with 365 rows and 5 variables: @@ -18,7 +18,7 @@ A tibble with 365 rows and 5 variables: Simulated data generated for package examples. } \usage{ -athlytics_sample_exposure +sample_exposure } \description{ This dataset contains daily training load, ATL, CTL, and ACWR, derived from diff --git a/man/athlytics_sample_pbs.Rd b/man/sample_pbs.Rd similarity index 94% rename from man/athlytics_sample_pbs.Rd rename to man/sample_pbs.Rd index 9af6feb..b8fcd4f 100644 --- a/man/athlytics_sample_pbs.Rd +++ b/man/sample_pbs.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{athlytics_sample_pbs} -\alias{athlytics_sample_pbs} +\name{sample_pbs} +\alias{sample_pbs} \title{Sample Personal Bests (PBs) Data for Athlytics} \format{ A tibble with 100 rows and 10 variables: @@ -23,7 +23,7 @@ A tibble with 100 rows and 10 variables: Simulated data generated for package examples. } \usage{ -athlytics_sample_pbs +sample_pbs } \description{ A dataset containing pre-calculated Personal Best (PB) times for various distances, diff --git a/man/quality_summary.Rd b/man/summarize_quality.Rd similarity index 88% rename from man/quality_summary.Rd rename to man/summarize_quality.Rd index b673b22..02a31e3 100644 --- a/man/quality_summary.Rd +++ b/man/summarize_quality.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/flag_quality.R -\name{quality_summary} +\name{summarize_quality} +\alias{summarize_quality} \alias{quality_summary} \title{Get Quality Summary Statistics} \usage{ +summarize_quality(flagged_streams) + quality_summary(flagged_streams) } \arguments{ @@ -29,6 +32,6 @@ Provides a summary of quality flags and steady-state segments. \examples{ \dontrun{ flagged_data <- flag_quality(stream_data) -quality_summary(flagged_data) +summarize_quality(flagged_data) } } diff --git a/paper/paper.md b/paper/paper.md index 72c7cc2..91d6108 100644 --- a/paper/paper.md +++ b/paper/paper.md @@ -52,7 +52,7 @@ Athlytics is unique in providing an API-free, end-to-end workflow that integrate - **Inputs & Data Model:** Reads Strava ZIP archives or `activities.csv`. Activity streams (FIT/TCX/GPX) are loaded **on demand** from the archive, optionally using `FITfileR` for FIT files [@FITfileR]. The core function `load_local_activities()` produces a standardized tibble. - **Core Metrics:** `calculate_acwr()`, `calculate_ef()`, and `calculate_decoupling()` compute key summaries with sensible, research-oriented defaults. The implementation of ACWR acknowledges its conceptual issues and is presented as a monitoring tool [@impellizzeri2020acwr]. - **Uncertainty Quantification:** Provides confidence intervals for EWMA-based ACWR using a moving-block bootstrap [@kunsch1989; @politis1994], a key feature for research applications. -- **Cohort Benchmarking:** `cohort_reference()` computes percentile bands, which can be layered onto individual plots using `plot_with_reference()`. +- **Cohort Benchmarking:** `calculate_cohort_reference()` computes percentile bands, which can be layered onto individual plots using `plot_with_reference()`. - **Plotting & Diagnostics:** Visualization functions follow a **data-first API**. Functions return **diagnostic fields** (e.g., `status`, `reason`) when inputs are insufficient, making the workflow transparent. # Example @@ -75,7 +75,7 @@ cohort_acwr <- cohort_data %>% ungroup() # 3. Generate cohort-wide percentile reference bands -reference_bands <- cohort_reference(cohort_acwr, metric = "acwr_smooth") +reference_bands <- calculate_cohort_reference(cohort_acwr, metric = "acwr_smooth") # 4. Plot an individual's data against the cohort reference individual_acwr <- cohort_acwr %>% filter(athlete_id == "A1") diff --git a/tests/testthat.R b/tests/testthat.R index 4b0bd27..c01a207 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ library(testthat) library(Athlytics) -test_check("Athlytics") +test_check("Athlytics") diff --git a/tests/testthat/helper-mock-files.R b/tests/testthat/helper-mock-files.R index 6cb0223..017b5c8 100644 --- a/tests/testthat/helper-mock-files.R +++ b/tests/testthat/helper-mock-files.R @@ -7,11 +7,11 @@ library(xml2) create_mock_strava_export <- function(base_dir = tempdir(), n_activities = 5) { export_dir <- file.path(base_dir, "mock_strava_export") activities_dir <- file.path(export_dir, "activities") - + # Create directories dir.create(export_dir, showWarnings = FALSE, recursive = TRUE) dir.create(activities_dir, showWarnings = FALSE) - + # Create activities.csv with proper column names (spaces, not dots) activities_data <- data.frame( `Activity ID` = seq_len(n_activities), @@ -51,9 +51,9 @@ create_mock_strava_export <- function(base_dir = tempdir(), n_activities = 5) { `Average Elapsed Speed` = round(runif(n_activities, 2.8, 3.8), 1), check.names = FALSE ) - + write.csv(activities_data, file.path(export_dir, "activities.csv"), row.names = FALSE) - + # Create mock activity files for (i in seq_len(n_activities)) { create_mock_tcx_file( @@ -63,77 +63,79 @@ create_mock_strava_export <- function(base_dir = tempdir(), n_activities = 5) { distance_meters = activities_data$Distance[i] ) } - + return(export_dir) } # Create a mock TCX file with realistic data create_mock_tcx_file <- function(filepath, activity_date, duration_seconds = 3600, distance_meters = 10000) { # Generate time points - n_points <- min(duration_seconds, 360) # Limit to 360 points (every 10 seconds for 1 hour) + n_points <- min(duration_seconds, 360) # Limit to 360 points (every 10 seconds for 1 hour) time_points <- seq(0, duration_seconds, length.out = n_points) - + # Generate realistic running data base_hr <- 150 - base_speed <- distance_meters / duration_seconds # m/s - + base_speed <- distance_meters / duration_seconds # m/s + # Add some variation hr_data <- round(base_hr + sin(time_points / 300) * 10 + rnorm(n_points, 0, 3)) - hr_data <- pmax(60, pmin(200, hr_data)) # Clamp to reasonable range - + hr_data <- pmax(60, pmin(200, hr_data)) # Clamp to reasonable range + distance_data <- cumsum(base_speed + rnorm(n_points, 0, 0.1)) - distance_data <- distance_data * (distance_meters / max(distance_data)) # Scale to target distance - + distance_data <- distance_data * (distance_meters / max(distance_data)) # Scale to target distance + # Create TCX structure tcx_content <- paste0( '\n', '\n', - ' \n', + " \n", ' \n', - ' ', format(activity_date, "%Y-%m-%dT%H:%M:%SZ"), '\n', + " ", format(activity_date, "%Y-%m-%dT%H:%M:%SZ"), "\n", ' \n', - ' ', duration_seconds, '\n', - ' ', distance_meters, '\n', - ' 0\n', - ' \n' + " ", duration_seconds, "\n", + " ", distance_meters, "\n", + " 0\n", + " \n" ) - + # Add trackpoints - for (i in seq(1, n_points, by = 10)) { # Sample every 10 seconds + for (i in seq(1, n_points, by = 10)) { # Sample every 10 seconds timestamp <- activity_date + time_points[i] - tcx_content <- paste0(tcx_content, - ' \n', - ' \n', - ' ', round(distance_data[i], 2), '\n', - ' \n', - ' ', hr_data[i], '\n', - ' \n', - ' \n' + tcx_content <- paste0( + tcx_content, + " \n", + " \n", + " ", round(distance_data[i], 2), "\n", + " \n", + " ", hr_data[i], "\n", + " \n", + " \n" ) } - - tcx_content <- paste0(tcx_content, - ' \n', - ' \n', - ' \n', - ' \n', - '' + + tcx_content <- paste0( + tcx_content, + " \n", + " \n", + " \n", + " \n", + "" ) - + writeLines(tcx_content, filepath) } # Create a mock FIT file (simplified - just creates a text file with data) create_mock_fit_file <- function(filepath, activity_date, duration_seconds = 3600, distance_meters = 10000) { # For testing purposes, create a simple CSV that parse_activity_file can handle - n_points <- min(duration_seconds, 1000) # Limit points for performance + n_points <- min(duration_seconds, 1000) # Limit points for performance time_points <- seq(0, duration_seconds, length.out = n_points) - + # Generate realistic data base_hr <- 150 base_speed <- distance_meters / duration_seconds base_power <- 200 - + stream_data <- data.frame( time = time_points, distance = cumsum(rep(base_speed * (duration_seconds / n_points), n_points)), @@ -145,36 +147,36 @@ create_mock_fit_file <- function(filepath, activity_date, duration_seconds = 360 grade_smooth = rnorm(n_points, 0, 1), moving = TRUE ) - + # Ensure positive values stream_data$heartrate <- pmax(60, pmin(200, stream_data$heartrate)) stream_data$watts <- pmax(0, stream_data$watts) stream_data$velocity_smooth <- pmax(0.5, stream_data$velocity_smooth) - + # Save as CSV (parse_activity_file should handle this) write.csv(stream_data, filepath, row.names = FALSE) } # Create a mock GPX file create_mock_gpx_file <- function(filepath, activity_date, duration_seconds = 3600, distance_meters = 10000) { - n_points <- min(duration_seconds / 10, 360) # One point every 10 seconds - + n_points <- min(duration_seconds / 10, 360) # One point every 10 seconds + # Generate GPS coordinates (small variations around a point) base_lat <- 40.7128 base_lon <- -74.0060 - + gpx_content <- paste0( '\n', '\n', - ' \n', - ' \n', - ' \n', - ' \n', - ' Morning Run\n', - ' Run\n', - ' \n' + " \n", + " \n", + " \n", + " \n", + " Morning Run\n", + " Run\n", + " \n" ) - + for (i in seq_len(n_points)) { time_offset <- (i - 1) * 10 timestamp <- activity_date + time_offset @@ -182,24 +184,26 @@ create_mock_gpx_file <- function(filepath, activity_date, duration_seconds = 360 lon <- base_lon + rnorm(1, 0, 0.0001) ele <- 100 + rnorm(1, 0, 5) hr <- round(150 + rnorm(1, 0, 10)) - - gpx_content <- paste0(gpx_content, + + gpx_content <- paste0( + gpx_content, ' \n', - ' ', ele, '\n', - ' \n', - ' \n', - '
', hr, '\n', - ' \n', - ' \n' + " ", ele, "\n", + " \n", + " \n", + "
", hr, "\n", + " \n", + " \n" ) } - - gpx_content <- paste0(gpx_content, - ' \n', - ' \n', - '' + + gpx_content <- paste0( + gpx_content, + " \n", + " \n", + "" ) - + writeLines(gpx_content, filepath) } diff --git a/tests/testthat/helper-mockdata.R b/tests/testthat/helper-mockdata.R index 21b101b..bee0420 100644 --- a/tests/testthat/helper-mockdata.R +++ b/tests/testthat/helper-mockdata.R @@ -13,16 +13,16 @@ mock_pbs_df <- data.frame( ) mock_acwr_df <- data.frame( - date = seq(lubridate::ymd("2023-01-01"), lubridate::ymd("2023-02-10"), by="day"), - atl = round(runif(41, 30, 70) + sin(seq(0, 4*pi, length.out=41))*10, 1), - ctl = round(runif(41, 40, 60) + sin(seq(0, 2*pi, length.out=41))*5, 1) + date = seq(lubridate::ymd("2023-01-01"), lubridate::ymd("2023-02-10"), by = "day"), + atl = round(runif(41, 30, 70) + sin(seq(0, 4 * pi, length.out = 41)) * 10, 1), + ctl = round(runif(41, 40, 60) + sin(seq(0, 2 * pi, length.out = 41)) * 5, 1) ) %>% dplyr::mutate( ctl_safe = ifelse(ctl <= 0, 1, ctl), acwr = round(atl / ctl_safe, 2), - acwr_smooth = acwr + acwr_smooth = acwr ) %>% - dplyr::select(date, atl, ctl, acwr, acwr_smooth) + dplyr::select(date, atl, ctl, acwr, acwr_smooth) latlng_list <- lapply(1:3601, function(i) c(runif(1, 40, 41), runif(1, -75, -74))) @@ -31,10 +31,10 @@ mock_activity_streams <- data.frame( latlng = I(latlng_list), distance = seq(0, 10000, length.out = 3601), altitude = rnorm(3601, 100, 10), - velocity_smooth = rnorm(3601, 3, 0.1), # Reduced variation for steady state - heartrate = round(rnorm(3601, 150, 5)), # More stable HR + velocity_smooth = rnorm(3601, 3, 0.1), # Reduced variation for steady state + heartrate = round(rnorm(3601, 150, 5)), # More stable HR cadence = round(runif(3601, 85, 95)), - watts = round(rnorm(3601, 200, 10)), # More stable power + watts = round(rnorm(3601, 200, 10)), # More stable power grade_smooth = rnorm(3601, 0, 1), moving = sample(c(TRUE, FALSE), 3601, replace = TRUE, prob = c(0.95, 0.05)), temp = rnorm(3601, 20, 3) @@ -44,26 +44,27 @@ mock_ef_df <- data.frame( activity_id = c("1", "2", "3", "4", "5"), date = lubridate::ymd(c("2023-01-01", "2023-01-15", "2023-02-01", "2023-02-15", "2023-03-01")), activity_type = rep("Run", 5), - ef_value = round(rnorm(5, 1.5, 0.1), 2), + ef_value = round(rnorm(5, 1.5, 0.1), 2), ef_metric = rep("pace_hr", 5), stringsAsFactors = FALSE ) mock_exposure_df <- data.frame( - date = seq(lubridate::ymd("2023-01-01"), lubridate::ymd("2023-02-10"), by="day"), - atl = round(runif(41, 30, 70) + sin(seq(0, 4*pi, length.out=41))*10, 1), - ctl = round(runif(41, 40, 60) + sin(seq(0, 2*pi, length.out=41))*5, 1) + date = seq(lubridate::ymd("2023-01-01"), lubridate::ymd("2023-02-10"), by = "day"), + atl = round(runif(41, 30, 70) + sin(seq(0, 4 * pi, length.out = 41)) * 10, 1), + ctl = round(runif(41, 40, 60) + sin(seq(0, 2 * pi, length.out = 41)) * 5, 1) ) %>% dplyr::mutate( ctl_safe = ifelse(ctl <= 0, 1, ctl), acwr = round(atl / ctl_safe, 2) - ) + ) mock_activity_list_df <- data.frame( id = c(1001, 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010), name = paste("Activity", 1:10), - start_date_local = seq.POSIXt(as.POSIXct("2023-10-01 08:00:00", tz = "UTC"), - by = "-2 days", length.out = 10), + start_date_local = seq.POSIXt(as.POSIXct("2023-10-01 08:00:00", tz = "UTC"), + by = "-2 days", length.out = 10 + ), type = rep(c("Run", "Ride"), length.out = 10), distance = c(5050, 20100, 10200, 30500, 8030, 15200, 12100, 40300, 6050, 25400), moving_time = c(1800, 3600, 3000, 5400, 2400, 2700, 3300, 7200, 1900, 4500), diff --git a/tests/testthat/test-absolute-real-data.R b/tests/testthat/test-absolute-real-data.R index 227c737..8eb44ce 100644 --- a/tests/testthat/test-absolute-real-data.R +++ b/tests/testthat/test-absolute-real-data.R @@ -10,10 +10,10 @@ zip_path <- file.path(base_dir, "export_97354582.zip") test_that("load with absolute path comprehensive", { skip_if(!file.exists(csv_path), "CSV file not found") - + # This should definitely work and be counted in coverage activities <- load_local_activities(csv_path) - + expect_true(is.data.frame(activities) || inherits(activities, "tbl")) expect_gt(nrow(activities), 0) expect_true("id" %in% names(activities)) @@ -23,9 +23,9 @@ test_that("load with absolute path comprehensive", { test_that("comprehensive activity type filtering", { skip_if(!file.exists(csv_path), "CSV file not found") - + all_act <- load_local_activities(csv_path) - + # Test each unique activity type types <- unique(all_act$type)[1:min(5, length(unique(all_act$type)))] for (atype in types) { @@ -36,39 +36,45 @@ test_that("comprehensive activity type filtering", { test_that("comprehensive calculate with real data", { skip_if(!file.exists(csv_path), "CSV file not found") - + act <- load_local_activities(csv_path) - + # Find activity type with most data type_table <- table(act$type) main_type <- names(which.max(type_table)) - + type_act <- act[act$type == main_type, ] - + if (nrow(type_act) >= 60) { # Test ACWR functions acwr1 <- calculate_acwr(type_act, activity_type = main_type, load_metric = "duration_mins") acwr2 <- calculate_acwr(type_act, activity_type = main_type, load_metric = "distance_km") acwr3 <- calculate_acwr(type_act, activity_type = main_type, acute_period = 7, chronic_period = 28) - + ewma <- calculate_acwr_ewma(type_act, activity_type = main_type, method = "ewma") ra <- calculate_acwr_ewma(type_act, activity_type = main_type, method = "ra") - + # Test exposure only if we have recent data date_range <- range(type_act$date, na.rm = TRUE) days_ago <- as.numeric(Sys.Date() - date_range[2]) - - if (days_ago <= 100) { # Only test if data is recent enough - exp1 <- tryCatch({ - calculate_exposure(type_act, activity_type = main_type, load_metric = "duration_mins") - }, error = function(e) NULL) - - exp2 <- tryCatch({ - calculate_exposure(type_act, activity_type = main_type, load_metric = "distance_km") - }, error = function(e) NULL) + + if (days_ago <= 100) { # Only test if data is recent enough + exp1 <- tryCatch( + { + calculate_exposure(type_act, activity_type = main_type, load_metric = "duration_mins") + }, + error = function(e) NULL + ) + + exp2 <- tryCatch( + { + calculate_exposure(type_act, activity_type = main_type, load_metric = "distance_km") + }, + error = function(e) NULL + ) } - - expect_true(TRUE) # If we get here, all calculations worked + + expect_true(TRUE) # If we get here, all calculations worked } else { skip("Not enough activities for comprehensive testing") } @@ -76,24 +82,26 @@ test_that("comprehensive calculate with real data", { test_that("comprehensive ef with real data", { skip_if(!file.exists(csv_path), "CSV file not found") - + act <- load_local_activities(csv_path) - + # Run activities with HR runs <- act[act$type == "Run" & !is.na(act$average_heartrate), ] - + if (nrow(runs) >= 30) { ef1 <- calculate_ef(runs, activity_type = "Run", ef_metric = "pace_hr") ef2 <- calculate_ef(runs, activity_type = "Run", ef_metric = "pace_hr", min_duration_mins = 20) ef3 <- calculate_ef(runs, activity_type = "Run", ef_metric = "pace_hr", min_duration_mins = 40) - + if (nrow(runs) >= 100) { dates <- range(runs$date, na.rm = TRUE) mid <- dates[1] + as.numeric(diff(dates)) / 2 - ef4 <- calculate_ef(runs, activity_type = "Run", ef_metric = "pace_hr", - start_date = dates[1], end_date = mid) + ef4 <- calculate_ef(runs, + activity_type = "Run", ef_metric = "pace_hr", + start_date = dates[1], end_date = mid + ) } - + expect_true(TRUE) } }) @@ -101,34 +109,34 @@ test_that("comprehensive ef with real data", { test_that("comprehensive plots with real calculated data", { skip_if_not_installed("ggplot2") skip_if(!file.exists(csv_path), "CSV file not found") - + act <- load_local_activities(csv_path) - + type_table <- table(act$type) main_type <- names(which.max(type_table)) type_act <- act[act$type == main_type, ] - + if (nrow(type_act) >= 60) { # Calculate acwr <- calculate_acwr(type_act, activity_type = main_type) - + # Plot all variations p1 <- plot_acwr(acwr) p2 <- plot_acwr_enhanced(acwr) p3 <- plot_acwr_enhanced(acwr, highlight_zones = FALSE) - + expect_s3_class(p1, "gg") expect_s3_class(p2, "gg") expect_s3_class(p3, "gg") } - + # EF plots runs <- act[act$type == "Run" & !is.na(act$average_heartrate), ] if (nrow(runs) >= 30) { p4 <- plot_ef(runs, activity_type = "Run", ef_metric = "pace_hr") p5 <- plot_ef(runs, activity_type = "Run", ef_metric = "pace_hr", add_trend_line = FALSE) p6 <- plot_ef(runs, activity_type = "Run", ef_metric = "pace_hr", smoothing_method = "lm") - + expect_s3_class(p4, "gg") expect_s3_class(p5, "gg") expect_s3_class(p6, "gg") @@ -137,10 +145,9 @@ test_that("comprehensive plots with real calculated data", { test_that("load ZIP with absolute path", { skip_if(!file.exists(zip_path), "ZIP file not found") - + activities <- load_local_activities(zip_path) - + expect_true(is.data.frame(activities) || inherits(activities, "tbl")) expect_gt(nrow(activities), 0) }) - diff --git a/tests/testthat/test-acwr-ewma-advanced.R b/tests/testthat/test-acwr-ewma-advanced.R index 7328de2..5647ccf 100644 --- a/tests/testthat/test-acwr-ewma-advanced.R +++ b/tests/testthat/test-acwr-ewma-advanced.R @@ -23,12 +23,13 @@ create_advanced_mock_activities <- function(n = 100) { test_that("calculate_acwr_ewma works with EWMA method", { mock_activities <- create_advanced_mock_activities(50) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - load_metric = "duration_mins") - + + result <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + load_metric = "duration_mins" + ) + expect_s3_class(result, "data.frame") expect_true("atl" %in% colnames(result)) expect_true("ctl" %in% colnames(result)) @@ -37,33 +38,36 @@ test_that("calculate_acwr_ewma works with EWMA method", { test_that("calculate_acwr_ewma works with different half-lives", { mock_activities <- create_advanced_mock_activities(50) - + # Test different half-life combinations - result1 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - half_life_acute = 2, - half_life_chronic = 10) - - result2 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - half_life_acute = 5, - half_life_chronic = 20) - + result1 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + half_life_acute = 2, + half_life_chronic = 10 + ) + + result2 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + half_life_acute = 5, + half_life_chronic = 20 + ) + expect_s3_class(result1, "data.frame") expect_s3_class(result2, "data.frame") }) test_that("calculate_acwr_ewma works with confidence intervals", { mock_activities <- create_advanced_mock_activities(50) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - ci = TRUE, - B = 50) # Reduced for faster testing - + + result <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + ci = TRUE, + B = 50 + ) # Reduced for faster testing + expect_s3_class(result, "data.frame") expect_true("acwr_lower" %in% colnames(result)) expect_true("acwr_upper" %in% colnames(result)) @@ -71,111 +75,119 @@ test_that("calculate_acwr_ewma works with confidence intervals", { test_that("calculate_acwr_ewma works with TSS load metric", { mock_activities <- create_advanced_mock_activities(50) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = "Ride", - load_metric = "tss", - user_ftp = 250) - + + result <- calculate_acwr_ewma(mock_activities, + activity_type = "Ride", + load_metric = "tss", + user_ftp = 250 + ) + expect_s3_class(result, "data.frame") }) test_that("calculate_acwr_ewma works with HRSS load metric", { mock_activities <- create_advanced_mock_activities(50) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - load_metric = "hrss", - user_max_hr = 190, - user_resting_hr = 50) - + + result <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + load_metric = "hrss", + user_max_hr = 190, + user_resting_hr = 50 + ) + expect_s3_class(result, "data.frame") }) test_that("calculate_acwr_ewma works with elevation gain", { mock_activities <- create_advanced_mock_activities(50) mock_activities$elevation_gain <- runif(nrow(mock_activities), 0, 1000) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - load_metric = "elevation_gain_m") - + + result <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + load_metric = "elevation_gain_m" + ) + expect_s3_class(result, "data.frame") }) test_that("calculate_acwr_ewma handles different smoothing periods", { mock_activities <- create_advanced_mock_activities(50) - - result1 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - smoothing_period = 3) - - result2 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - smoothing_period = 14) - + + result1 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + smoothing_period = 3 + ) + + result2 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + smoothing_period = 14 + ) + expect_s3_class(result1, "data.frame") expect_s3_class(result2, "data.frame") }) test_that("calculate_acwr_ewma handles different confidence levels", { mock_activities <- create_advanced_mock_activities(50) - - result1 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - ci = TRUE, - conf_level = 0.90) - - result2 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - ci = TRUE, - conf_level = 0.99) - + + result1 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + ci = TRUE, + conf_level = 0.90 + ) + + result2 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + ci = TRUE, + conf_level = 0.99 + ) + expect_s3_class(result1, "data.frame") expect_s3_class(result2, "data.frame") }) test_that("calculate_acwr_ewma handles different block lengths", { mock_activities <- create_advanced_mock_activities(50) - - result1 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - ci = TRUE, - block_len = 3) - - result2 <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - method = "ewma", - ci = TRUE, - block_len = 14) - + + result1 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + ci = TRUE, + block_len = 3 + ) + + result2 <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + method = "ewma", + ci = TRUE, + block_len = 14 + ) + expect_s3_class(result1, "data.frame") expect_s3_class(result2, "data.frame") }) test_that("calculate_acwr_ewma handles mixed activity types", { mock_activities <- create_advanced_mock_activities(50) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = c("Run", "Ride"), - load_metric = "duration_mins") - + + result <- calculate_acwr_ewma(mock_activities, + activity_type = c("Run", "Ride"), + load_metric = "duration_mins" + ) + expect_s3_class(result, "data.frame") }) test_that("calculate_acwr_ewma handles date range filtering", { mock_activities <- create_advanced_mock_activities(50) - - result <- calculate_acwr_ewma(mock_activities, - activity_type = "Run", - start_date = Sys.Date() - 30, - end_date = Sys.Date()) - - expect_s3_class(result, "data.frame") -}) - + result <- calculate_acwr_ewma(mock_activities, + activity_type = "Run", + start_date = Sys.Date() - 30, + end_date = Sys.Date() + ) + expect_s3_class(result, "data.frame") +}) diff --git a/tests/testthat/test-acwr-ewma.R b/tests/testthat/test-acwr-ewma.R index fde90ec..563d4b2 100644 --- a/tests/testthat/test-acwr-ewma.R +++ b/tests/testthat/test-acwr-ewma.R @@ -3,12 +3,12 @@ test_that("calculate_acwr_ewma calculates RA correctly", { skip_if_not_installed("dplyr") skip("Skipping ACWR EWMA test - requires date column conversion") - + # Create simple test data test_activities <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 60), type = "Run", - moving_time = 3600, # 1 hour each + moving_time = 3600, # 1 hour each distance = 10000, elapsed_time = 3600, average_heartrate = 150, @@ -17,7 +17,7 @@ test_that("calculate_acwr_ewma calculates RA correctly", { weighted_average_watts = NA, stringsAsFactors = FALSE ) - + # Calculate ACWR with RA method result <- calculate_acwr_ewma( test_activities, @@ -26,15 +26,15 @@ test_that("calculate_acwr_ewma calculates RA correctly", { chronic_period = 28, load_metric = "duration_mins" ) - + # Check structure expect_true(is.data.frame(result)) expect_true(all(c("date", "atl", "ctl", "acwr", "acwr_smooth") %in% colnames(result))) - + # ATL and CTL should be numeric and non-negative expect_true(all(result$atl >= 0, na.rm = TRUE)) expect_true(all(result$ctl >= 0, na.rm = TRUE)) - + # ACWR should be ratio of ATL/CTL valid_rows <- !is.na(result$atl) & !is.na(result$ctl) & result$ctl > 0 if (any(valid_rows)) { @@ -46,7 +46,7 @@ test_that("calculate_acwr_ewma calculates RA correctly", { test_that("calculate_acwr_ewma EWMA method works", { skip_if_not_installed("dplyr") skip("Skipping ACWR EWMA test - requires proper data structure") - + # Create test data test_activities <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 90), @@ -60,7 +60,7 @@ test_that("calculate_acwr_ewma EWMA method works", { weighted_average_watts = NA, stringsAsFactors = FALSE ) - + # Calculate ACWR with EWMA method result <- calculate_acwr_ewma( test_activities, @@ -70,11 +70,11 @@ test_that("calculate_acwr_ewma EWMA method works", { load_metric = "duration_mins", ci = FALSE ) - + # Check structure expect_true(is.data.frame(result)) expect_true(all(c("date", "atl", "ctl", "acwr", "acwr_smooth") %in% colnames(result))) - + # EWMA should produce smoothly varying loads # Check that there are no sudden jumps (beyond reasonable limits) if (nrow(result) > 10) { @@ -97,7 +97,7 @@ test_that("EWMA half-life validation works", { weighted_average_watts = NA, stringsAsFactors = FALSE ) - + # Test invalid half-life (acute >= chronic) expect_error( calculate_acwr_ewma( @@ -112,11 +112,11 @@ test_that("EWMA half-life validation works", { test_that("Bootstrap confidence bands are calculated (when requested)", { skip("Bootstrap test takes too long for regular testing") - + test_activities <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 90), type = "Run", - moving_time = rnorm(90, 3600, 600), # Variable duration + moving_time = rnorm(90, 3600, 600), # Variable duration distance = 10000, elapsed_time = 3600, average_heartrate = 150, @@ -125,20 +125,20 @@ test_that("Bootstrap confidence bands are calculated (when requested)", { weighted_average_watts = NA, stringsAsFactors = FALSE ) - + # Calculate with confidence bands result <- calculate_acwr_ewma( test_activities, method = "ewma", ci = TRUE, - B = 50, # Reduced for testing speed + B = 50, # Reduced for testing speed conf_level = 0.95 ) - + # Check that CI columns exist expect_true("acwr_lower" %in% colnames(result)) expect_true("acwr_upper" %in% colnames(result)) - + # Upper should be >= lower (where not NA) valid_ci <- !is.na(result$acwr_lower) & !is.na(result$acwr_upper) if (any(valid_ci)) { @@ -148,7 +148,7 @@ test_that("Bootstrap confidence bands are calculated (when requested)", { test_that("CI warning for RA method", { skip("Skipping CI warning test - requires proper data structure") - + test_activities <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 60), type = "Run", @@ -161,7 +161,7 @@ test_that("CI warning for RA method", { weighted_average_watts = NA, stringsAsFactors = FALSE ) - + # Requesting CI with RA method should warn expect_warning( calculate_acwr_ewma( @@ -176,7 +176,7 @@ test_that("CI warning for RA method", { test_that("calculate_acwr_ewma handles different load metrics", { skip_if_not_installed("dplyr") skip("Skipping load metrics test - requires proper data structure") - + test_activities <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 60), type = "Run", @@ -189,7 +189,7 @@ test_that("calculate_acwr_ewma handles different load metrics", { elevation_gain = 100, stringsAsFactors = FALSE ) - + # Test distance metric result_dist <- calculate_acwr_ewma( test_activities, @@ -197,7 +197,7 @@ test_that("calculate_acwr_ewma handles different load metrics", { load_metric = "distance_km" ) expect_true(is.data.frame(result_dist)) - + # Test TSS metric (requires FTP) result_tss <- calculate_acwr_ewma( test_activities, @@ -207,4 +207,3 @@ test_that("calculate_acwr_ewma handles different load metrics", { ) expect_true(is.data.frame(result_tss)) }) - diff --git a/tests/testthat/test-acwr.R b/tests/testthat/test-acwr.R index efcae0a..84c8b80 100644 --- a/tests/testthat/test-acwr.R +++ b/tests/testthat/test-acwr.R @@ -6,8 +6,8 @@ library(Athlytics) library(testthat) # Load sample data from the package -data(athlytics_sample_acwr) -data(athlytics_sample_exposure) +data(sample_acwr) +data(sample_exposure) # Create mock activities data for testing create_mock_activities <- function(n = 30) { @@ -19,8 +19,8 @@ create_mock_activities <- function(n = 30) { sport_type = sample(c("Run", "Ride"), length(dates), replace = TRUE), start_date_local = as.POSIXct(dates), date = as.Date(dates), - distance = runif(length(dates), 1000, 15000), # meters - moving_time = as.integer(runif(length(dates), 1200, 5400)), # seconds + distance = runif(length(dates), 1000, 15000), # meters + moving_time = as.integer(runif(length(dates), 1200, 5400)), # seconds elapsed_time = as.integer(runif(length(dates), 1200, 5400)), average_heartrate = runif(length(dates), 120, 170), max_heartrate = runif(length(dates), 160, 190), @@ -36,7 +36,7 @@ create_mock_activities <- function(n = 30) { test_that("calculate_acwr works with activities_data parameter", { mock_activities <- create_mock_activities(60) - + acwr_result <- calculate_acwr( activities_data = mock_activities, load_metric = "duration_mins", @@ -44,15 +44,15 @@ test_that("calculate_acwr works with activities_data parameter", { acute_period = 7, chronic_period = 28 ) - + # Structure checks expect_s3_class(acwr_result, "data.frame") expect_true(all(c("date", "atl", "ctl", "acwr", "acwr_smooth") %in% colnames(acwr_result))) expect_s3_class(acwr_result$date, "Date") - + # Check that we have results expect_gt(nrow(acwr_result), 0) - + # Numerical checks expect_true(is.numeric(acwr_result$atl)) expect_true(is.numeric(acwr_result$ctl)) @@ -65,18 +65,18 @@ test_that("calculate_acwr validates activities_data parameter", { calculate_acwr(activities_data = "not_a_dataframe"), "must be a data frame" ) - + # Test with empty or incomplete data frame empty_df <- data.frame() expect_error( calculate_acwr(activities_data = empty_df), - "activity_type.*must be explicitly specified" # Now checks for activity_type first + "activity_type.*must be explicitly specified" # Now checks for activity_type first ) }) test_that("calculate_acwr validates period parameters", { mock_activities <- create_mock_activities() - + # acute_period must be less than chronic_period expect_error( calculate_acwr( @@ -90,7 +90,7 @@ test_that("calculate_acwr validates period parameters", { test_that("calculate_acwr works with different load metrics", { mock_activities <- create_mock_activities(60) - + # Test duration_mins acwr_duration <- calculate_acwr( activities_data = mock_activities, @@ -98,7 +98,7 @@ test_that("calculate_acwr works with different load metrics", { load_metric = "duration_mins" ) expect_s3_class(acwr_duration, "data.frame") - + # Test distance_km acwr_distance <- calculate_acwr( activities_data = mock_activities, @@ -106,7 +106,7 @@ test_that("calculate_acwr works with different load metrics", { load_metric = "distance_km" ) expect_s3_class(acwr_distance, "data.frame") - + # Test elevation acwr_elevation <- calculate_acwr( activities_data = mock_activities, @@ -118,32 +118,32 @@ test_that("calculate_acwr works with different load metrics", { test_that("calculate_acwr filters by activity type correctly", { mock_activities <- create_mock_activities(60) - + acwr_run <- calculate_acwr( activities_data = mock_activities, activity_type = "Run", load_metric = "duration_mins" ) - + expect_s3_class(acwr_run, "data.frame") expect_gt(nrow(acwr_run), 0) }) test_that("calculate_acwr works with sample data", { - skip_if(is.null(athlytics_sample_acwr), "Sample ACWR data not available") - + skip_if(is.null(sample_acwr), "Sample ACWR data not available") + # Just check that sample data has the right structure - expect_s3_class(athlytics_sample_acwr, "data.frame") - expect_true(all(c("date", "atl", "ctl", "acwr") %in% colnames(athlytics_sample_acwr))) + expect_s3_class(sample_acwr, "data.frame") + expect_true(all(c("date", "atl", "ctl", "acwr") %in% colnames(sample_acwr))) }) # --- Test plot_acwr --- test_that("plot_acwr works with pre-calculated data", { - skip_if(is.null(athlytics_sample_acwr), "Sample ACWR data not available") - - p <- plot_acwr(athlytics_sample_acwr, highlight_zones = FALSE) - + skip_if(is.null(sample_acwr), "Sample ACWR data not available") + + p <- plot_acwr(sample_acwr, highlight_zones = FALSE) + expect_s3_class(p, "ggplot") }) @@ -153,11 +153,11 @@ test_that("plot_acwr validates input", { plot_acwr("not_a_dataframe"), "activities_data.*must be a data frame" ) - + # Test with missing required columns - should error or warn bad_df <- data.frame(x = 1:10, y = 1:10) expect_error( plot_acwr(bad_df), - "activity_type.*must be explicitly specified" # Now checks for activity_type first + "activity_type.*must be explicitly specified" # Now checks for activity_type first ) }) diff --git a/tests/testthat/test-additional-edge-cases.R b/tests/testthat/test-additional-edge-cases.R index a47df76..eab348d 100644 --- a/tests/testthat/test-additional-edge-cases.R +++ b/tests/testthat/test-additional-edge-cases.R @@ -1,4 +1,3 @@ - test_that("additional edge cases for coverage", { # Test with very small numeric values - using reasonable date range activities <- data.frame( @@ -7,12 +6,12 @@ test_that("additional edge cases for coverage", { distance = 0.001, moving_time = 1, average_heartrate = 50, - average_speed = 0.001/1*1000 + average_speed = 0.001 / 1 * 1000 ) - + result <- calculate_ef(activities, start_date = "2023-05-01", end_date = "2023-07-01", quality_control = "off") expect_s3_class(result, "data.frame") - + # Test with very large numeric values activities2 <- data.frame( date = as.Date("2023-06-01"), @@ -20,12 +19,12 @@ test_that("additional edge cases for coverage", { distance = 100000, moving_time = 86400, average_heartrate = 200, - average_speed = 100000/86400*1000 + average_speed = 100000 / 86400 * 1000 ) - + result2 <- calculate_ef(activities2, start_date = "2023-05-01", end_date = "2023-07-01", quality_control = "off") expect_s3_class(result2, "data.frame") - + # Test with NA values in data activities3 <- data.frame( date = as.Date("2023-06-01"), @@ -33,10 +32,9 @@ test_that("additional edge cases for coverage", { distance = 10, moving_time = 3600, average_heartrate = NA, - average_speed = 10/3600*1000 + average_speed = 10 / 3600 * 1000 ) - + result3 <- calculate_ef(activities3, start_date = "2023-05-01", end_date = "2023-07-01", quality_control = "off") expect_s3_class(result3, "data.frame") }) - diff --git a/tests/testthat/test-calculate-decoupling.R b/tests/testthat/test-calculate-decoupling.R index 579c1d8..5440ad4 100644 --- a/tests/testthat/test-calculate-decoupling.R +++ b/tests/testthat/test-calculate-decoupling.R @@ -1,5 +1,5 @@ # Load data: sample data from package & mock API returns from helper -data(athlytics_sample_decoupling) +data(sample_decoupling) source(test_path("helper-mockdata.R"), local = TRUE) # Provides mock_activity_list_list, mock_activity_streams -# Mock Strava token - needed for function signature but API calls will be mocked +# Mock Strava token - needed for function signature but API calls will be mocked diff --git a/tests/testthat/test-calculate-ef-advanced.R b/tests/testthat/test-calculate-ef-advanced.R index 113fb12..dabd2c7 100644 --- a/tests/testthat/test-calculate-ef-advanced.R +++ b/tests/testthat/test-calculate-ef-advanced.R @@ -13,13 +13,14 @@ test_that("calculate_ef handles stream data with velocity calculation", { filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with export_dir parameter (triggers stream data analysis) - result <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "off") + result <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result)) }) @@ -35,20 +36,22 @@ test_that("calculate_ef handles different steady state parameters", { filename = NA, stringsAsFactors = FALSE ) - + # Test with different steady state parameters - result1 <- calculate_ef(mock_data, - min_steady_minutes = 20, - steady_cv_threshold = 0.1, - min_hr_coverage = 0.8, - quality_control = "off") + result1 <- calculate_ef(mock_data, + min_steady_minutes = 20, + steady_cv_threshold = 0.1, + min_hr_coverage = 0.8, + quality_control = "off" + ) expect_true(is.data.frame(result1)) - - result2 <- calculate_ef(mock_data, - min_steady_minutes = 30, - steady_cv_threshold = 0.05, - min_hr_coverage = 0.95, - quality_control = "off") + + result2 <- calculate_ef(mock_data, + min_steady_minutes = 30, + steady_cv_threshold = 0.05, + min_hr_coverage = 0.95, + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -65,13 +68,14 @@ test_that("calculate_ef handles power calculation edge cases", { filename = NA, stringsAsFactors = FALSE ) - - result1 <- calculate_ef(mock_equal, - activity_type = "Ride", - ef_metric = "power_hr", - quality_control = "off") + + result1 <- calculate_ef(mock_equal, + activity_type = "Ride", + ef_metric = "power_hr", + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with zero weighted_average_watts mock_zero_weighted <- data.frame( date = Sys.Date(), @@ -84,11 +88,12 @@ test_that("calculate_ef handles power calculation edge cases", { filename = NA, stringsAsFactors = FALSE ) - - result2 <- calculate_ef(mock_zero_weighted, - activity_type = "Ride", - ef_metric = "power_hr", - quality_control = "off") + + result2 <- calculate_ef(mock_zero_weighted, + activity_type = "Ride", + ef_metric = "power_hr", + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -99,21 +104,21 @@ test_that("calculate_ef handles quality control edge cases", { type = "Run", moving_time = 2400, distance = 8000, - average_heartrate = 50, # Borderline low + average_heartrate = 50, # Borderline low average_watts = 0, weighted_average_watts = 0, filename = NA, stringsAsFactors = FALSE ) - + # Test filter mode with borderline data result_filter <- calculate_ef(mock_borderline_hr, quality_control = "filter") expect_true(is.data.frame(result_filter)) - + # Test flag mode with borderline data result_flag <- calculate_ef(mock_borderline_hr, quality_control = "flag") expect_true(is.data.frame(result_flag)) - + # Test off mode with borderline data result_off <- calculate_ef(mock_borderline_hr, quality_control = "off") expect_true(is.data.frame(result_off)) @@ -131,15 +136,15 @@ test_that("calculate_ef handles multiple ef_metric combinations", { filename = c(NA, NA), stringsAsFactors = FALSE ) - + # Test with multiple ef_metric values result1 <- calculate_ef(mock_data, ef_metric = c("pace_hr", "power_hr"), quality_control = "off") expect_true(is.data.frame(result1)) - + # Test with single ef_metric result2 <- calculate_ef(mock_data, ef_metric = "pace_hr", quality_control = "off") expect_true(is.data.frame(result2)) - + # Test with different ef_metric result3 <- calculate_ef(mock_data, ef_metric = "power_hr", quality_control = "off") expect_true(is.data.frame(result3)) @@ -157,20 +162,24 @@ test_that("calculate_ef handles date range edge cases", { filename = rep(NA, 4), stringsAsFactors = FALSE ) - + # Test with specific date range - result <- calculate_ef(mock_data, - start_date = Sys.Date() - 150, - end_date = Sys.Date() - 50, - quality_control = "off") + result <- calculate_ef(mock_data, + start_date = Sys.Date() - 150, + end_date = Sys.Date() - 50, + quality_control = "off" + ) expect_true(is.data.frame(result)) - + # Test with date range that includes no activities - expect_error(calculate_ef(mock_data, - start_date = Sys.Date() + 1, - end_date = Sys.Date() + 100, - quality_control = "off"), - "No activities found") + expect_error( + calculate_ef(mock_data, + start_date = Sys.Date() + 1, + end_date = Sys.Date() + 100, + quality_control = "off" + ), + "No activities found" + ) }) test_that("calculate_ef handles activity type edge cases", { @@ -185,18 +194,20 @@ test_that("calculate_ef handles activity type edge cases", { filename = rep(NA, 3), stringsAsFactors = FALSE ) - + # Test with single activity type result_run <- calculate_ef(mock_data, activity_type = "Run", quality_control = "off") expect_true(is.data.frame(result_run)) - + # Test with multiple activity types result_multi <- calculate_ef(mock_data, activity_type = c("Run", "Ride"), quality_control = "off") expect_true(is.data.frame(result_multi)) - + # Test with activity type not in data - expect_error(calculate_ef(mock_data, activity_type = "Hike", quality_control = "off"), - "No activities found") + expect_error( + calculate_ef(mock_data, activity_type = "Hike", quality_control = "off"), + "No activities found" + ) }) test_that("calculate_ef handles calculation edge cases", { @@ -204,7 +215,7 @@ test_that("calculate_ef handles calculation edge cases", { mock_short <- data.frame( date = Sys.Date(), type = "Run", - moving_time = 300, # 5 minutes + moving_time = 300, # 5 minutes distance = 1000, average_heartrate = 150, average_watts = 0, @@ -212,19 +223,20 @@ test_that("calculate_ef handles calculation edge cases", { filename = NA, stringsAsFactors = FALSE ) - - result1 <- calculate_ef(mock_short, - activity_type = "Run", - ef_metric = "pace_hr", - min_steady_minutes = 10, - quality_control = "off") + + result1 <- calculate_ef(mock_short, + activity_type = "Run", + ef_metric = "pace_hr", + min_steady_minutes = 10, + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with very long activity mock_long <- data.frame( date = Sys.Date(), type = "Run", - moving_time = 7200, # 2 hours + moving_time = 7200, # 2 hours distance = 20000, average_heartrate = 150, average_watts = 0, @@ -232,11 +244,12 @@ test_that("calculate_ef handles calculation edge cases", { filename = NA, stringsAsFactors = FALSE ) - - result2 <- calculate_ef(mock_long, - activity_type = "Run", - ef_metric = "pace_hr", - quality_control = "off") + + result2 <- calculate_ef(mock_long, + activity_type = "Run", + ef_metric = "pace_hr", + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -252,25 +265,33 @@ test_that("calculate_ef handles parameter validation", { filename = NA, stringsAsFactors = FALSE ) - + # Test with invalid date inputs (should use defaults) - result1 <- tryCatch({ - calculate_ef(mock_data, - start_date = "invalid_date", - quality_control = "off") - }, error = function(e) { - data.frame(date = Sys.Date(), activity_type = "Run", ef_value = 0.02) - }) + result1 <- tryCatch( + { + calculate_ef(mock_data, + start_date = "invalid_date", + quality_control = "off" + ) + }, + error = function(e) { + data.frame(date = Sys.Date(), activity_type = "Run", ef_value = 0.02) + } + ) expect_true(is.data.frame(result1)) - + # Test with invalid end_date (should use defaults) - result2 <- tryCatch({ - calculate_ef(mock_data, - end_date = "invalid_date", - quality_control = "off") - }, error = function(e) { - data.frame(date = Sys.Date(), activity_type = "Run", ef_value = 0.02) - }) + result2 <- tryCatch( + { + calculate_ef(mock_data, + end_date = "invalid_date", + quality_control = "off" + ) + }, + error = function(e) { + data.frame(date = Sys.Date(), activity_type = "Run", ef_value = 0.02) + } + ) expect_true(is.data.frame(result2)) }) @@ -287,10 +308,10 @@ test_that("calculate_ef handles empty and invalid data", { filename = NA, stringsAsFactors = FALSE ) - + result <- calculate_ef(mock_invalid, quality_control = "off") expect_true(is.data.frame(result)) - + # Test with NA values (should handle gracefully) mock_na <- data.frame( date = Sys.Date(), @@ -303,11 +324,14 @@ test_that("calculate_ef handles empty and invalid data", { filename = NA, stringsAsFactors = FALSE ) - - result2 <- tryCatch({ - calculate_ef(mock_na, quality_control = "off") - }, error = function(e) { - data.frame(date = Sys.Date(), activity_type = "Run", ef_value = NA_real_) - }) + + result2 <- tryCatch( + { + calculate_ef(mock_na, quality_control = "off") + }, + error = function(e) { + data.frame(date = Sys.Date(), activity_type = "Run", ef_value = NA_real_) + } + ) expect_true(is.data.frame(result2)) }) diff --git a/tests/testthat/test-calculate-ef-extended.R b/tests/testthat/test-calculate-ef-extended.R index 04d72b7..8ad08c5 100644 --- a/tests/testthat/test-calculate-ef-extended.R +++ b/tests/testthat/test-calculate-ef-extended.R @@ -11,9 +11,9 @@ create_test_activities <- function(n = 30, with_hr = TRUE, with_power = FALSE, w date = seq(Sys.Date() - n, Sys.Date() - 1, by = "day"), distance = runif(n, 5000, 15000), moving_time = runif(n, 1800, 5400), - average_heartrate = if(with_hr) runif(n, 130, 170) else rep(NA_real_, n), - average_watts = if(with_power) runif(n, 180, 250) else rep(NA_real_, n), - average_speed = if(with_speed) runif(n, 2.5, 4.5) else rep(NA_real_, n), + average_heartrate = if (with_hr) runif(n, 130, 170) else rep(NA_real_, n), + average_watts = if (with_power) runif(n, 180, 250) else rep(NA_real_, n), + average_speed = if (with_speed) runif(n, 2.5, 4.5) else rep(NA_real_, n), stringsAsFactors = FALSE ) } @@ -21,36 +21,36 @@ create_test_activities <- function(n = 30, with_hr = TRUE, with_power = FALSE, w test_that("calculate_ef filters by activity type correctly", { activities <- create_test_activities(50) activities$type <- rep(c("Run", "Ride", "Run", "Swim", "Run"), 10) - + ef_runs <- calculate_ef(activities, activity_type = "Run", ef_metric = "pace_hr") expect_true(all(ef_runs$activity_type == "Run")) - + ef_rides <- calculate_ef(activities, activity_type = "Ride", ef_metric = "power_hr") expect_true(all(ef_rides$activity_type == "Ride")) }) test_that("calculate_ef handles missing heart rate data", { activities <- create_test_activities(20, with_hr = FALSE) - + ef_result <- calculate_ef(activities, ef_metric = "pace_hr") - + # Should return data frame even if all HR is missing expect_s3_class(ef_result, "data.frame") }) test_that("calculate_ef handles missing power data", { activities <- create_test_activities(20, with_power = FALSE) - + ef_result <- calculate_ef(activities, ef_metric = "power_hr", activity_type = "Ride") - + expect_s3_class(ef_result, "data.frame") }) test_that("calculate_ef handles missing speed data", { activities <- create_test_activities(20, with_speed = FALSE) - + ef_result <- calculate_ef(activities, ef_metric = "pace_hr") - + expect_s3_class(ef_result, "data.frame") }) @@ -66,9 +66,9 @@ test_that("calculate_ef calculates pace/hr correctly", { average_speed = c(3.33, 3.33, 3.33, 3.33, 3.33), stringsAsFactors = FALSE ) - + ef_result <- calculate_ef(activities, ef_metric = "pace_hr") - + expect_s3_class(ef_result, "data.frame") expect_true("ef_value" %in% names(ef_result)) expect_equal(nrow(ef_result), 5) @@ -86,9 +86,9 @@ test_that("calculate_ef calculates power/hr correctly", { average_watts = c(200, 200, 200, 200, 200), stringsAsFactors = FALSE ) - + ef_result <- calculate_ef(activities, ef_metric = "power_hr", activity_type = "Ride") - + expect_s3_class(ef_result, "data.frame") expect_true("ef_value" %in% names(ef_result)) expect_equal(nrow(ef_result), 5) @@ -96,17 +96,17 @@ test_that("calculate_ef calculates power/hr correctly", { test_that("calculate_ef handles date range filtering", { activities <- create_test_activities(60) - + start_date <- Sys.Date() - 30 end_date <- Sys.Date() - 10 - + ef_result <- calculate_ef( activities, ef_metric = "pace_hr", start_date = start_date, end_date = end_date ) - + expect_s3_class(ef_result, "data.frame") if (nrow(ef_result) > 0) { expect_true(all(ef_result$date >= start_date)) @@ -116,14 +116,14 @@ test_that("calculate_ef handles date range filtering", { test_that("calculate_ef respects min_duration_mins", { activities <- create_test_activities(20) - activities$moving_time <- c(rep(600, 10), rep(3600, 10)) # 10 min vs 60 min - + activities$moving_time <- c(rep(600, 10), rep(3600, 10)) # 10 min vs 60 min + ef_result <- calculate_ef( activities, ef_metric = "pace_hr", min_duration_mins = 30 ) - + expect_s3_class(ef_result, "data.frame") # Should only include activities >= 30 minutes expect_true(nrow(ef_result) <= 10) @@ -131,7 +131,7 @@ test_that("calculate_ef respects min_duration_mins", { test_that("calculate_ef handles empty result set", { activities <- create_test_activities(10) - + # Filter to impossible date range should throw error expect_error( calculate_ef( @@ -147,16 +147,15 @@ test_that("calculate_ef handles empty result set", { test_that("calculate_ef handles multiple activity types", { activities <- create_test_activities(40) activities$type <- rep(c("Run", "Ride"), 20) - + ef_result <- calculate_ef( activities, activity_type = c("Run", "Ride"), ef_metric = "pace_hr" ) - + expect_s3_class(ef_result, "data.frame") if (nrow(ef_result) > 0) { expect_true(all(ef_result$activity_type %in% c("Run", "Ride"))) } }) - diff --git a/tests/testthat/test-calculate-ef-simple.R b/tests/testthat/test-calculate-ef-simple.R index 6c5fe70..1f452e6 100644 --- a/tests/testthat/test-calculate-ef-simple.R +++ b/tests/testthat/test-calculate-ef-simple.R @@ -13,7 +13,7 @@ test_that("calculate_ef basic functionality", { filename = c(NA, NA, NA), stringsAsFactors = FALSE ) - + # Test basic calculation result <- calculate_ef(mock_data, quality_control = "off") expect_true(is.data.frame(result)) @@ -30,11 +30,11 @@ test_that("calculate_ef parameter validation", { average_watts = 0, filename = NA ) - + # Test missing activities_data expect_error(calculate_ef(), "activities_data.*must be provided") expect_error(calculate_ef(NULL), "activities_data.*must be provided") - + # Test invalid parameters expect_error(calculate_ef(mock_data, min_duration_mins = -1), "non-negative") expect_error(calculate_ef(mock_data, min_steady_minutes = -1), "non-negative") @@ -54,11 +54,11 @@ test_that("calculate_ef handles different metrics", { filename = c(NA, NA), stringsAsFactors = FALSE ) - + # Test pace_hr metric result_pace <- calculate_ef(mock_data, activity_type = "Run", ef_metric = "pace_hr", quality_control = "off") expect_true(is.data.frame(result_pace)) - + # Test power_hr metric result_power <- calculate_ef(mock_data, activity_type = "Ride", ef_metric = "power_hr", quality_control = "off") expect_true(is.data.frame(result_power)) @@ -75,10 +75,10 @@ test_that("calculate_ef handles data quality issues", { average_watts = 0, filename = NA ) - + result <- calculate_ef(mock_no_hr, quality_control = "off") expect_true(is.data.frame(result)) - + # Test with zero HR mock_zero_hr <- data.frame( date = Sys.Date(), @@ -89,21 +89,21 @@ test_that("calculate_ef handles data quality issues", { average_watts = 0, filename = NA ) - + result2 <- calculate_ef(mock_zero_hr, quality_control = "off") expect_true(is.data.frame(result2)) - + # Test with too short duration mock_short <- data.frame( date = Sys.Date(), type = "Run", - moving_time = 300, # 5 minutes + moving_time = 300, # 5 minutes distance = 1000, average_heartrate = 150, average_watts = 0, filename = NA ) - + result3 <- calculate_ef(mock_short, min_duration_mins = 20, quality_control = "off") expect_true(is.data.frame(result3)) }) @@ -118,14 +118,14 @@ test_that("calculate_ef handles quality control modes", { average_watts = 0, filename = NA ) - + # Test different quality control modes result_off <- calculate_ef(mock_data, quality_control = "off") expect_true(is.data.frame(result_off)) - + result_flag <- calculate_ef(mock_data, quality_control = "flag") expect_true(is.data.frame(result_flag)) - + result_filter <- calculate_ef(mock_data, quality_control = "filter") expect_true(is.data.frame(result_filter)) }) @@ -141,12 +141,13 @@ test_that("calculate_ef handles date filtering", { filename = rep(NA, 4), stringsAsFactors = FALSE ) - + # Test date filtering - result <- calculate_ef(mock_data, - start_date = Sys.Date() - 60, - end_date = Sys.Date(), - quality_control = "off") + result <- calculate_ef(mock_data, + start_date = Sys.Date() - 60, + end_date = Sys.Date(), + quality_control = "off" + ) expect_true(is.data.frame(result)) }) @@ -160,10 +161,13 @@ test_that("calculate_ef handles no activities found", { average_watts = 0, filename = NA ) - + # Request activities from future dates - expect_error(calculate_ef(mock_old_data, - start_date = Sys.Date() + 1, - end_date = Sys.Date() + 100), - "No activities found") + expect_error( + calculate_ef(mock_old_data, + start_date = Sys.Date() + 1, + end_date = Sys.Date() + 100 + ), + "No activities found" + ) }) diff --git a/tests/testthat/test-calculate-ef-stream.R b/tests/testthat/test-calculate-ef-stream.R index ca9914d..8734b67 100644 --- a/tests/testthat/test-calculate-ef-stream.R +++ b/tests/testthat/test-calculate-ef-stream.R @@ -13,21 +13,23 @@ test_that("calculate_ef handles stream data quality control", { filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with quality_control = "filter" - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "filter") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "filter" + ) expect_true(is.data.frame(result1)) - + # Test with quality_control = "flag" - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "flag") + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "flag" + ) expect_true(is.data.frame(result2)) }) @@ -44,21 +46,23 @@ test_that("calculate_ef handles stream data with different velocity ranges", { filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with pace_hr metric - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with power_hr metric - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "power_hr", - export_dir = ".", - quality_control = "off") + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "power_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -75,26 +79,28 @@ test_that("calculate_ef handles stream data with different steady state paramete filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with different steady state parameters - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - min_steady_minutes = 20, - steady_cv_threshold = 0.1, - min_hr_coverage = 0.8, - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + min_steady_minutes = 20, + steady_cv_threshold = 0.1, + min_hr_coverage = 0.8, + quality_control = "off" + ) expect_true(is.data.frame(result1)) - - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - min_steady_minutes = 30, - steady_cv_threshold = 0.05, - min_hr_coverage = 0.95, - quality_control = "off") + + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + min_steady_minutes = 30, + steady_cv_threshold = 0.05, + min_hr_coverage = 0.95, + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -111,23 +117,25 @@ test_that("calculate_ef handles stream data with different duration requirements filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with short duration requirement - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - min_steady_minutes = 10, - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + min_steady_minutes = 10, + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with long duration requirement - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - min_steady_minutes = 60, - quality_control = "off") + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + min_steady_minutes = 60, + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -144,23 +152,25 @@ test_that("calculate_ef handles stream data with different HR coverage requireme filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with low HR coverage requirement - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - min_hr_coverage = 0.5, - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + min_hr_coverage = 0.5, + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with high HR coverage requirement - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - min_hr_coverage = 0.99, - quality_control = "off") + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + min_hr_coverage = 0.99, + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -177,23 +187,25 @@ test_that("calculate_ef handles stream data with different CV thresholds", { filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with low CV threshold - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - steady_cv_threshold = 0.01, - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + steady_cv_threshold = 0.01, + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with high CV threshold - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - steady_cv_threshold = 0.2, - quality_control = "off") + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + steady_cv_threshold = 0.2, + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -210,25 +222,30 @@ test_that("calculate_ef handles stream data with different activity types", { filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with Ride activity type - result1 <- calculate_ef(mock_activities, - activity_type = "Ride", - ef_metric = "power_hr", - export_dir = ".", - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Ride", + ef_metric = "power_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with Run activity type (may fail due to activity type mismatch) - result2 <- tryCatch({ - calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "off") - }, error = function(e) { - data.frame(date = Sys.Date(), activity_type = "Run", ef_value = NA_real_) - }) + result2 <- tryCatch( + { + calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "off" + ) + }, + error = function(e) { + data.frame(date = Sys.Date(), activity_type = "Run", ef_value = NA_real_) + } + ) expect_true(is.data.frame(result2)) }) @@ -245,20 +262,22 @@ test_that("calculate_ef handles stream data with different export directories", filename = "test_activity.fit", stringsAsFactors = FALSE ) - + # Test with different export directories - result1 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "off") + result1 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result1)) - - result2 <- calculate_ef(mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = "/tmp", - quality_control = "off") + + result2 <- calculate_ef(mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = "/tmp", + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) @@ -275,7 +294,7 @@ test_that("calculate_ef handles stream data with different file extensions", { filename = "test_activity.fit", stringsAsFactors = FALSE ) - + mock_activities_tcx <- data.frame( date = Sys.Date(), type = "Run", @@ -287,20 +306,22 @@ test_that("calculate_ef handles stream data with different file extensions", { filename = "test_activity.tcx", stringsAsFactors = FALSE ) - + # Test with FIT file - result1 <- calculate_ef(mock_activities_fit, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "off") + result1 <- calculate_ef(mock_activities_fit, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result1)) - + # Test with TCX file - result2 <- calculate_ef(mock_activities_tcx, - activity_type = "Run", - ef_metric = "pace_hr", - export_dir = ".", - quality_control = "off") + result2 <- calculate_ef(mock_activities_tcx, + activity_type = "Run", + ef_metric = "pace_hr", + export_dir = ".", + quality_control = "off" + ) expect_true(is.data.frame(result2)) }) diff --git a/tests/testthat/test-calculate-exposure-extended.R b/tests/testthat/test-calculate-exposure-extended.R index bf88801..daa271f 100644 --- a/tests/testthat/test-calculate-exposure-extended.R +++ b/tests/testthat/test-calculate-exposure-extended.R @@ -5,9 +5,9 @@ library(Athlytics) create_test_activities_exposure <- function(n_days = 90) { dates <- seq(Sys.Date() - n_days, Sys.Date() - 1, by = "day") - n_activities <- round(n_days * 0.6) # ~60% of days have activities + n_activities <- round(n_days * 0.6) # ~60% of days have activities activity_dates <- sort(sample(dates, n_activities, replace = FALSE)) - + data.frame( id = seq_along(activity_dates), name = paste("Activity", seq_along(activity_dates)), @@ -15,8 +15,9 @@ create_test_activities_exposure <- function(n_days = 90) { date = activity_dates, distance = abs(rnorm(n_activities, 8000, 2000)), moving_time = abs(rnorm(n_activities, 2400, 600)), - average_watts = ifelse(sample(c(TRUE, FALSE), n_activities, replace = TRUE), - rnorm(n_activities, 200, 50), NA_real_), + average_watts = ifelse(sample(c(TRUE, FALSE), n_activities, replace = TRUE), + rnorm(n_activities, 200, 50), NA_real_ + ), average_heartrate = rnorm(n_activities, 145, 15), stringsAsFactors = FALSE ) @@ -24,13 +25,13 @@ create_test_activities_exposure <- function(n_days = 90) { test_that("calculate_exposure handles different load metrics", { activities <- create_test_activities_exposure(60) - + # Test duration_mins exp_duration <- calculate_exposure(activities, load_metric = "duration_mins") expect_s3_class(exp_duration, "data.frame") expect_true("atl" %in% names(exp_duration)) expect_true("ctl" %in% names(exp_duration)) - + # Test distance_km exp_distance <- calculate_exposure(activities, load_metric = "distance_km") expect_s3_class(exp_distance, "data.frame") @@ -38,11 +39,11 @@ test_that("calculate_exposure handles different load metrics", { test_that("calculate_exposure handles different time windows", { activities <- create_test_activities_exposure(100) - + # Test with different acute/chronic windows exp1 <- calculate_exposure(activities, acute_period = 7, chronic_period = 28) expect_s3_class(exp1, "data.frame") - + exp2 <- calculate_exposure(activities, acute_period = 10, chronic_period = 42) expect_s3_class(exp2, "data.frame") }) @@ -50,22 +51,22 @@ test_that("calculate_exposure handles different time windows", { test_that("calculate_exposure filters by activity type", { activities <- create_test_activities_exposure(60) activities$type <- rep(c("Run", "Ride"), length.out = nrow(activities)) - + exp_runs <- calculate_exposure(activities, activity_type = "Run") expect_s3_class(exp_runs, "data.frame") - + exp_rides <- calculate_exposure(activities, activity_type = "Ride") expect_s3_class(exp_rides, "data.frame") }) test_that("calculate_exposure handles date ranges", { activities <- create_test_activities_exposure(120) - + exp <- calculate_exposure( activities, end_date = Sys.Date() - 30 ) - + expect_s3_class(exp, "data.frame") if (nrow(exp) > 0) { expect_true(all(exp$date <= Sys.Date() - 30)) @@ -74,12 +75,12 @@ test_that("calculate_exposure handles date ranges", { test_that("calculate_exposure calculates ACWR correctly", { activities <- create_test_activities_exposure(60) - + exp <- calculate_exposure(activities) - + expect_s3_class(exp, "data.frame") expect_true("acwr" %in% names(exp)) - + # ACWR should be ATL / CTL (where CTL > 0) if (nrow(exp) > 0) { valid_rows <- exp$ctl > 0 @@ -93,14 +94,13 @@ test_that("calculate_exposure calculates ACWR correctly", { test_that("calculate_exposure handles sparse activity data", { # Create very sparse data (only a few activities) activities <- create_test_activities_exposure(90) - activities <- activities[sample(1:nrow(activities), 5), ] # Keep only 5 activities - + activities <- activities[sample(1:nrow(activities), 5), ] # Keep only 5 activities + exp <- calculate_exposure(activities) - + expect_s3_class(exp, "data.frame") }) test_that("calculate_exposure handles missing data gracefully", { skip("Missing data handling needs to be tested at activity load level") }) - diff --git a/tests/testthat/test-calculate-exposure.R b/tests/testthat/test-calculate-exposure.R index 45bb4bd..cfa4f8f 100644 --- a/tests/testthat/test-calculate-exposure.R +++ b/tests/testthat/test-calculate-exposure.R @@ -6,7 +6,7 @@ library(Athlytics) library(testthat) # Load sample data -data(athlytics_sample_exposure) +data(sample_exposure) # Create mock activities create_mock_activities <- function(n = 30) { @@ -28,14 +28,14 @@ create_mock_activities <- function(n = 30) { test_that("calculate_exposure works with local activities data", { mock_activities <- create_mock_activities(60) - + exposure_result <- calculate_exposure( activities_data = mock_activities, load_metric = "duration_mins", acute_period = 7, chronic_period = 28 ) - + expect_s3_class(exposure_result, "data.frame") expect_true(all(c("date", "atl", "ctl") %in% colnames(exposure_result))) expect_gt(nrow(exposure_result), 0) @@ -49,8 +49,8 @@ test_that("calculate_exposure validates input", { }) test_that("calculate_exposure works with sample data", { - skip_if(is.null(athlytics_sample_exposure), "Sample exposure data not available") - - expect_s3_class(athlytics_sample_exposure, "data.frame") - expect_true("atl" %in% colnames(athlytics_sample_exposure)) + skip_if(is.null(sample_exposure), "Sample exposure data not available") + + expect_s3_class(sample_exposure, "data.frame") + expect_true("atl" %in% colnames(sample_exposure)) }) diff --git a/tests/testthat/test-calculate-functions.R b/tests/testthat/test-calculate-functions.R index 1398c58..7d2e4a3 100644 --- a/tests/testthat/test-calculate-functions.R +++ b/tests/testthat/test-calculate-functions.R @@ -9,10 +9,10 @@ library(lubridate) # Helper function to create realistic activity data create_realistic_activities <- function(n_days = 90, base_date = Sys.Date() - 90) { dates <- seq(base_date, by = "day", length.out = n_days) - + # Simulate realistic running pattern (4-5 runs per week) run_days <- sort(sample(1:n_days, size = round(n_days * 0.6))) - + activities <- data.frame( id = seq_along(run_days), name = paste("Morning Run", seq_along(run_days)), @@ -20,8 +20,8 @@ create_realistic_activities <- function(n_days = 90, base_date = Sys.Date() - 90 sport_type = "Run", date = dates[run_days], start_date_local = as.POSIXct(dates[run_days]), - distance = abs(rnorm(length(run_days), mean = 8000, sd = 2000)), # 8km average - moving_time = abs(rnorm(length(run_days), mean = 2400, sd = 600)), # 40min average + distance = abs(rnorm(length(run_days), mean = 8000, sd = 2000)), # 8km average + moving_time = abs(rnorm(length(run_days), mean = 2400, sd = 600)), # 40min average elapsed_time = abs(rnorm(length(run_days), mean = 2500, sd = 700)), total_elevation_gain = abs(rnorm(length(run_days), mean = 100, sd = 50)), average_heartrate = abs(rnorm(length(run_days), mean = 145, sd = 15)), @@ -29,24 +29,24 @@ create_realistic_activities <- function(n_days = 90, base_date = Sys.Date() - 90 average_speed = abs(rnorm(length(run_days), mean = 3.3, sd = 0.3)), max_speed = abs(rnorm(length(run_days), mean = 4.5, sd = 0.5)), average_cadence = rnorm(length(run_days), mean = 170, sd = 10), - average_watts = NA_real_, # No power for runs + average_watts = NA_real_, # No power for runs kilojoules = NA_real_, has_heartrate = TRUE, gear_id = NA_character_, filename = paste0("activities/", run_days, ".fit"), stringsAsFactors = FALSE ) - + # Ensure positive values activities$distance <- abs(activities$distance) activities$moving_time <- abs(activities$moving_time) activities$elapsed_time <- pmax(activities$elapsed_time, activities$moving_time) - + # Add calculated fields activities$distance_km <- activities$distance / 1000 activities$duration_mins <- activities$moving_time / 60 activities$average_speed_kmh <- (activities$distance_km / activities$duration_mins) * 60 - + return(activities) } @@ -54,12 +54,12 @@ create_realistic_activities <- function(n_days = 90, base_date = Sys.Date() - 90 create_activity_stream <- function(duration_seconds = 3600, steady_state = TRUE) { time_points <- seq(0, duration_seconds, by = 1) n_points <- length(time_points) - + # Base values base_hr <- 150 - base_pace <- 3.0 # m/s - base_power <- 200 # watts - + base_pace <- 3.0 # m/s + base_power <- 200 # watts + if (steady_state) { # Steady state: low variation hr_variation <- rnorm(n_points, 0, 2) @@ -71,7 +71,7 @@ create_activity_stream <- function(duration_seconds = 3600, steady_state = TRUE) pace_variation <- sin(time_points / 200) * 0.5 + rnorm(n_points, 0, 0.1) power_variation <- sin(time_points / 250) * 50 + rnorm(n_points, 0, 10) } - + stream_df <- data.frame( time = time_points, heartrate = round(base_hr + hr_variation), @@ -84,20 +84,20 @@ create_activity_stream <- function(duration_seconds = 3600, steady_state = TRUE) moving = rep(TRUE, n_points), stringsAsFactors = FALSE ) - + # Ensure positive values stream_df$heartrate <- pmax(stream_df$heartrate, 60) stream_df$heartrate <- pmin(stream_df$heartrate, 200) stream_df$velocity_smooth <- pmax(stream_df$velocity_smooth, 0.5) stream_df$watts <- pmax(stream_df$watts, 0) - + return(stream_df) } # Test calculate_acwr test_that("calculate_acwr works with simulated data", { activities <- create_realistic_activities(90) - + result <- calculate_acwr( activities_data = activities, load_metric = "duration_mins", @@ -105,7 +105,7 @@ test_that("calculate_acwr works with simulated data", { acute_period = 7, chronic_period = 28 ) - + expect_s3_class(result, "data.frame") expect_true(all(c("date", "atl", "ctl", "acwr", "acwr_smooth") %in% colnames(result))) expect_gt(nrow(result), 0) @@ -116,7 +116,7 @@ test_that("calculate_acwr works with simulated data", { test_that("calculate_acwr handles different load metrics", { activities <- create_realistic_activities(60) - + # Test with distance result_distance <- calculate_acwr( activities_data = activities, @@ -125,7 +125,7 @@ test_that("calculate_acwr handles different load metrics", { ) expect_s3_class(result_distance, "data.frame") expect_gt(mean(result_distance$atl, na.rm = TRUE), 0) - + # Test with duration (should always work) result_duration <- calculate_acwr( activities_data = activities, @@ -138,13 +138,13 @@ test_that("calculate_acwr handles different load metrics", { # Test calculate_acwr_ewma test_that("calculate_acwr_ewma works with simulated data", { activities <- create_realistic_activities(90) - + result <- calculate_acwr_ewma( activities_data = activities, activity_type = "Run", load_metric = "duration_mins" ) - + expect_s3_class(result, "data.frame") expect_true(all(c("date", "atl", "ctl", "acwr", "acwr_smooth") %in% colnames(result))) # EWMA returns all dates in the range (including dates without activities) @@ -163,7 +163,7 @@ test_that("calculate_acwr_ewma handles edge cases", { expect_gt(nrow(result), 0) # Check that the activity date is included expect_true(single_activity$date[1] %in% result$date) - + # Empty data empty_df <- data.frame() expect_error(calculate_acwr_ewma(activities_data = empty_df, activity_type = "Run")) @@ -174,12 +174,12 @@ test_that("calculate_ef works with simulated data", { activities <- create_realistic_activities(30) # Add some activities with heartrate activities$average_heartrate <- rnorm(nrow(activities), mean = 145, sd = 15) - + result <- calculate_ef( activities_data = activities, ef_metric = "pace_hr" ) - + expect_s3_class(result, "data.frame") expect_true(all(c("date", "ef_value", "activity_type") %in% colnames(result))) expect_gt(nrow(result), 0) @@ -188,18 +188,18 @@ test_that("calculate_ef works with simulated data", { test_that("calculate_ef handles different metrics", { activities <- create_realistic_activities(20) - + # Add power data for some activities activities$average_watts <- ifelse( runif(nrow(activities)) > 0.5, rnorm(nrow(activities), mean = 200, sd = 30), NA ) - + # Test pace/HR result_pace <- calculate_ef(activities_data = activities, ef_metric = "pace_hr") expect_gt(nrow(result_pace), 0) - + # Test power/HR (only for activities with power) result_power <- calculate_ef(activities_data = activities, ef_metric = "power_hr") power_activities <- sum(!is.na(activities$average_watts) & !is.na(activities$average_heartrate)) @@ -211,22 +211,22 @@ test_that("calculate_ef handles different metrics", { test_that("calculate_decoupling works with simulated stream data", { # Test steady state (low decoupling) steady_stream <- create_activity_stream(duration_seconds = 3600, steady_state = TRUE) - + decoupling_steady <- calculate_decoupling( stream_df = steady_stream, decouple_metric = "pace_hr" ) - + expect_type(decoupling_steady, "double") expect_true(is.finite(decoupling_steady)) - expect_true(decoupling_steady > -20 && decoupling_steady < 20) # Reasonable range - + expect_true(decoupling_steady > -20 && decoupling_steady < 20) # Reasonable range + # Test with power/HR decoupling_power <- calculate_decoupling( stream_df = steady_stream, decouple_metric = "power_hr" ) - + expect_type(decoupling_power, "double") expect_true(is.finite(decoupling_power)) }) @@ -234,13 +234,13 @@ test_that("calculate_decoupling works with simulated stream data", { test_that("calculate_decoupling handles non-steady state", { # Create non-steady state data variable_stream <- create_activity_stream(duration_seconds = 3600, steady_state = FALSE) - + # Should still calculate but might have higher values decoupling <- calculate_decoupling( stream_df = variable_stream, decouple_metric = "pace_hr" ) - + expect_type(decoupling, "double") # Non-steady state might have values outside typical range expect_true(is.finite(decoupling) || is.na(decoupling)) @@ -249,12 +249,12 @@ test_that("calculate_decoupling handles non-steady state", { # Test calculate_exposure test_that("calculate_exposure works with simulated data", { activities <- create_realistic_activities(60) - + result <- calculate_exposure( activities_data = activities, load_metric = "duration_mins" ) - + expect_s3_class(result, "data.frame") expect_true(all(c("date", "atl", "ctl") %in% colnames(result))) expect_gt(nrow(result), 0) @@ -265,7 +265,7 @@ test_that("calculate_exposure works with simulated data", { # Test calculate_pbs test_that("calculate_pbs handles missing stream files gracefully", { activities <- create_realistic_activities(10) - + # This should error when directory doesn't exist expect_error( calculate_pbs( @@ -281,29 +281,29 @@ test_that("calculate_pbs handles missing stream files gracefully", { test_that("flag_quality works with simulated data", { skip("Temporarily disabled - needs stream data") activities <- create_realistic_activities(30) - + # Add some quality issues activities$average_heartrate[c(5, 10)] <- NA activities$distance[15] <- 0 if (nrow(activities) >= 20) { - activities$moving_time[20] <- activities$elapsed_time[20] * 2 # Impossible + activities$moving_time[20] <- activities$elapsed_time[20] * 2 # Impossible } - + flagged <- flag_quality(activities) - + expect_s3_class(flagged, "data.frame") expect_true("quality_flag" %in% colnames(flagged)) expect_true("quality_note" %in% colnames(flagged)) - expect_gt(sum(!is.na(flagged$quality_flag)), 0) # Should flag some issues + expect_gt(sum(!is.na(flagged$quality_flag)), 0) # Should flag some issues }) test_that("quality_summary works with flagged data", { skip("Temporarily disabled - needs stream data") activities <- create_realistic_activities(30) flagged <- flag_quality(activities) - - summary <- quality_summary(flagged) - + + summary <- summarize_quality(flagged) + expect_s3_class(summary, "data.frame") expect_true(all(c("flag", "count", "percentage", "example_dates") %in% colnames(summary))) }) @@ -322,17 +322,17 @@ test_that("cohort_reference works with simulated multi-athlete data", { acwr_data$athlete_id <- paste0("athlete_", i) athlete_data[[i]] <- acwr_data } - + cohort_data <- bind_rows(athlete_data) - - reference <- cohort_reference( + + reference <- calculate_cohort_reference( data = cohort_data, metric = "acwr", by = NULL, probs = c(0.05, 0.25, 0.50, 0.75, 0.95), min_athletes = 3 ) - + expect_s3_class(reference, "data.frame") expect_true(all(c("date", "percentile", "value", "n_athletes") %in% colnames(reference))) expect_equal(length(unique(reference$percentile)), 5) diff --git a/tests/testthat/test-calculate-with-mock-files.R b/tests/testthat/test-calculate-with-mock-files.R index 8a4fc33..f3246cd 100644 --- a/tests/testthat/test-calculate-with-mock-files.R +++ b/tests/testthat/test-calculate-with-mock-files.R @@ -12,10 +12,10 @@ source(test_path("helper-mock-files.R"), local = TRUE) test_that("calculate_pbs works with mock TCX files", { # Create mock export mock_export <- create_mock_strava_export(n_activities = 10) - + # Load activities activities <- load_local_activities(file.path(mock_export, "activities.csv")) - + # Calculate PBs pbs_result <- calculate_pbs( activities_data = activities, @@ -23,13 +23,13 @@ test_that("calculate_pbs works with mock TCX files", { activity_type = "Run", distances_m = c(1000, 5000, 10000) ) - + expect_s3_class(pbs_result, "data.frame") expect_true(all(c("activity_id", "activity_date", "distance", "time_seconds", "is_pb") %in% names(pbs_result))) - + # Check that we have some PBs expect_gt(sum(pbs_result$is_pb), 0) - + # Clean up cleanup_mock_export(mock_export) }) @@ -38,13 +38,13 @@ test_that("calculate_pbs works with mock TCX files", { test_that("calculate_decoupling works with mock activity files", { # Create mock export with activities that have good duration mock_export <- create_mock_strava_export(n_activities = 5) - + # Load activities activities <- load_local_activities(file.path(mock_export, "activities.csv")) - + # Make sure activities have sufficient duration - activities$moving_time <- pmax(activities$moving_time, 2400) # At least 40 minutes - + activities$moving_time <- pmax(activities$moving_time, 2400) # At least 40 minutes + # Calculate decoupling decoupling_result <- calculate_decoupling( activities_data = activities, @@ -53,15 +53,15 @@ test_that("calculate_decoupling works with mock activity files", { decouple_metric = "pace_hr", min_duration_mins = 30 ) - + expect_s3_class(decoupling_result, "data.frame") expect_true(all(c("date", "decoupling", "status") %in% names(decoupling_result))) - + # Some activities should have valid decoupling values # Mock TCX files may not have proper heart rate data for decoupling # Just check the structure is correct expect_true(is.data.frame(decoupling_result)) - + # Clean up cleanup_mock_export(mock_export) }) @@ -70,10 +70,10 @@ test_that("calculate_decoupling works with mock activity files", { test_that("calculate_ef works with activity stream data", { # Create mock export mock_export <- create_mock_strava_export(n_activities = 5) - + # Load activities activities <- load_local_activities(file.path(mock_export, "activities.csv")) - + # For stream-based EF calculation, we need to ensure parse_activity_file works # This is a simplified test since real parsing is complex ef_result <- calculate_ef( @@ -81,10 +81,10 @@ test_that("calculate_ef works with activity stream data", { ef_metric = "pace_hr", activity_type = "Run" ) - + expect_s3_class(ef_result, "data.frame") expect_true(all(c("date", "ef_value", "activity_type") %in% names(ef_result))) - + # Clean up cleanup_mock_export(mock_export) }) @@ -93,19 +93,19 @@ test_that("calculate_ef works with activity stream data", { test_that("load_local_activities can handle mock export directory", { # Create mock export mock_export <- create_mock_strava_export(n_activities = 8) - + # Test loading from directory activities <- load_local_activities(file.path(mock_export, "activities.csv")) - + expect_s3_class(activities, "data.frame") expect_equal(nrow(activities), 8) expect_true(all(c("id", "date", "type", "distance", "moving_time") %in% names(activities))) - + # Check data types expect_true(is.numeric(activities$distance)) expect_true(is.numeric(activities$moving_time)) expect_s3_class(activities$date, "Date") - + # Clean up cleanup_mock_export(mock_export) }) @@ -113,40 +113,40 @@ test_that("load_local_activities can handle mock export directory", { # Test parse_activity_file with different file types test_that("parse_activity_file handles different mock file types", { temp_dir <- tempdir() - + # Create different file types tcx_file <- file.path(temp_dir, "test.tcx") fit_file <- file.path(temp_dir, "test.fit") gpx_file <- file.path(temp_dir, "test.gpx") - + create_mock_tcx_file(tcx_file, Sys.Date(), 3600, 10000) create_mock_fit_file(fit_file, Sys.Date(), 3600, 10000) create_mock_gpx_file(gpx_file, Sys.Date(), 3600, 10000) - + # Test TCX parsing tcx_data <- tryCatch( parse_activity_file(tcx_file), error = function(e) NULL ) - + # Test FIT parsing (as CSV) fit_data <- tryCatch( parse_activity_file(fit_file), error = function(e) NULL ) - + # Test GPX parsing gpx_data <- tryCatch( parse_activity_file(gpx_file), error = function(e) NULL ) - + # At least one should parse successfully # Check that we can at least create the files expect_true(file.exists(tcx_file)) expect_true(file.exists(fit_file)) expect_true(file.exists(gpx_file)) - + # Clean up unlink(c(tcx_file, fit_file, gpx_file)) }) @@ -156,25 +156,25 @@ test_that("flag_quality works with mock export data", { skip("Temporarily disabled - needs stream data") # Create mock export mock_export <- create_mock_strava_export(n_activities = 10) - + # Load activities activities <- load_local_activities(file.path(mock_export, "activities.csv")) - + # Add some quality issues activities$average_heartrate[c(2, 5)] <- NA activities$distance[8] <- 0 activities$moving_time[3] <- activities$elapsed_time[3] * 2 - + # Flag quality issues flagged <- flag_quality(activities) - + expect_s3_class(flagged, "data.frame") expect_true("quality_flag" %in% names(flagged)) expect_true("quality_note" %in% names(flagged)) - + # Should have flagged some issues expect_gt(sum(!is.na(flagged$quality_flag)), 0) - + # Clean up cleanup_mock_export(mock_export) }) @@ -184,10 +184,10 @@ test_that("integrated workflow works with mock files", { skip("Temporarily disabled to check coverage") # Create mock export mock_export <- create_mock_strava_export(n_activities = 30) - + # Load activities activities <- load_local_activities(file.path(mock_export, "activities.csv")) - + # Calculate ACWR acwr_result <- calculate_acwr( activities_data = activities, @@ -195,7 +195,7 @@ test_that("integrated workflow works with mock files", { load_metric = "duration_mins" ) expect_s3_class(acwr_result, "data.frame") - + # Calculate exposure exposure_result <- calculate_exposure( activities_data = activities, @@ -203,11 +203,11 @@ test_that("integrated workflow works with mock files", { load_metric = "distance_km" ) expect_s3_class(exposure_result, "data.frame") - + # Create plots (just check they don't error) expect_s3_class(plot_acwr(acwr_result), "ggplot") expect_s3_class(plot_exposure(exposure_result), "ggplot") - + # Clean up cleanup_mock_export(mock_export) }) diff --git a/tests/testthat/test-cohort-reference.R b/tests/testthat/test-cohort-reference.R index 206f046..d5cde13 100644 --- a/tests/testthat/test-cohort-reference.R +++ b/tests/testthat/test-cohort-reference.R @@ -3,10 +3,10 @@ test_that("cohort_reference calculates percentiles correctly", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") - + # Create multi-athlete test data dates <- rep(seq(as.Date("2024-01-01"), by = "day", length.out = 30), times = 10) - + cohort_data <- data.frame( date = dates, athlete_id = rep(paste0("athlete", 1:10), each = 30), @@ -14,31 +14,31 @@ test_that("cohort_reference calculates percentiles correctly", { acwr_smooth = rnorm(300, mean = 1.0, sd = 0.2), stringsAsFactors = FALSE ) - + # Calculate reference percentiles - result <- cohort_reference( + result <- calculate_cohort_reference( cohort_data, metric = "acwr_smooth", by = c("sport"), probs = c(0.25, 0.5, 0.75), min_athletes = 5 ) - + # Check structure expect_true(is.data.frame(result)) expect_true(all(c("date", "percentile", "value", "n_athletes") %in% colnames(result))) - + # Check that we have 3 percentiles per date dates_count <- unique(result$date) expect_equal(length(unique(result$percentile)), 3) - + # Check that n_athletes is correct (should be 10) expect_true(all(result$n_athletes == 10)) }) test_that("cohort_reference respects min_athletes threshold", { skip_if_not_installed("dplyr") - + # Create data with only 3 athletes cohort_data <- data.frame( date = rep(as.Date("2024-01-01"), 3), @@ -47,30 +47,30 @@ test_that("cohort_reference respects min_athletes threshold", { acwr_smooth = c(0.8, 1.0, 1.2), stringsAsFactors = FALSE ) - + # With min_athletes = 5, should error or return empty expect_error( - cohort_reference( + calculate_cohort_reference( cohort_data, metric = "acwr_smooth", min_athletes = 5 ), "No groups have at least.*athletes" ) - + # With min_athletes = 3, should work - result <- cohort_reference( + result <- calculate_cohort_reference( cohort_data, metric = "acwr_smooth", min_athletes = 3 ) - + expect_gt(nrow(result), 0) }) test_that("cohort_reference handles grouping variables", { skip_if_not_installed("dplyr") - + # Create data with multiple sports cohort_data <- data.frame( date = rep(seq(as.Date("2024-01-01"), by = "day", length.out = 10), times = 10), @@ -79,15 +79,15 @@ test_that("cohort_reference handles grouping variables", { acwr_smooth = rnorm(100, mean = 1.0, sd = 0.2), stringsAsFactors = FALSE ) - + # Group by sport - result <- cohort_reference( + result <- calculate_cohort_reference( cohort_data, metric = "acwr_smooth", by = c("sport"), min_athletes = 3 ) - + # Should have both sports expect_true("sport" %in% colnames(result)) expect_setequal(unique(result$sport), c("Run", "Ride")) @@ -96,18 +96,18 @@ test_that("cohort_reference handles grouping variables", { test_that("cohort_reference validates input", { # Empty data expect_error( - cohort_reference(data.frame()), + calculate_cohort_reference(data.frame()), "data.*empty" ) - + # Missing required column bad_data <- data.frame( date = as.Date("2024-01-01"), athlete_id = "athlete1" ) - + expect_error( - cohort_reference(bad_data, metric = "acwr_smooth"), + calculate_cohort_reference(bad_data, metric = "acwr_smooth"), "Missing required columns" ) }) @@ -116,37 +116,37 @@ test_that("plot_with_reference creates valid plot", { skip_if_not_installed("ggplot2") skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") - + # Create individual data individual_data <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 30), acwr_smooth = rnorm(30, mean = 1.1, sd = 0.15) ) - + # Create reference data reference_data <- data.frame( date = rep(seq(as.Date("2024-01-01"), by = "day", length.out = 30), times = 5), percentile = rep(c("p05", "p25", "p50", "p75", "p95"), each = 30), value = c( - rnorm(30, 0.6, 0.05), # p05 - rnorm(30, 0.8, 0.05), # p25 - rnorm(30, 1.0, 0.05), # p50 - rnorm(30, 1.2, 0.05), # p75 - rnorm(30, 1.4, 0.05) # p95 + rnorm(30, 0.6, 0.05), # p05 + rnorm(30, 0.8, 0.05), # p25 + rnorm(30, 1.0, 0.05), # p50 + rnorm(30, 1.2, 0.05), # p75 + rnorm(30, 1.4, 0.05) # p95 ), n_athletes = 10 ) - + # Create plot p <- plot_with_reference( individual = individual_data, reference = reference_data, metric = "acwr_smooth" ) - + # Check that plot is created expect_s3_class(p, "ggplot") - + # Check plot components expect_true(length(p$layers) > 0) }) @@ -154,16 +154,16 @@ test_that("plot_with_reference creates valid plot", { test_that("add_reference_bands adds layers to plot", { skip_if_not_installed("ggplot2") skip_if_not_installed("dplyr") - + # Create base plot plot_data <- data.frame( date = seq(as.Date("2024-01-01"), by = "day", length.out = 30), value = rnorm(30, 1.0, 0.1) ) - + base_plot <- ggplot2::ggplot(plot_data, ggplot2::aes(x = date, y = value)) + ggplot2::geom_line() - + # Create reference data reference_data <- data.frame( date = rep(seq(as.Date("2024-01-01"), by = "day", length.out = 30), times = 5), @@ -173,10 +173,10 @@ test_that("add_reference_bands adds layers to plot", { ), n_athletes = 10 ) - + # Add bands plot_with_bands <- add_reference_bands(base_plot, reference_data) - + # Check that layers were added expect_s3_class(plot_with_bands, "ggplot") expect_gt(length(plot_with_bands$layers), length(base_plot$layers)) @@ -184,26 +184,46 @@ test_that("add_reference_bands adds layers to plot", { test_that("cohort_reference handles missing grouping variables gracefully", { skip_if_not_installed("dplyr") - + cohort_data <- data.frame( date = rep(as.Date("2024-01-01"), 10), athlete_id = paste0("athlete", 1:10), acwr_smooth = rnorm(10, 1.0, 0.2), stringsAsFactors = FALSE ) - + # Request grouping by a non-existent variable expect_warning( - result <- cohort_reference( + result <- calculate_cohort_reference( cohort_data, metric = "acwr_smooth", - by = c("sport", "nonexistent_var"), # "sport" doesn't exist + by = c("sport", "nonexistent_var"), # "sport" doesn't exist min_athletes = 5 ), "Grouping variable.*not found" ) - + # Should still work, just without grouping expect_true(is.data.frame(result)) }) + +test_that("cohort_reference is deprecated but remains available", { + skip_if_not_installed("dplyr") + skip_if_not_installed("tidyr") + + dates <- rep(seq(as.Date("2024-01-01"), by = "day", length.out = 10), times = 10) + cohort_data <- data.frame( + date = dates, + athlete_id = rep(paste0("athlete", 1:10), each = 10), + sport = "Run", + acwr_smooth = rnorm(100, mean = 1.0, sd = 0.2), + stringsAsFactors = FALSE + ) + + expect_warning( + out <- cohort_reference(cohort_data, metric = "acwr_smooth", by = "sport", min_athletes = 3), + "deprecated" + ) + expect_true(is.data.frame(out)) +}) diff --git a/tests/testthat/test-color-palettes.R b/tests/testthat/test-color-palettes.R index 5fc2509..9fad9f8 100644 --- a/tests/testthat/test-color-palettes.R +++ b/tests/testthat/test-color-palettes.R @@ -7,19 +7,19 @@ library(ggplot2) # Test palette functions test_that("athlytics_palette_nature returns correct colors", { palette <- athlytics_palette_nature() - + expect_type(palette, "character") expect_length(palette, 9) expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", palette))) - + # Check specific colors - expect_equal(palette[1], "#E64B35") # Red - expect_equal(palette[2], "#4DBBD5") # Cyan + expect_equal(palette[1], "#E64B35") # Red + expect_equal(palette[2], "#4DBBD5") # Cyan }) test_that("athlytics_palette_academic returns correct colors", { palette <- athlytics_palette_academic() - + expect_type(palette, "character") expect_length(palette, 8) expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", palette))) @@ -27,7 +27,7 @@ test_that("athlytics_palette_academic returns correct colors", { test_that("athlytics_palette_vibrant returns correct colors", { palette <- athlytics_palette_vibrant() - + expect_type(palette, "character") expect_length(palette, 8) expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", palette))) @@ -35,7 +35,7 @@ test_that("athlytics_palette_vibrant returns correct colors", { test_that("athlytics_palette_science returns correct colors", { palette <- athlytics_palette_science() - + expect_type(palette, "character") expect_length(palette, 8) expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", palette))) @@ -43,7 +43,7 @@ test_that("athlytics_palette_science returns correct colors", { test_that("athlytics_palette_cell returns correct colors", { palette <- athlytics_palette_cell() - + expect_type(palette, "character") expect_length(palette, 8) expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", palette))) @@ -52,7 +52,7 @@ test_that("athlytics_palette_cell returns correct colors", { # Test specialized color functions test_that("athlytics_colors_acwr_zones returns named list", { colors <- athlytics_colors_acwr_zones() - + expect_type(colors, "list") expect_named(colors) expect_true(all(c("undertraining", "safe", "caution", "high_risk") %in% names(colors))) @@ -61,7 +61,7 @@ test_that("athlytics_colors_acwr_zones returns named list", { test_that("athlytics_colors_training_load returns named list", { colors <- athlytics_colors_training_load() - + expect_type(colors, "list") expect_named(colors) expect_true(all(c("acute", "chronic", "ratio") %in% names(colors))) @@ -70,7 +70,7 @@ test_that("athlytics_colors_training_load returns named list", { test_that("athlytics_colors_ef returns named list", { colors <- athlytics_colors_ef() - + expect_type(colors, "list") expect_named(colors) expect_true(all(c("run", "ride", "swim", "other") %in% names(colors))) @@ -80,7 +80,7 @@ test_that("athlytics_colors_ef returns named list", { # Test theme function test_that("theme_athlytics returns ggplot theme", { theme <- theme_athlytics() - + expect_s3_class(theme, "theme") expect_s3_class(theme, "gg") }) @@ -88,7 +88,7 @@ test_that("theme_athlytics returns ggplot theme", { test_that("theme_athlytics accepts custom parameters", { theme1 <- theme_athlytics(base_size = 14) theme2 <- theme_athlytics(base_family = "Arial") - + expect_s3_class(theme1, "theme") expect_s3_class(theme2, "theme") }) @@ -98,19 +98,19 @@ test_that("scale_athlytics works with different palettes", { # Test with nature palette scale1 <- scale_athlytics("nature", "color") expect_s3_class(scale1, "ScaleDiscrete") - + # Test with academic palette scale2 <- scale_athlytics("academic", "fill") expect_s3_class(scale2, "ScaleDiscrete") - + # Test with vibrant palette scale3 <- scale_athlytics("vibrant", "color") expect_s3_class(scale3, "ScaleDiscrete") - + # Test with science palette scale4 <- scale_athlytics("science", "fill") expect_s3_class(scale4, "ScaleDiscrete") - + # Test with cell palette scale5 <- scale_athlytics("cell", "color") expect_s3_class(scale5, "ScaleDiscrete") @@ -130,19 +130,19 @@ test_that("color palettes work with ggplot", { y = 1:5, group = letters[1:5] ) - + # Test with nature palette p1 <- ggplot(test_data, aes(x, y, color = group)) + geom_line() + scale_athlytics("nature", "color") expect_s3_class(p1, "ggplot") - + # Test with academic palette p2 <- ggplot(test_data, aes(x, y, fill = group)) + geom_bar(stat = "identity") + scale_athlytics("academic", "fill") expect_s3_class(p2, "ggplot") - + # Test with theme p3 <- ggplot(test_data, aes(x, y)) + geom_line() + @@ -159,7 +159,7 @@ test_that("palettes contain distinct colors", { science = athlytics_palette_science(), cell = athlytics_palette_cell() ) - + for (palette_name in names(palettes)) { colors <- palettes[[palette_name]] # Check that all colors are unique @@ -176,15 +176,15 @@ test_that("all colors are valid hex codes", { athlytics_palette_science(), athlytics_palette_cell() ) - + all_specialized <- c( unlist(athlytics_colors_acwr_zones()), unlist(athlytics_colors_training_load()), unlist(athlytics_colors_ef()) ) - + all_colors <- c(all_palettes, all_specialized) - + # All should be valid hex codes expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", all_colors))) }) @@ -192,7 +192,7 @@ test_that("all colors are valid hex codes", { # Test theme elements test_that("theme_athlytics has expected elements", { theme <- theme_athlytics() - + # Check that key theme elements are present expect_true("plot.title" %in% names(theme)) expect_true("axis.title" %in% names(theme)) diff --git a/tests/testthat/test-date-ranges.R b/tests/testthat/test-date-ranges.R index 73009a0..d9998c6 100644 --- a/tests/testthat/test-date-ranges.R +++ b/tests/testthat/test-date-ranges.R @@ -1,4 +1,3 @@ - test_that("date range tests for coverage", { activities <- data.frame( date = as.Date(c("2023-01-01", "2023-06-15", "2023-12-31")), @@ -6,19 +5,18 @@ test_that("date range tests for coverage", { distance = c(10, 15, 20), moving_time = c(3600, 5400, 7200), average_heartrate = c(150, 160, 170), - average_speed = c(10/3600*1000, 15/5400*1000, 20/7200*1000) + average_speed = c(10 / 3600 * 1000, 15 / 5400 * 1000, 20 / 7200 * 1000) ) - + # Test start date filtering result1 <- calculate_ef(activities, start_date = "2023-03-01", end_date = "2024-01-01", quality_control = "off") expect_s3_class(result1, "data.frame") - + # Test end date filtering result2 <- calculate_ef(activities, start_date = "2022-01-01", end_date = "2023-09-01", quality_control = "off") expect_s3_class(result2, "data.frame") - + # Test date range filtering result3 <- calculate_ef(activities, start_date = "2023-02-01", end_date = "2023-08-01", quality_control = "off") expect_s3_class(result3, "data.frame") }) - diff --git a/tests/testthat/test-decoupling.R b/tests/testthat/test-decoupling.R index 5efe594..bfa2593 100644 --- a/tests/testthat/test-decoupling.R +++ b/tests/testthat/test-decoupling.R @@ -3,16 +3,16 @@ library(testthat) library(Athlytics) library(lubridate) # Ensure lubridate is loaded for ymd in english_month_year tests -# library(rStrava) # No longer needed directly if we use stream_df or Athlytics_sample_data +# library(rStrava) # No longer needed directly if we use stream_df or sample data # Load main sample data for the package -data(Athlytics_sample_data) +data(sample_decoupling) # Load data from helper for direct use in tests # Ensure helper-mockdata.R is in the tests/testthat directory source(test_path("helper-mockdata.R"), local = TRUE) -# --- Test english_month_year --- +# --- Test english_month_year --- # This helper is defined in R/utils.R test_that("english_month_year formats dates correctly", { @@ -31,7 +31,7 @@ test_that("english_month_year formats dates correctly", { # Test with a leap year date leap_date <- ymd("2024-02-29") expect_equal(Athlytics:::english_month_year(leap_date), "Feb 2024") - + # Test with an empty vector of dates empty_dates <- ymd(character(0)) expect_equal(Athlytics:::english_month_year(empty_dates), character(0)) @@ -42,10 +42,10 @@ test_that("english_month_year formats dates correctly", { test_that("calculate_decoupling computes a plausible value from mock stream_df", { # This test uses mock_activity_streams from helpe-mockdata.R for single activity stream processing expect_true(exists("mock_activity_streams"), "mock_activity_streams not loaded from helper.") - + decoupling_power_hr <- calculate_decoupling(stream_df = mock_activity_streams, decouple_metric = "power_hr") decoupling_pace_hr <- calculate_decoupling(stream_df = mock_activity_streams, decouple_metric = "pace_hr") - + expect_type(decoupling_power_hr, "double") expect_type(decoupling_pace_hr, "double") expect_true(is.finite(decoupling_power_hr)) @@ -60,33 +60,36 @@ test_that("calculate_decoupling handles missing columns in stream_df", { # Test missing watts for power_hr mock_streams_no_watts <- mock_activity_streams[, !(names(mock_activity_streams) %in% "watts")] - expect_error(calculate_decoupling(stream_df = mock_streams_no_watts, decouple_metric = "power_hr"), - regexp = "must contain 'watts' column") - + expect_error(calculate_decoupling(stream_df = mock_streams_no_watts, decouple_metric = "power_hr"), + regexp = "must contain 'watts' column" + ) + # Test missing velocity_smooth AND distance for pace_hr mock_streams_no_speed <- mock_activity_streams[, !(names(mock_activity_streams) %in% c("velocity_smooth", "distance"))] - expect_error(calculate_decoupling(stream_df = mock_streams_no_speed, decouple_metric = "pace_hr"), - regexp = "must contain 'distance' or 'velocity_smooth' column") - + expect_error(calculate_decoupling(stream_df = mock_streams_no_speed, decouple_metric = "pace_hr"), + regexp = "must contain 'distance' or 'velocity_smooth' column" + ) + # Test missing heartrate mock_streams_no_hr <- mock_activity_streams[, !(names(mock_activity_streams) %in% "heartrate")] expect_error(calculate_decoupling(stream_df = mock_streams_no_hr, decouple_metric = "power_hr"), - regexp = "missing required columns") + regexp = "missing required columns" + ) }) -# --- Test Cases for plot_decoupling (using Athlytics_sample_data) --- +# --- Test Cases for plot_decoupling (using sample_decoupling) --- -test_that("plot_decoupling returns a ggplot object using Athlytics_sample_data", { - expect_true(exists("athlytics_sample_decoupling"), "athlytics_sample_decoupling not found in Athlytics_sample_data.") - expect_s3_class(athlytics_sample_decoupling, "data.frame") +test_that("plot_decoupling returns a ggplot object using sample_decoupling", { + expect_true(exists("sample_decoupling"), "sample_decoupling not found.") + expect_s3_class(sample_decoupling, "data.frame") # Ensure required columns for plotting are present in the sample data - expect_true(all(c("date", "decoupling") %in% names(athlytics_sample_decoupling))) - + expect_true(all(c("date", "decoupling") %in% names(sample_decoupling))) + # plot_decoupling requires decouple_metric for labeling if not directly derivable from decoupling_df - # We assume athlytics_sample_decoupling might be for a mix or needs this specified. - p_decouple <- plot_decoupling(decoupling_df = athlytics_sample_decoupling, decouple_metric = "pace_hr") + # We assume sample_decoupling might be for a mix or needs this specified. + p_decouple <- plot_decoupling(decoupling_df = sample_decoupling, decouple_metric = "pace_hr") expect_s3_class(p_decouple, "ggplot") - + # Check that the plot is not empty / uses the data expect_gt(nrow(p_decouple$data), 0) expect_true("decoupling" %in% names(p_decouple$data)) @@ -117,7 +120,7 @@ test_that("plot_decoupling returns a blank plot with warning for invalid decoupl ) expect_s3_class(p_missing_col, "ggplot") expect_true(grepl("No decoupling data to plot", p_missing_col$labels$title, ignore.case = TRUE)) - + # Test with a data frame missing the 'date' column df_missing_date <- data.frame(decoupling = 0.5) expect_warning( @@ -131,15 +134,15 @@ test_that("plot_decoupling returns a blank plot with warning for invalid decoupl test_that("plot_decoupling sets title correctly based on activity_type and data", { # Valid dummy data for plotting valid_df <- data.frame(date = Sys.Date() - 0:2, decoupling = c(1, 2, 3)) - + # Case 1: activity_type is a single string p1 <- plot_decoupling(decoupling_df = valid_df, activity_type = "MyRun", decouple_metric = "pace_hr") expect_true(grepl("Trend for MyRun", p1$labels$title)) # Case 2: activity_type (plot arg) is vector, decoupling_df has single activity_type column df_single_type_col <- data.frame( - date = Sys.Date() - 0:2, - decoupling = c(1, 2, 3), + date = Sys.Date() - 0:2, + decoupling = c(1, 2, 3), activity_type = rep("SpecificRunType", 3) ) p2 <- plot_decoupling(decoupling_df = df_single_type_col, activity_type = c("Run", "Ride"), decouple_metric = "pace_hr") @@ -147,17 +150,17 @@ test_that("plot_decoupling sets title correctly based on activity_type and data" # Case 3: activity_type (plot arg) is vector, decoupling_df has multiple activity_types in its column df_multi_type_col <- data.frame( - date = Sys.Date() - 0:3, - decoupling = c(1, 2, 3, 4), + date = Sys.Date() - 0:3, + decoupling = c(1, 2, 3, 4), activity_type = c("RunA", "RunA", "RunB", "RunB") ) p3 <- plot_decoupling(decoupling_df = df_multi_type_col, activity_type = c("RunA", "RunB"), decouple_metric = "pace_hr") expect_true(grepl("Trend for Selected Activities", p3$labels$title)) # Expect generic - + # Case 4: activity_type (plot arg) is vector, decoupling_df does NOT have activity_type column p4 <- plot_decoupling(decoupling_df = valid_df, activity_type = c("Run", "Ride"), decouple_metric = "pace_hr") expect_true(grepl("Trend for Selected Activities", p4$labels$title)) # Expect generic - + # Case 5: activity_type (plot arg) is default (vector), decoupling_df does NOT have activity_type column p5 <- plot_decoupling(decoupling_df = valid_df, decouple_metric = "pace_hr") # activity_type uses default expect_true(grepl("Trend for Selected Activities", p5$labels$title)) # Expect generic @@ -178,7 +181,7 @@ test_that("plot_decoupling handles add_trend_line argument correctly", { df_two_points <- data.frame(date = Sys.Date() - 0:1, decoupling = c(1, 2)) p_two_points <- plot_decoupling(decoupling_df = df_two_points, add_trend_line = TRUE, decouple_metric = "pace_hr") expect_true(has_smooth_layer(p_two_points)) - + # Case 3: add_trend_line = FALSE, enough data points df_enough_points <- data.frame(date = Sys.Date() - 0:2, decoupling = c(1, 2, 3)) p_no_trend <- plot_decoupling(decoupling_df = df_enough_points, add_trend_line = FALSE, decouple_metric = "pace_hr") @@ -207,16 +210,16 @@ mock_rStrava_get_activity_streams_decoupling <- function(act_data, acts, stoken, # message(sprintf("MOCK get_activity_streams called for index: %d, types: %s", acts, paste(types, collapse=", "))) # Debug # Use the existing mock_activity_streams, assuming it has the needed columns # In a real scenario, this might need to vary based on 'acts' or types requested - if(exists("mock_activity_streams")) { + if (exists("mock_activity_streams")) { # Ensure the mock stream has the requested types - if(all(types %in% names(mock_activity_streams))){ - return(mock_activity_streams[, types, drop = FALSE]) + if (all(types %in% names(mock_activity_streams))) { + return(mock_activity_streams[, types, drop = FALSE]) } else { - warning("Mock get_activity_streams called but mock_activity_streams doesn't have all requested types.") - return(NULL) # Simulate failure if types mismatch drastically + warning("Mock get_activity_streams called but mock_activity_streams doesn't have all requested types.") + return(NULL) # Simulate failure if types mismatch drastically } } else { - stop("Mock error: mock_activity_streams not found in test environment.") + stop("Mock error: mock_activity_streams not found in test environment.") } } @@ -228,7 +231,7 @@ test_that("calculate_decoupling (API path) works with mocked API calls", { local_mocked_bindings( .package = "rStrava", - get_activity_list = function(...) mock_activity_list_list, # Use the list mock + get_activity_list = function(...) mock_activity_list_list, # Use the list mock get_activity_streams = mock_rStrava_get_activity_streams_decoupling # Use the stream mock ) @@ -240,11 +243,11 @@ test_that("calculate_decoupling (API path) works with mocked API calls", { expect_true(all(c("date", "decoupling") %in% names(result_df))) expect_s3_class(result_df$date, "Date") expect_type(result_df$decoupling, "double") - + # Check the number of results (should correspond to the number of 'Run' activities in mock_activity_list_list) # Mock has 2 Runs (id 1 and 3) expect_equal(nrow(result_df), 2) - + # Check specific decoupling values (optional, depends on stability of mock data calculation) # This requires running the decoupling logic manually on mock_activity_streams # For now, checking structure and count is a good start. @@ -252,16 +255,16 @@ test_that("calculate_decoupling (API path) works with mocked API calls", { # Test skipped as API call would fail without proper mocking or real token test_that("calculate_decoupling (API path) structure check (SKIPPED)", { - skip_on_cran() - skip("Skipping API call test for calculate_decoupling; requires network or full API mock.") - # Original test logic commented out as it relies on an actual or complex mocked API call: - # result_df <- tryCatch({ - # calculate_decoupling(stoken = dummy_stoken, activity_type = "Run", decouple_metric = "pace_hr", max_activities = 2, min_duration_mins = 1) - # }, error = function(e) { NULL }) - # if (is.null(result_df)) { - # skip("Test skipped as API call failed or function returned NULL, likely due to missing mock/real token.") - # } - # # else { # If somehow it didn't fail, check structure - # # expect_s3_class(result_df, "data.frame") - # # } -}) \ No newline at end of file + skip_on_cran() + skip("Skipping API call test for calculate_decoupling; requires network or full API mock.") + # Original test logic commented out as it relies on an actual or complex mocked API call: + # result_df <- tryCatch({ + # calculate_decoupling(stoken = dummy_stoken, activity_type = "Run", decouple_metric = "pace_hr", max_activities = 2, min_duration_mins = 1) + # }, error = function(e) { NULL }) + # if (is.null(result_df)) { + # skip("Test skipped as API call failed or function returned NULL, likely due to missing mock/real token.") + # } + # # else { # If somehow it didn't fail, check structure + # # expect_s3_class(result_df, "data.frame") + # # } +}) diff --git a/tests/testthat/test-ef-stream-coverage.R b/tests/testthat/test-ef-stream-coverage.R index d962faf..8e77c83 100644 --- a/tests/testthat/test-ef-stream-coverage.R +++ b/tests/testthat/test-ef-stream-coverage.R @@ -6,46 +6,46 @@ test_that("calculate_ef_from_stream handles missing required columns", { time = 1:100, heartrate = rep(150, 100) ) - + result <- calculate_ef_from_stream( stream_data = stream_no_velocity, activity_date = Sys.Date(), act_type = "Run", ef_metric = "pace_hr" ) - + expect_equal(result$status, "missing_velocity_data") expect_true(is.na(result$ef_value)) - + # Test missing power data for power_hr stream_no_power <- data.frame( time = 1:100, heartrate = rep(140, 100) ) - + result2 <- calculate_ef_from_stream( stream_data = stream_no_power, activity_date = Sys.Date(), act_type = "Ride", ef_metric = "power_hr" ) - + expect_equal(result2$status, "missing_power_data") expect_true(is.na(result2$ef_value)) - + # Test missing heartrate column stream_no_hr <- data.frame( time = 1:100, distance = 1:100 ) - + result3 <- calculate_ef_from_stream( stream_data = stream_no_hr, activity_date = Sys.Date(), act_type = "Run", ef_metric = "pace_hr" ) - + expect_equal(result3$status, "missing_hr_data") expect_true(is.na(result3$ef_value)) }) @@ -57,14 +57,14 @@ test_that("calculate_ef_from_stream handles insufficient data", { heartrate = rep(150, 50), distance = 1:50 ) - + result <- calculate_ef_from_stream( stream_data = small_stream, activity_date = Sys.Date(), act_type = "Run", ef_metric = "pace_hr" ) - + expect_equal(result$status, "insufficient_data_points") expect_true(is.na(result$ef_value)) }) @@ -76,15 +76,15 @@ test_that("calculate_ef_from_stream handles low HR coverage", { heartrate = c(rep(150, 30), rep(NA, 170)), distance = 1:200 * 10 ) - + result <- calculate_ef_from_stream( stream_data = stream_low_hr, activity_date = Sys.Date(), act_type = "Run", ef_metric = "pace_hr", - min_hr_coverage = 0.7 # Require 70% HR coverage + min_hr_coverage = 0.7 # Require 70% HR coverage ) - + expect_true(result$status %in% c("insufficient_hr_data", "insufficient_valid_data", "insufficient_data_points")) expect_true(is.na(result$ef_value)) }) @@ -92,11 +92,11 @@ test_that("calculate_ef_from_stream handles low HR coverage", { test_that("calculate_ef_from_stream handles velocity calculation from distance", { # Test with distance column (no velocity_smooth) stream_with_distance <- data.frame( - time = seq(0, 599, by = 1), # 10 minutes of data + time = seq(0, 599, by = 1), # 10 minutes of data heartrate = rep(150, 600), - distance = seq(0, 3000, length.out = 600) # 3km in 10 minutes + distance = seq(0, 3000, length.out = 600) # 3km in 10 minutes ) - + result <- calculate_ef_from_stream( stream_data = stream_with_distance, activity_date = Sys.Date(), @@ -107,7 +107,7 @@ test_that("calculate_ef_from_stream handles velocity calculation from distance", min_hr_coverage = 0.7, quality_control = "off" ) - + expect_true(is.data.frame(result)) expect_true("ef_value" %in% names(result)) }) @@ -117,9 +117,9 @@ test_that("calculate_ef_from_stream handles velocity_smooth column", { stream_with_velocity <- data.frame( time = seq(0, 599, by = 1), heartrate = rep(150, 600), - velocity_smooth = rep(5.0, 600) # 5 m/s constant + velocity_smooth = rep(5.0, 600) # 5 m/s constant ) - + result <- calculate_ef_from_stream( stream_data = stream_with_velocity, activity_date = Sys.Date(), @@ -130,7 +130,7 @@ test_that("calculate_ef_from_stream handles velocity_smooth column", { min_hr_coverage = 0.7, quality_control = "off" ) - + expect_true(is.data.frame(result)) expect_true("ef_value" %in% names(result)) }) @@ -140,9 +140,9 @@ test_that("calculate_ef_from_stream handles power data", { stream_with_power <- data.frame( time = seq(0, 599, by = 1), heartrate = rep(140, 600), - watts = rep(200, 600) # 200W constant + watts = rep(200, 600) # 200W constant ) - + result <- calculate_ef_from_stream( stream_data = stream_with_power, activity_date = Sys.Date(), @@ -153,7 +153,7 @@ test_that("calculate_ef_from_stream handles power data", { min_hr_coverage = 0.7, quality_control = "off" ) - + expect_true(is.data.frame(result)) expect_true("ef_value" %in% names(result)) }) @@ -162,10 +162,10 @@ test_that("calculate_ef_from_stream handles quality control filtering", { # Test with unrealistic values that should be filtered out stream_bad_values <- data.frame( time = seq(0, 599, by = 1), - heartrate = c(rep(150, 300), rep(250, 300)), # 250 is too high - velocity_smooth = c(rep(5, 300), rep(20, 300)) # 20 m/s is too fast + heartrate = c(rep(150, 300), rep(250, 300)), # 250 is too high + velocity_smooth = c(rep(5, 300), rep(20, 300)) # 20 m/s is too fast ) - + result <- calculate_ef_from_stream( stream_data = stream_bad_values, activity_date = Sys.Date(), @@ -176,7 +176,7 @@ test_that("calculate_ef_from_stream handles quality control filtering", { min_hr_coverage = 0.7, quality_control = "filter" ) - + expect_true(is.data.frame(result)) # Should filter out bad values }) @@ -184,22 +184,22 @@ test_that("calculate_ef_from_stream handles quality control filtering", { test_that("calculate_ef_from_stream handles too short duration", { # Test with stream that's too short stream_short <- data.frame( - time = seq(0, 120, by = 1), # Only 2 minutes + time = seq(0, 120, by = 1), # Only 2 minutes heartrate = rep(150, 121), velocity_smooth = rep(5, 121) ) - + result <- calculate_ef_from_stream( stream_data = stream_short, activity_date = Sys.Date(), act_type = "Run", ef_metric = "pace_hr", - min_steady_minutes = 10, # Require 10 minutes + min_steady_minutes = 10, # Require 10 minutes steady_cv_threshold = 0.1, min_hr_coverage = 0.7, quality_control = "off" ) - + expect_equal(result$status, "too_short") expect_true(is.na(result$ef_value)) }) @@ -210,20 +210,20 @@ test_that("calculate_ef_from_stream handles non-steady activity", { stream_variable <- data.frame( time = seq(0, 599, by = 1), heartrate = rep(150, 600), - velocity_smooth = runif(600, 3, 8) # Very variable speed + velocity_smooth = runif(600, 3, 8) # Very variable speed ) - + result <- calculate_ef_from_stream( stream_data = stream_variable, activity_date = Sys.Date(), act_type = "Run", ef_metric = "pace_hr", min_steady_minutes = 5, - steady_cv_threshold = 0.05, # Very strict CV threshold + steady_cv_threshold = 0.05, # Very strict CV threshold min_hr_coverage = 0.7, quality_control = "off" ) - + # Might return non_steady or might find some steady periods expect_true(is.data.frame(result)) expect_true("status" %in% names(result)) @@ -232,11 +232,11 @@ test_that("calculate_ef_from_stream handles non-steady activity", { test_that("calculate_ef_from_stream calculates valid EF for good steady data", { # Test with good steady-state data stream_steady <- data.frame( - time = seq(0, 1199, by = 1), # 20 minutes - heartrate = rnorm(1200, mean = 150, sd = 3), # Stable HR - velocity_smooth = rnorm(1200, mean = 5, sd = 0.2) # Stable pace + time = seq(0, 1199, by = 1), # 20 minutes + heartrate = rnorm(1200, mean = 150, sd = 3), # Stable HR + velocity_smooth = rnorm(1200, mean = 5, sd = 0.2) # Stable pace ) - + result <- calculate_ef_from_stream( stream_data = stream_steady, activity_date = Sys.Date(), @@ -247,7 +247,7 @@ test_that("calculate_ef_from_stream calculates valid EF for good steady data", { min_hr_coverage = 0.7, quality_control = "off" ) - + expect_true(is.data.frame(result)) if (result$status == "ok") { expect_true(!is.na(result$ef_value)) @@ -257,8 +257,7 @@ test_that("calculate_ef_from_stream calculates valid EF for good steady data", { test_that("calculate_ef handles export_dir and stream parsing", { skip("Requires real activity files") - + # This test would need actual activity files # Skipping as it requires complex test setup }) - diff --git a/tests/testthat/test-ef.R b/tests/testthat/test-ef.R index 9eb08b3..e81b0c3 100644 --- a/tests/testthat/test-ef.R +++ b/tests/testthat/test-ef.R @@ -5,7 +5,7 @@ library(Athlytics) library(testthat) -data(athlytics_sample_ef) +data(sample_ef) create_mock_activities <- function(n = 30) { dates <- seq(Sys.Date() - n, Sys.Date(), by = "day") @@ -25,12 +25,12 @@ create_mock_activities <- function(n = 30) { test_that("calculate_ef works with pace_hr metric", { mock_activities <- create_mock_activities() - + ef_result <- calculate_ef( activities_data = mock_activities, ef_metric = "pace_hr" ) - + expect_s3_class(ef_result, "data.frame") expect_true("ef_value" %in% colnames(ef_result)) expect_gt(nrow(ef_result), 0) @@ -38,12 +38,12 @@ test_that("calculate_ef works with pace_hr metric", { test_that("calculate_ef works with power_hr metric", { mock_activities <- create_mock_activities() - + ef_result <- calculate_ef( activities_data = mock_activities, ef_metric = "power_hr" ) - + expect_s3_class(ef_result, "data.frame") expect_true("ef_value" %in% colnames(ef_result)) }) @@ -56,23 +56,23 @@ test_that("calculate_ef validates input", { }) test_that("calculate_ef works with sample data", { - skip_if(is.null(athlytics_sample_ef), "Sample EF data not available") - - expect_s3_class(athlytics_sample_ef, "data.frame") + skip_if(is.null(sample_ef), "Sample EF data not available") + + expect_s3_class(sample_ef, "data.frame") # Sample data may have either ef_value or efficiency_factor - expect_true(any(c("ef_value", "efficiency_factor") %in% colnames(athlytics_sample_ef))) + expect_true(any(c("ef_value", "efficiency_factor") %in% colnames(sample_ef))) }) test_that("plot_ef works with pre-calculated data", { - skip_if(is.null(athlytics_sample_ef), "Sample EF data not available") - - p <- plot_ef(athlytics_sample_ef) + skip_if(is.null(sample_ef), "Sample EF data not available") + + p <- plot_ef(sample_ef) expect_s3_class(p, "ggplot") }) test_that("plot_ef works with activities data", { mock_activities <- create_mock_activities(50) - + # Test with pace_hr p1 <- plot_ef( data = mock_activities, @@ -80,7 +80,7 @@ test_that("plot_ef works with activities data", { ef_metric = "pace_hr" ) expect_s3_class(p1, "ggplot") - + # Test with power_hr p2 <- plot_ef( data = mock_activities, @@ -92,7 +92,7 @@ test_that("plot_ef works with activities data", { test_that("plot_ef handles various options", { mock_activities <- create_mock_activities(50) - + # Test without trend line p1 <- plot_ef( data = mock_activities, @@ -101,7 +101,7 @@ test_that("plot_ef handles various options", { add_trend_line = FALSE ) expect_s3_class(p1, "ggplot") - + # Test with different smoothing method p2 <- plot_ef( data = mock_activities, @@ -110,7 +110,7 @@ test_that("plot_ef handles various options", { smoothing_method = "lm" ) expect_s3_class(p2, "ggplot") - + # Test with date range p3 <- plot_ef( data = mock_activities, @@ -123,9 +123,9 @@ test_that("plot_ef handles various options", { }) test_that("plot_ef works with ef_df parameter", { - skip_if(is.null(athlytics_sample_ef), "Sample EF data not available") - + skip_if(is.null(sample_ef), "Sample EF data not available") + # Plot already calculated EF data - p <- plot_ef(athlytics_sample_ef) + p <- plot_ef(sample_ef) expect_s3_class(p, "ggplot") }) diff --git a/tests/testthat/test-exposure.R b/tests/testthat/test-exposure.R index 0f96858..c4fd44e 100644 --- a/tests/testthat/test-exposure.R +++ b/tests/testthat/test-exposure.R @@ -4,58 +4,61 @@ library(testthat) library(Athlytics) # Load sample data from the package -data(Athlytics_sample_data) +data(sample_acwr) +data(sample_exposure) # Load mock data (if helper-mockdata.R contains mocks for direct use) source(test_path("helper-mockdata.R"), local = TRUE) # Mock Strava token (if needed for functions that might call API, though most tests here use sample_df) -# --- Test plot_exposure (using pre-calculated ACWR data from Athlytics_sample_data) --- +# --- Test plot_exposure (using pre-calculated ACWR data from sample data) --- -test_that("plot_exposure returns a ggplot object with athlytics_sample_acwr data", { +test_that("plot_exposure returns a ggplot object with sample_acwr data", { # Check if the sample ACWR data subset exists - expect_true(exists("athlytics_sample_acwr"), "athlytics_sample_acwr not found in Athlytics_sample_data.") - expect_s3_class(athlytics_sample_acwr, "data.frame") - - # Ensure athlytics_sample_acwr has the expected columns for plotting + expect_true(exists("sample_acwr"), "sample_acwr not found.") + expect_s3_class(sample_acwr, "data.frame") + + # Ensure sample_acwr has the expected columns for plotting # plot_exposure typically uses date, acwr, atl, ctl. expected_cols <- c("date", "acwr", "atl", "ctl") - if (nrow(athlytics_sample_acwr) > 0) { # Only check columns if data exists - expect_true(all(expected_cols %in% names(athlytics_sample_acwr)), - paste("athlytics_sample_acwr is missing one or more expected columns:", paste(expected_cols, collapse=", "))) + if (nrow(sample_acwr) > 0) { # Only check columns if data exists + expect_true( + all(expected_cols %in% names(sample_acwr)), + paste("sample_acwr is missing one or more expected columns:", paste(expected_cols, collapse = ", ")) + ) } # Test with actual data if it's not empty - if (nrow(athlytics_sample_acwr) > 0) { - expect_s3_class(plot_exposure(exposure_df = athlytics_sample_acwr), "ggplot") + if (nrow(sample_acwr) > 0) { + expect_s3_class(plot_exposure(exposure_df = sample_acwr), "ggplot") } else { - skip("athlytics_sample_acwr is empty, skipping main plot test.") + skip("sample_acwr is empty, skipping main plot test.") } }) -test_that("plot_exposure handles risk_zones argument with athlytics_sample_acwr", { - if (!exists("athlytics_sample_acwr") || nrow(athlytics_sample_acwr) == 0) { - skip("athlytics_sample_acwr is empty or not found, skipping risk_zones test.") +test_that("plot_exposure handles risk_zones argument with sample_acwr", { + if (!exists("sample_acwr") || nrow(sample_acwr) == 0) { + skip("sample_acwr is empty or not found, skipping risk_zones test.") } - expect_s3_class(plot_exposure(exposure_df = athlytics_sample_acwr, risk_zones = TRUE), "ggplot") - expect_s3_class(plot_exposure(exposure_df = athlytics_sample_acwr, risk_zones = FALSE), "ggplot") - + expect_s3_class(plot_exposure(exposure_df = sample_acwr, risk_zones = TRUE), "ggplot") + expect_s3_class(plot_exposure(exposure_df = sample_acwr, risk_zones = FALSE), "ggplot") + # Check for geom_rect layers (risk zones are often drawn with geom_rect for background bands) # or geom_hline/geom_vline if specific lines are used. # The original test checked for GeomAbline, let's adapt if needed or keep if appropriate. # plot_exposure uses geom_abline for risk zones. - p_zones <- plot_exposure(exposure_df = athlytics_sample_acwr, risk_zones = TRUE) - p_no_zones <- plot_exposure(exposure_df = athlytics_sample_acwr, risk_zones = FALSE) - + p_zones <- plot_exposure(exposure_df = sample_acwr, risk_zones = TRUE) + p_no_zones <- plot_exposure(exposure_df = sample_acwr, risk_zones = FALSE) + get_abline_layers <- function(p) sum(sapply(p$layers, function(l) inherits(l$geom, "GeomAbline"))) - + expect_equal(get_abline_layers(p_zones), 3) expect_equal(get_abline_layers(p_no_zones), 0) }) test_that("plot_exposure handles empty data frame input", { - # Create an empty data frame with the same structure as athlytics_sample_acwr + # Create an empty data frame with the same structure as sample_acwr empty_df_structure <- data.frame( date = as.Date(character()), daily_load = numeric(), @@ -64,17 +67,17 @@ test_that("plot_exposure handles empty data frame input", { acwr = numeric(), stringsAsFactors = FALSE ) - - if (exists("athlytics_sample_acwr") && nrow(athlytics_sample_acwr) > 0) { - empty_df <- athlytics_sample_acwr[0, ] + + if (exists("sample_acwr") && nrow(sample_acwr) > 0) { + empty_df <- sample_acwr[0, ] } else { - empty_df <- empty_df_structure + empty_df <- empty_df_structure } - + expect_warning( - p_empty <- plot_exposure(exposure_df = empty_df), + p_empty <- plot_exposure(exposure_df = empty_df), regexp = "No valid exposure data available to plot \\(or missing required columns\\)." ) - expect_s3_class(p_empty, "ggplot") + expect_s3_class(p_empty, "ggplot") expect_true(grepl("No exposure data available", p_empty$labels$title, ignore.case = TRUE) || length(p_empty$layers) == 0) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-extreme-edge-cases.R b/tests/testthat/test-extreme-edge-cases.R index 53cef19..34b706a 100644 --- a/tests/testthat/test-extreme-edge-cases.R +++ b/tests/testthat/test-extreme-edge-cases.R @@ -23,24 +23,33 @@ test_that("calculate_ef with extreme and edge case data", { filename = paste0(1:50, ".fit"), stringsAsFactors = FALSE ) - + # Test with quality_control = "filter" - ef_filter <- calculate_ef(extreme_runs, activity_type = "Run", ef_metric = "pace_hr", - quality_control = "filter", min_duration_mins = 10) + ef_filter <- calculate_ef(extreme_runs, + activity_type = "Run", ef_metric = "pace_hr", + quality_control = "filter", min_duration_mins = 10 + ) expect_true(is.data.frame(ef_filter) || inherits(ef_filter, "tbl")) - + # Test with quality_control = "flag" - ef_flag <- calculate_ef(extreme_runs, activity_type = "Run", ef_metric = "pace_hr", - quality_control = "flag", min_duration_mins = 10) + ef_flag <- calculate_ef(extreme_runs, + activity_type = "Run", ef_metric = "pace_hr", + quality_control = "flag", min_duration_mins = 10 + ) expect_true(is.data.frame(ef_flag) || inherits(ef_flag, "tbl")) - + # Test with export_dir (will try to parse files) if (dir.exists(export_dir)) { - ef_with_dir <- tryCatch({ - calculate_ef(extreme_runs[1:10, ], activity_type = "Run", ef_metric = "pace_hr", - export_dir = export_dir, quality_control = "filter") - }, error = function(e) data.frame()) - + ef_with_dir <- tryCatch( + { + calculate_ef(extreme_runs[1:10, ], + activity_type = "Run", ef_metric = "pace_hr", + export_dir = export_dir, quality_control = "filter" + ) + }, + error = function(e) data.frame() + ) + expect_true(is.data.frame(ef_with_dir) || inherits(ef_with_dir, "tbl")) } }) @@ -61,18 +70,24 @@ test_that("calculate_ef with power metric edge cases", { filename = paste0(1:40, ".fit"), stringsAsFactors = FALSE ) - + # Test power_hr metric - ef_power1 <- calculate_ef(extreme_rides, activity_type = "Ride", ef_metric = "power_hr", - quality_control = "off") + ef_power1 <- calculate_ef(extreme_rides, + activity_type = "Ride", ef_metric = "power_hr", + quality_control = "off" + ) expect_true(is.data.frame(ef_power1) || inherits(ef_power1, "tbl")) - - ef_power2 <- calculate_ef(extreme_rides, activity_type = "Ride", ef_metric = "power_hr", - quality_control = "filter") + + ef_power2 <- calculate_ef(extreme_rides, + activity_type = "Ride", ef_metric = "power_hr", + quality_control = "filter" + ) expect_true(is.data.frame(ef_power2) || inherits(ef_power2, "tbl")) - - ef_power3 <- calculate_ef(extreme_rides, activity_type = "Ride", ef_metric = "power_hr", - quality_control = "flag") + + ef_power3 <- calculate_ef(extreme_rides, + activity_type = "Ride", ef_metric = "power_hr", + quality_control = "flag" + ) expect_true(is.data.frame(ef_power3) || inherits(ef_power3, "tbl")) }) @@ -80,29 +95,33 @@ test_that("calculate_ef with power metric edge cases", { test_that("real data with all calculate_ef parameter combinations", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(export_dir), "Export dir not found") - + act <- load_local_activities(csv_path) - + # Get activities with filenames act_with_files <- act[!is.na(act$filename) & nchar(act$filename) > 0, ] - + if (nrow(act_with_files) >= 20) { # Test all quality_control modes with export_dir for (qc_mode in c("off", "flag", "filter")) { for (min_dur in c(10, 20, 30)) { for (min_steady in c(10, 15, 20)) { - ef_result <- tryCatch({ - calculate_ef(act_with_files[1:20, ], - activity_type = act_with_files$type[1], - ef_metric = "pace_hr", - export_dir = export_dir, - quality_control = qc_mode, - min_duration_mins = min_dur, - min_steady_minutes = min_steady, - steady_cv_threshold = 0.08, - min_hr_coverage = 0.9) - }, error = function(e) data.frame()) - + ef_result <- tryCatch( + { + calculate_ef(act_with_files[1:20, ], + activity_type = act_with_files$type[1], + ef_metric = "pace_hr", + export_dir = export_dir, + quality_control = qc_mode, + min_duration_mins = min_dur, + min_steady_minutes = min_steady, + steady_cv_threshold = 0.08, + min_hr_coverage = 0.9 + ) + }, + error = function(e) data.frame() + ) + expect_true(is.data.frame(ef_result) || inherits(ef_result, "tbl")) } } @@ -113,7 +132,7 @@ test_that("real data with all calculate_ef parameter combinations", { # ========== Extreme plot conditions ========== test_that("plot functions with extreme data conditions", { skip_if_not_installed("ggplot2") - + # Extremely sparse PBs (just 3 points) minimal_pbs <- data.frame( activity_id = 1:3, @@ -126,13 +145,13 @@ test_that("plot functions with extreme data conditions", { activity_type = "Run", stringsAsFactors = FALSE ) - + p1 <- plot_pbs(pbs_df = minimal_pbs, add_trend_line = TRUE) expect_s3_class(p1, "gg") - + p2 <- plot_pbs(pbs_df = minimal_pbs, add_trend_line = FALSE) expect_s3_class(p2, "gg") - + # Extremely dense PBs (many at same date) dense_pbs <- data.frame( activity_id = 1:100, @@ -145,10 +164,10 @@ test_that("plot functions with extreme data conditions", { activity_type = "Run", stringsAsFactors = FALSE ) - + p3 <- plot_pbs(pbs_df = dense_pbs) expect_s3_class(p3, "gg") - + # Minimal EF data minimal_ef_data <- data.frame( id = 1:3, @@ -162,22 +181,26 @@ test_that("plot functions with extreme data conditions", { average_speed = c(10, 10.2, 9.8), stringsAsFactors = FALSE ) - - p4 <- plot_ef(minimal_ef_data, activity_type = "Run", ef_metric = "pace_hr", - add_trend_line = TRUE) + + p4 <- plot_ef(minimal_ef_data, + activity_type = "Run", ef_metric = "pace_hr", + add_trend_line = TRUE + ) expect_s3_class(p4, "gg") - - p5 <- plot_ef(minimal_ef_data, activity_type = "Run", ef_metric = "pace_hr", - add_trend_line = FALSE) + + p5 <- plot_ef(minimal_ef_data, + activity_type = "Run", ef_metric = "pace_hr", + add_trend_line = FALSE + ) expect_s3_class(p5, "gg") }) # ========== Additional load_local_activities scenarios ========== test_that("load_local_activities with various input conditions", { skip_if(!file.exists(csv_path), "CSV not found") - + act <- load_local_activities(csv_path) - + # Load with every possible activity type individually all_types <- unique(act$type) for (atype in all_types) { @@ -187,7 +210,7 @@ test_that("load_local_activities with various input conditions", { expect_true(all(result$type == atype, na.rm = TRUE)) } } - + # Load with all possible combinations if (length(all_types) >= 4) { # 4-type combinations @@ -197,7 +220,7 @@ test_that("load_local_activities with various input conditions", { expect_true(is.data.frame(result) || inherits(result, "tbl")) } } - + # Load with all types result_all <- load_local_activities(csv_path, activity_types = all_types) expect_true(is.data.frame(result_all) || inherits(result_all, "tbl")) @@ -207,26 +230,31 @@ test_that("load_local_activities with various input conditions", { test_that("all plot option combinations with real data", { skip_if_not_installed("ggplot2") skip_if(!file.exists(csv_path), "CSV not found") - + act <- load_local_activities(csv_path) - + # Get activity type with most data type_counts <- table(act$type[!is.na(act$average_heartrate)]) if (length(type_counts) > 0) { main_type <- names(which.max(type_counts)) type_act <- act[act$type == main_type & !is.na(act$average_heartrate), ] - + if (nrow(type_act) >= 30) { # Test every combination of plot_ef options for (add_trend in c(TRUE, FALSE)) { for (smooth_method in c("loess", "lm")) { for (min_dur in c(15, 30, 45)) { - p <- tryCatch({ - plot_ef(type_act, activity_type = main_type, ef_metric = "pace_hr", - add_trend_line = add_trend, smoothing_method = smooth_method, - min_duration_mins = min_dur) - }, error = function(e) NULL) - + p <- tryCatch( + { + plot_ef(type_act, + activity_type = main_type, ef_metric = "pace_hr", + add_trend_line = add_trend, smoothing_method = smooth_method, + min_duration_mins = min_dur + ) + }, + error = function(e) NULL + ) + if (!is.null(p)) { expect_s3_class(p, "gg") } @@ -241,46 +269,53 @@ test_that("all plot option combinations with real data", { test_that("ultra comprehensive real data coverage", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(export_dir), "Export dir not found") - + act <- load_local_activities(csv_path) - + # Test with every unique combination types <- unique(act$type) for (i in seq_along(types)) { atype <- types[i] type_act <- act[act$type == atype, ] - + if (nrow(type_act) >= 25) { # Try calculate_ef with export_dir - ef_result <- tryCatch({ - calculate_ef(type_act[1:25, ], - activity_type = atype, - ef_metric = "pace_hr", - export_dir = export_dir, - quality_control = "filter", - min_duration_mins = 15, - min_steady_minutes = 15, - steady_cv_threshold = 0.10, - min_hr_coverage = 0.85) - }, error = function(e) data.frame()) - + ef_result <- tryCatch( + { + calculate_ef(type_act[1:25, ], + activity_type = atype, + ef_metric = "pace_hr", + export_dir = export_dir, + quality_control = "filter", + min_duration_mins = 15, + min_steady_minutes = 15, + steady_cv_threshold = 0.10, + min_hr_coverage = 0.85 + ) + }, + error = function(e) data.frame() + ) + expect_true(is.data.frame(ef_result) || inherits(ef_result, "tbl")) - + # Try with different settings - ef_result2 <- tryCatch({ - calculate_ef(type_act[1:25, ], - activity_type = atype, - ef_metric = "pace_hr", - export_dir = export_dir, - quality_control = "flag", - min_duration_mins = 20, - min_steady_minutes = 20, - steady_cv_threshold = 0.08, - min_hr_coverage = 0.90) - }, error = function(e) data.frame()) - + ef_result2 <- tryCatch( + { + calculate_ef(type_act[1:25, ], + activity_type = atype, + ef_metric = "pace_hr", + export_dir = export_dir, + quality_control = "flag", + min_duration_mins = 20, + min_steady_minutes = 20, + steady_cv_threshold = 0.08, + min_hr_coverage = 0.90 + ) + }, + error = function(e) data.frame() + ) + expect_true(is.data.frame(ef_result2) || inherits(ef_result2, "tbl")) } } }) - diff --git a/tests/testthat/test-flag-quality-streams.R b/tests/testthat/test-flag-quality-streams.R index e5c5aef..e88846f 100644 --- a/tests/testthat/test-flag-quality-streams.R +++ b/tests/testthat/test-flag-quality-streams.R @@ -8,32 +8,32 @@ library(dplyr) create_stream_data <- function(n_points = 3600, sport = "Run") { # Create time series (1 hour at 1Hz) time_sec <- seq(0, n_points - 1) - + # Base heart rate with some variation base_hr <- 140 + 20 * sin(time_sec / 300) + rnorm(n_points, 0, 5) base_hr <- pmax(60, pmin(180, base_hr)) - + # Add some HR spikes for testing hr_spikes <- sample(1:n_points, 5) - base_hr[hr_spikes] <- c(250, 10, 200, 5, 220) # Out of range values - + base_hr[hr_spikes] <- c(250, 10, 200, 5, 220) # Out of range values + # Power data (for cycling) if (sport == "Ride") { base_power <- 200 + 50 * sin(time_sec / 200) + rnorm(n_points, 0, 20) base_power <- pmax(0, pmin(800, base_power)) - + # Add power spikes pw_spikes <- sample(1:n_points, 3) - base_power[pw_spikes] <- c(2000, -100, 1800) # Out of range values + base_power[pw_spikes] <- c(2000, -100, 1800) # Out of range values } else { base_power <- rep(NA, n_points) } - + # Speed data if (sport == "Run") { base_speed <- 3.5 + 0.5 * sin(time_sec / 400) + rnorm(n_points, 0, 0.2) base_speed <- pmax(0, pmin(6, base_speed)) - + # Add GPS drift gps_drift <- sample(1:n_points, 10) base_speed[gps_drift] <- c(15, 0.1, 12, 0.05, 8, 0.2, 10, 0.1, 9, 0.15) @@ -41,10 +41,10 @@ create_stream_data <- function(n_points = 3600, sport = "Run") { base_speed <- 8 + 2 * sin(time_sec / 300) + rnorm(n_points, 0, 0.5) base_speed <- pmax(0, pmin(20, base_speed)) } - + # Distance (cumulative) distance <- cumsum(base_speed) - + data.frame( time = time_sec, heartrate = base_hr, @@ -59,14 +59,16 @@ create_stream_data <- function(n_points = 3600, sport = "Run") { # Test basic functionality test_that("flag_quality works with running stream data", { streams <- create_stream_data(sport = "Run") - + flagged <- flag_quality(streams, sport = "Run") - + expect_s3_class(flagged, "data.frame") expect_equal(nrow(flagged), nrow(streams)) - expect_true(all(c("flag_hr_spike", "flag_pw_spike", "flag_gps_drift", - "flag_any", "is_steady_state", "quality_score") %in% names(flagged))) - + expect_true(all(c( + "flag_hr_spike", "flag_pw_spike", "flag_gps_drift", + "flag_any", "is_steady_state", "quality_score" + ) %in% names(flagged))) + # Should detect some quality issues expect_gt(sum(flagged$flag_any, na.rm = TRUE), 0) expect_lt(mean(flagged$quality_score, na.rm = TRUE), 1.0) @@ -74,24 +76,24 @@ test_that("flag_quality works with running stream data", { test_that("flag_quality works with cycling stream data", { streams <- create_stream_data(sport = "Ride") - + flagged <- flag_quality(streams, sport = "Ride") - + expect_s3_class(flagged, "data.frame") expect_equal(nrow(flagged), nrow(streams)) - + # Should detect power spikes expect_gt(sum(flagged$flag_pw_spike, na.rm = TRUE), 0) }) test_that("flag_quality detects HR spikes", { streams <- create_stream_data(sport = "Run") - + flagged <- flag_quality(streams, sport = "Run") - + # Should detect the HR spikes we added expect_gt(sum(flagged$flag_hr_spike, na.rm = TRUE), 0) - + # Check that extreme values are flagged extreme_hr_indices <- which(streams$heartrate > 200 | streams$heartrate < 30) if (length(extreme_hr_indices) > 0) { @@ -101,9 +103,9 @@ test_that("flag_quality detects HR spikes", { test_that("flag_quality detects GPS drift", { streams <- create_stream_data(sport = "Run") - + flagged <- flag_quality(streams, sport = "Run") - + # Should detect some GPS drift expect_gt(sum(flagged$flag_gps_drift, na.rm = TRUE), 0) }) @@ -112,21 +114,21 @@ test_that("flag_quality identifies steady state segments", { # Create data with a clear steady state segment n_points <- 3600 time_sec <- seq(0, n_points - 1) - + # Create steady HR for middle segment hr <- c( - rep(120, 600), # Warm up + rep(120, 600), # Warm up rep(150, 1200), # Steady state (20 min) - rep(180, 1800) # High intensity + rep(180, 1800) # High intensity ) - + # Create steady speed speed <- c( rep(2.5, 600), rep(3.5, 1200), rep(5.0, 1800) ) - + streams <- data.frame( time = time_sec, heartrate = hr, @@ -136,80 +138,80 @@ test_that("flag_quality identifies steady state segments", { distance = cumsum(speed), stringsAsFactors = FALSE ) - + flagged <- flag_quality(streams, sport = "Run", min_steady_minutes = 15) - + # Should identify steady state in the middle segment - steady_segment <- 601:1800 # Middle 20 minutes + steady_segment <- 601:1800 # Middle 20 minutes expect_gt(sum(flagged$is_steady_state[steady_segment], na.rm = TRUE), 0) }) test_that("flag_quality handles different sport types", { streams_run <- create_stream_data(sport = "Run") streams_ride <- create_stream_data(sport = "Ride") - + flagged_run <- flag_quality(streams_run, sport = "Run") flagged_ride <- flag_quality(streams_ride, sport = "Ride") - + # Both should work expect_s3_class(flagged_run, "data.frame") expect_s3_class(flagged_ride, "data.frame") - + # Cycling should have power data expect_true(any(!is.na(streams_ride$watts))) }) test_that("flag_quality handles custom thresholds", { streams <- create_stream_data(sport = "Run") - + # Test with stricter thresholds flagged_strict <- flag_quality( - streams, + streams, sport = "Run", hr_range = c(50, 200), max_hr_jump = 5, max_run_speed = 5.0 ) - + # Should flag more issues with stricter thresholds expect_gt(sum(flagged_strict$flag_any, na.rm = TRUE), 0) - + # Test with lenient thresholds flagged_lenient <- flag_quality( streams, - sport = "Run", + sport = "Run", hr_range = c(20, 250), max_hr_jump = 20, max_run_speed = 10.0 ) - + # Should flag fewer issues expect_s3_class(flagged_lenient, "data.frame") }) test_that("flag_quality handles missing data gracefully", { streams <- create_stream_data(sport = "Run") - + # Remove some columns streams_no_hr <- streams[, !names(streams) %in% "heartrate"] streams_no_speed <- streams[, !names(streams) %in% c("velocity_smooth", "speed")] - + # Should still work flagged_no_hr <- flag_quality(streams_no_hr, sport = "Run") expect_s3_class(flagged_no_hr, "data.frame") - + flagged_no_speed <- flag_quality(streams_no_speed, sport = "Run") expect_s3_class(flagged_no_speed, "data.frame") }) test_that("flag_quality calculates quality score correctly", { streams <- create_stream_data(sport = "Run") - + flagged <- flag_quality(streams, sport = "Run") - + # Quality score should be between 0 and 1 expect_true(all(flagged$quality_score >= 0 & flagged$quality_score <= 1, na.rm = TRUE)) - + # Should be less than 1 due to quality issues expect_lt(mean(flagged$quality_score, na.rm = TRUE), 1.0) }) @@ -225,10 +227,10 @@ test_that("flag_quality handles edge cases", { distance = cumsum(rep(3.5, 10)), stringsAsFactors = FALSE ) - + flagged <- flag_quality(short_streams, sport = "Run") expect_s3_class(flagged, "data.frame") - + # Test with all NA data na_streams <- data.frame( time = 1:100, @@ -239,7 +241,7 @@ test_that("flag_quality handles edge cases", { distance = NA, stringsAsFactors = FALSE ) - + flagged_na <- flag_quality(na_streams, sport = "Run") expect_s3_class(flagged_na, "data.frame") }) @@ -248,11 +250,23 @@ test_that("flag_quality handles edge cases", { test_that("quality_summary works with flagged stream data", { streams <- create_stream_data(sport = "Run") flagged <- flag_quality(streams, sport = "Run") - - summary <- quality_summary(flagged) - + + summary <- summarize_quality(flagged) + expect_type(summary, "list") expect_true(all(c("total_points", "flagged_points", "flagged_pct") %in% names(summary))) expect_true(is.numeric(summary$total_points)) expect_true(summary$total_points > 0) }) + + +test_that("quality_summary is deprecated but remains available", { + streams <- create_stream_data(sport = "Run") + flagged <- flag_quality(streams, sport = "Run") + + expect_warning( + out <- quality_summary(flagged), + "deprecated" + ) + expect_type(out, "list") +}) diff --git a/tests/testthat/test-flag-quality.R b/tests/testthat/test-flag-quality.R index 624ace0..e2798cb 100644 --- a/tests/testthat/test-flag-quality.R +++ b/tests/testthat/test-flag-quality.R @@ -4,15 +4,15 @@ test_that("flag_quality detects HR spikes", { # Create synthetic data with HR spike stream_data <- data.frame( time = 1:100, - heartrate = c(rep(150, 50), 250, rep(150, 49)) # One spike at position 51 + heartrate = c(rep(150, 50), 250, rep(150, 49)) # One spike at position 51 ) - + result <- flag_quality(stream_data, sport = "Run") - + # Check that spike is flagged expect_true(result$flag_hr_spike[51]) expect_true(result$flag_any[51]) - + # Check that non-spike values before are not flagged expect_false(result$flag_hr_spike[50]) # Note: position 52 might also be flagged due to jump back down from spike @@ -23,11 +23,11 @@ test_that("flag_quality detects power spikes", { # Create synthetic data with power spike stream_data <- data.frame( time = 1:100, - watts = c(rep(200, 50), 1600, rep(200, 49)) # One spike at position 51 + watts = c(rep(200, 50), 1600, rep(200, 49)) # One spike at position 51 ) - + result <- flag_quality(stream_data, sport = "Ride") - + # Check that spike is flagged expect_true(result$flag_pw_spike[51]) expect_true(result$flag_any[51]) @@ -37,11 +37,11 @@ test_that("flag_quality detects excessive HR jumps", { # Create data with excessive HR jump stream_data <- data.frame( time = 1:100, - heartrate = c(rep(140, 50), 160, rep(140, 49)) # Jump of 20 bpm in 1 sec + heartrate = c(rep(140, 50), 160, rep(140, 49)) # Jump of 20 bpm in 1 sec ) - + result <- flag_quality(stream_data, sport = "Run", max_hr_jump = 10) - + # Check that jump is flagged expect_true(result$flag_hr_spike[51]) }) @@ -50,11 +50,11 @@ test_that("flag_quality detects GPS drift", { # Create data with implausible speed stream_data <- data.frame( time = 1:100, - velocity_smooth = c(rep(3.5, 50), 10, rep(3.5, 49)) # 10 m/s = ~36 km/h running + velocity_smooth = c(rep(3.5, 50), 10, rep(3.5, 49)) # 10 m/s = ~36 km/h running ) - + result <- flag_quality(stream_data, sport = "Run", max_run_speed = 7.0) - + # Check that drift is flagged expect_true(result$flag_gps_drift[51]) expect_true(result$flag_any[51]) @@ -68,20 +68,20 @@ test_that("flag_quality calculates quality score", { watts = rep(200, 100), velocity_smooth = rep(3.5, 100) ) - + result <- flag_quality(clean_data, sport = "Run") - + # Quality score should be 1.0 (perfect) expect_equal(result$quality_score[1], 1.0) - + # Create data with 10% flagged points dirty_data <- data.frame( time = 1:100, - heartrate = c(rep(250, 10), rep(150, 90)) # 10% out of range + heartrate = c(rep(250, 10), rep(150, 90)) # 10% out of range ) - + result2 <- flag_quality(dirty_data, sport = "Run") - + # Quality score should be ~0.9 expect_lt(result2$quality_score[1], 1.0) expect_gt(result2$quality_score[1], 0.85) @@ -89,7 +89,7 @@ test_that("flag_quality calculates quality score", { test_that("flag_quality handles empty data gracefully", { empty_data <- data.frame(time = numeric(0)) - + expect_warning(result <- flag_quality(empty_data)) expect_equal(nrow(result), 0) expect_true("flag_any" %in% colnames(result)) @@ -98,12 +98,12 @@ test_that("flag_quality handles empty data gracefully", { test_that("flag_quality detects steady state", { # Create long steady-state data (25 minutes at constant pace) steady_data <- data.frame( - time = 0:(25*60-1), # 25 minutes - velocity_smooth = rnorm(25*60, mean = 3.5, sd = 0.1) # Low variability + time = 0:(25 * 60 - 1), # 25 minutes + velocity_smooth = rnorm(25 * 60, mean = 3.5, sd = 0.1) # Low variability ) - + result <- flag_quality(steady_data, sport = "Run", min_steady_minutes = 20) - + # Should have some steady-state points expect_gt(sum(result$is_steady_state, na.rm = TRUE), 0) }) @@ -111,12 +111,12 @@ test_that("flag_quality detects steady state", { test_that("quality_summary provides correct statistics", { stream_data <- data.frame( time = 1:100, - heartrate = c(rep(250, 10), rep(150, 90)) # 10% out of range + 1 transition + heartrate = c(rep(250, 10), rep(150, 90)) # 10% out of range + 1 transition ) - + result <- flag_quality(stream_data, sport = "Run") - summary_stats <- quality_summary(result) - + summary_stats <- summarize_quality(result) + expect_equal(summary_stats$total_points, 100) # Expect 10 out-of-range + 1 jump (transition from 250 to 150) expect_equal(summary_stats$flagged_points, 11) @@ -128,15 +128,14 @@ test_that("flag_quality is sport-aware", { # Create data with speed that's OK for cycling but not running stream_data <- data.frame( time = 1:100, - velocity_smooth = rep(12, 100) # 12 m/s = ~43 km/h + velocity_smooth = rep(12, 100) # 12 m/s = ~43 km/h ) - + # Should be flagged for running result_run <- flag_quality(stream_data, sport = "Run", max_run_speed = 7.0) expect_gt(sum(result_run$flag_gps_drift), 0) - + # Should NOT be flagged for cycling result_ride <- flag_quality(stream_data, sport = "Ride", max_ride_speed = 25.0) expect_equal(sum(result_ride$flag_gps_drift), 0) }) - diff --git a/tests/testthat/test-load-local-activities.R b/tests/testthat/test-load-local-activities.R index ecae4fb..9c247d4 100644 --- a/tests/testthat/test-load-local-activities.R +++ b/tests/testthat/test-load-local-activities.R @@ -6,12 +6,12 @@ library(Athlytics) library(testthat) test_that("load_local_activities works with sample data", { - # Skip this test as athlytics_sample_data doesn't exist - skip("athlytics_sample_data not available") - + # Skip this test as sample data doesn't exist + skip("sample data not available") + # Check that sample data has the right structure - expect_true(!is.null(athlytics_sample_acwr)) - expect_s3_class(athlytics_sample_acwr, "data.frame") + expect_true(!is.null(sample_acwr)) + expect_s3_class(sample_acwr, "data.frame") }) test_that("load_local_activities validates input parameters", { @@ -20,7 +20,7 @@ test_that("load_local_activities validates input parameters", { load_local_activities("nonexistent_file.csv"), "File not found" ) - + # Test with invalid activity types skip_if_not(file.exists("strava_export_data/activities.csv")) expect_error( @@ -34,7 +34,7 @@ test_that("load_local_activities validates input parameters", { test_that("load_local_activities detects ZIP files", { skip("Requires actual ZIP file for testing") - + # This test would run if a test ZIP file is available # activities <- load_local_activities("test_export.zip") # expect_s3_class(activities, "data.frame") @@ -52,4 +52,3 @@ test_that("load_local_activities handles full Strava CSV structure", { test_that("load_local_activities filters by activity type", { skip("CSV column parsing is complex and already tested with real data") }) - diff --git a/tests/testthat/test-load-with-real-data.R b/tests/testthat/test-load-with-real-data.R index ee38a97..cae8a46 100644 --- a/tests/testthat/test-load-with-real-data.R +++ b/tests/testthat/test-load-with-real-data.R @@ -26,20 +26,20 @@ activities_dir <- normalizePath(file.path(project_root, "export_data", "activiti test_that("load_local_activities works with real ZIP export", { skip_if(!file.exists(zip_path), paste("Real export ZIP not available at", zip_path)) - + # Load from ZIP file activities <- load_local_activities(zip_path) - + expect_s3_class(activities, "data.frame") expect_gt(nrow(activities), 0) - + # Check required columns exist expect_true("id" %in% names(activities)) expect_true("date" %in% names(activities)) expect_true("type" %in% names(activities)) expect_true("distance" %in% names(activities)) expect_true("moving_time" %in% names(activities)) - + # Check data types expect_s3_class(activities$date, "Date") expect_true(is.numeric(activities$distance)) @@ -48,18 +48,18 @@ test_that("load_local_activities works with real ZIP export", { test_that("load_local_activities works with real CSV export", { skip_if(!file.exists(csv_path), paste("Real export CSV not available at", csv_path)) - + # Load from CSV file activities <- load_local_activities(csv_path) - + expect_s3_class(activities, "data.frame") expect_gt(nrow(activities), 0) - + # Check column structure expect_true("id" %in% names(activities)) expect_true("date" %in% names(activities)) expect_true("type" %in% names(activities)) - + # Check calculated columns if ("distance_km" %in% names(activities)) { expect_true(is.numeric(activities$distance_km)) @@ -71,18 +71,18 @@ test_that("load_local_activities works with real CSV export", { test_that("load_local_activities filters by activity type with real data", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + # Load all activities first all_activities <- load_local_activities(csv_path) - + # Get unique activity types unique_types <- unique(all_activities$type) - + if (length(unique_types) > 0) { # Filter for first type first_type <- unique_types[1] filtered <- load_local_activities(csv_path, activity_types = first_type) - + expect_s3_class(filtered, "data.frame") if (nrow(filtered) > 0) { expect_true(all(filtered$type == first_type)) @@ -92,18 +92,20 @@ test_that("load_local_activities filters by activity type with real data", { test_that("calculate functions work with real export data", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + # Try ACWR calculation with real data if (nrow(activities) >= 42) { # Get most common activity type activity_types <- table(activities$type) main_type <- names(activity_types)[which.max(activity_types)] - + if (sum(activities$type == main_type) >= 42) { - acwr <- calculate_acwr(activities, activity_type = main_type, - load_metric = "duration_mins") + acwr <- calculate_acwr(activities, + activity_type = main_type, + load_metric = "duration_mins" + ) expect_s3_class(acwr, "data.frame") expect_true("acwr" %in% names(acwr) || "acwr_smooth" %in% names(acwr)) } @@ -112,14 +114,14 @@ test_that("calculate functions work with real export data", { test_that("calculate_exposure works with real export data", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + if (nrow(activities) >= 50) { # Get most common activity type activity_types <- table(activities$type) main_type <- names(activity_types)[which.max(activity_types)] - + # 添加结束日期参数 exposure <- calculate_exposure(activities, activity_type = main_type, end_date = "2024-12-31") expect_s3_class(exposure, "data.frame") @@ -131,22 +133,25 @@ test_that("calculate_exposure works with real export data", { test_that("calculate_ef works with real export data", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + # Filter activities with heart rate data if ("average_heartrate" %in% names(activities)) { hr_activities <- activities[!is.na(activities$average_heartrate), ] - + if (nrow(hr_activities) >= 10) { # Get activity type with most HR data - hr_by_type <- aggregate(average_heartrate ~ type, - data = hr_activities, - FUN = length) + hr_by_type <- aggregate(average_heartrate ~ type, + data = hr_activities, + FUN = length + ) main_type <- hr_by_type$type[which.max(hr_by_type$average_heartrate)] - - ef <- calculate_ef(hr_activities, activity_type = main_type, - ef_metric = "pace_hr") + + ef <- calculate_ef(hr_activities, + activity_type = main_type, + ef_metric = "pace_hr" + ) expect_s3_class(ef, "data.frame") expect_true("ef_value" %in% names(ef)) } @@ -155,14 +160,16 @@ test_that("calculate_ef works with real export data", { test_that("load_local_activities handles various column formats in real data", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + # Check that various optional columns are handled - optional_cols <- c("average_heartrate", "max_heartrate", "average_watts", - "average_speed", "average_cadence", "elevation_gain", - "calories", "filename") - + optional_cols <- c( + "average_heartrate", "max_heartrate", "average_watts", + "average_speed", "average_cadence", "elevation_gain", + "calories", "filename" + ) + # At least some optional columns should exist existing_optional <- sum(optional_cols %in% names(activities)) expect_gt(existing_optional, 0) @@ -171,56 +178,59 @@ test_that("load_local_activities handles various column formats in real data", { test_that("calculate_pbs works with real export directory", { skip_if(!file.exists(csv_path), "Real export CSV not available") skip_if(!dir.exists(activities_dir), "Activity files directory not available") - + activities <- load_local_activities(csv_path) - + # Filter for activities with distance data - distance_activities <- activities[!is.na(activities$distance) & - activities$distance > 0, ] - + distance_activities <- activities[!is.na(activities$distance) & + activities$distance > 0, ] + if (nrow(distance_activities) >= 5) { # Try to calculate PBs for most common activity type activity_types <- table(distance_activities$type) main_type <- names(activity_types)[which.max(activity_types)] - + # Common distances for running (in meters) test_distances <- c(1000, 5000, 10000) - - tryCatch({ - pbs <- calculate_pbs( - activities_data = distance_activities, - export_dir = file.path(project_root, "export_data"), - activity_type = main_type, - distances_m = test_distances - ) - - expect_s3_class(pbs, "data.frame") - if (nrow(pbs) > 0) { - expect_true("is_pb" %in% names(pbs)) - expect_true("distance" %in% names(pbs)) + + tryCatch( + { + pbs <- calculate_pbs( + activities_data = distance_activities, + export_dir = file.path(project_root, "export_data"), + activity_type = main_type, + distances_m = test_distances + ) + + expect_s3_class(pbs, "data.frame") + if (nrow(pbs) > 0) { + expect_true("is_pb" %in% names(pbs)) + expect_true("distance" %in% names(pbs)) + } + }, + error = function(e) { + # PBs calculation may fail if activity files are not in expected format + skip(paste("PBs calculation not possible:", e$message)) } - }, error = function(e) { - # PBs calculation may fail if activity files are not in expected format - skip(paste("PBs calculation not possible:", e$message)) - }) + ) } }) test_that("plot functions work with real data", { skip_if_not_installed("ggplot2") skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + if (nrow(activities) >= 42) { # Get most common activity type activity_types <- table(activities$type) main_type <- names(activity_types)[which.max(activity_types)] - + if (sum(activities$type == main_type) >= 42) { # Calculate ACWR with real data acwr <- calculate_acwr(activities, activity_type = main_type) - + # Test plotting p <- plot_acwr(acwr) expect_s3_class(p, "ggplot") @@ -230,12 +240,12 @@ test_that("plot functions work with real data", { test_that("load_local_activities detects and handles different date formats", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + # Date column should be properly parsed expect_s3_class(activities$date, "Date") - + # Dates should be reasonable (not in future, not too old) expect_true(all(activities$date <= Sys.Date(), na.rm = TRUE)) expect_true(all(activities$date >= as.Date("2000-01-01"), na.rm = TRUE)) @@ -243,14 +253,14 @@ test_that("load_local_activities detects and handles different date formats", { test_that("load_local_activities handles missing and NA values", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + # Core columns should not be all NA expect_false(all(is.na(activities$id))) expect_false(all(is.na(activities$date))) expect_false(all(is.na(activities$type))) - + # Some optional columns may have NAs - that's OK # Just check the data frame is valid expect_gt(ncol(activities), 5) @@ -258,18 +268,17 @@ test_that("load_local_activities handles missing and NA values", { test_that("activity file references are valid in real data", { skip_if(!file.exists(csv_path), "Real export CSV not available") - + activities <- load_local_activities(csv_path) - + # Check if filename column exists if ("filename" %in% names(activities)) { # Some activities should have filenames has_filename <- !is.na(activities$filename) & activities$filename != "" - + if (any(has_filename)) { # Check if files actually exist (at least check format) expect_true(is.character(activities$filename)) } } }) - diff --git a/tests/testthat/test-parameter-boundaries.R b/tests/testthat/test-parameter-boundaries.R index d438514..6bcc2ca 100644 --- a/tests/testthat/test-parameter-boundaries.R +++ b/tests/testthat/test-parameter-boundaries.R @@ -1,4 +1,3 @@ - test_that("parameter boundary tests for coverage", { activities <- data.frame( date = as.Date("2023-06-01"), @@ -6,22 +5,21 @@ test_that("parameter boundary tests for coverage", { distance = 10, moving_time = 3600, average_heartrate = 150, - average_speed = 10/3600*1000 + average_speed = 10 / 3600 * 1000 ) - + # Test minimum duration parameter result1 <- calculate_ef(activities, start_date = "2023-05-01", end_date = "2023-07-01", min_duration_mins = 0, quality_control = "off") expect_s3_class(result1, "data.frame") - + # Test maximum duration parameter result2 <- calculate_ef(activities, start_date = "2023-05-01", end_date = "2023-07-01", min_duration_mins = 1000, quality_control = "off") expect_s3_class(result2, "data.frame") - + # Test different quality control settings result3 <- calculate_ef(activities, start_date = "2023-05-01", end_date = "2023-07-01", quality_control = "off") expect_s3_class(result3, "data.frame") - + result4 <- calculate_ef(activities, start_date = "2023-05-01", end_date = "2023-07-01", quality_control = "flag") expect_s3_class(result4, "data.frame") }) - diff --git a/tests/testthat/test-parse-activity-file-stream.R b/tests/testthat/test-parse-activity-file-stream.R index e6f3fd5..b2e1fc6 100644 --- a/tests/testthat/test-parse-activity-file-stream.R +++ b/tests/testthat/test-parse-activity-file-stream.R @@ -4,22 +4,22 @@ test_that("parse_activity_file handles different file types", { # Test with FIT files result1 <- Athlytics:::parse_activity_file("test.fit") expect_null(result1) - + # Test with TCX files result2 <- Athlytics:::parse_activity_file("test.tcx") expect_null(result2) - + # Test with GPX files result3 <- Athlytics:::parse_activity_file("test.gpx") expect_null(result3) - + # Test with uppercase extensions result4 <- Athlytics:::parse_activity_file("test.FIT") expect_null(result4) - + result5 <- Athlytics:::parse_activity_file("test.TCX") expect_null(result5) - + result6 <- Athlytics:::parse_activity_file("test.GPX") expect_null(result6) }) @@ -28,11 +28,11 @@ test_that("parse_activity_file handles compressed files", { # Test with .gz extension result1 <- Athlytics:::parse_activity_file("test.fit.gz") expect_null(result1) - + # Test with .GZ extension (case insensitive) result2 <- Athlytics:::parse_activity_file("test.fit.GZ") expect_null(result2) - + # Test with .gz in middle of filename result3 <- Athlytics:::parse_activity_file("test.gz.fit") expect_null(result3) @@ -42,11 +42,11 @@ test_that("parse_activity_file handles unsupported file types", { # Test with unsupported extension result1 <- Athlytics:::parse_activity_file("test.txt") expect_null(result1) - + # Test with no extension result2 <- Athlytics:::parse_activity_file("test") expect_null(result2) - + # Test with multiple extensions result3 <- Athlytics:::parse_activity_file("test.fit.backup") expect_null(result3) @@ -55,11 +55,11 @@ test_that("parse_activity_file handles unsupported file types", { test_that("parse_activity_file handles error conditions", { # Test with NULL file_path (should error) expect_error(Athlytics:::parse_activity_file(NULL)) - + # Test with empty string result2 <- Athlytics:::parse_activity_file("") expect_null(result2) - + # Test with NA (should error) expect_error(Athlytics:::parse_activity_file(NA)) }) @@ -68,11 +68,11 @@ test_that("parse_activity_file handles export_dir parameter", { # Test with NULL export_dir result1 <- Athlytics:::parse_activity_file("test.fit", export_dir = NULL) expect_null(result1) - + # Test with empty export_dir result2 <- Athlytics:::parse_activity_file("test.fit", export_dir = "") expect_null(result2) - + # Test with nonexistent export_dir result3 <- Athlytics:::parse_activity_file("test.fit", export_dir = "/nonexistent/dir") expect_null(result3) @@ -82,11 +82,11 @@ test_that("parse_activity_file handles file path edge cases", { # Test with path containing spaces result1 <- Athlytics:::parse_activity_file("test file.fit") expect_null(result1) - + # Test with path containing special characters result2 <- Athlytics:::parse_activity_file("test-file.fit") expect_null(result2) - + # Test with very long path long_path <- paste(rep("a", 200), collapse = "") result3 <- Athlytics:::parse_activity_file(paste0(long_path, ".fit")) @@ -97,7 +97,7 @@ test_that("parse_activity_file handles compression errors", { # Test with corrupted .gz file (simulated by nonexistent file) result1 <- Athlytics:::parse_activity_file("corrupted.fit.gz") expect_null(result1) - + # Test with .gz file that's not actually compressed result2 <- Athlytics:::parse_activity_file("notcompressed.fit.gz") expect_null(result2) @@ -110,7 +110,7 @@ test_that("parse_activity_file handles file parsing errors", { result1 <- Athlytics:::parse_activity_file(empty_file) expect_null(result1) unlink(empty_file) - + # Test with corrupted file corrupted_file <- tempfile(fileext = ".fit") writeLines("corrupted data", corrupted_file) @@ -124,7 +124,7 @@ test_that("parse_activity_file handles temporary file cleanup", { # This is more of an integration test result <- Athlytics:::parse_activity_file("test.fit.gz") expect_null(result) - + # Check that no temp files are left behind temp_files <- list.files(tempdir(), pattern = ".*\\.fit$", full.names = TRUE) # Should be empty or contain only files from other tests @@ -134,20 +134,20 @@ test_that("parse_activity_file handles different file formats", { # Test with mixed case file extensions result1 <- Athlytics:::parse_activity_file("test.FiT") expect_null(result1) - + result2 <- Athlytics:::parse_activity_file("test.TcX") expect_null(result2) - + result3 <- Athlytics:::parse_activity_file("test.GpX") expect_null(result3) - + # Test with file extensions in different positions result4 <- Athlytics:::parse_activity_file("test.fit.gz") expect_null(result4) - + result5 <- Athlytics:::parse_activity_file("test.tcx.gz") expect_null(result5) - + result6 <- Athlytics:::parse_activity_file("test.gpx.gz") expect_null(result6) }) @@ -156,11 +156,11 @@ test_that("parse_activity_file handles path resolution", { # Test with absolute path result1 <- Athlytics:::parse_activity_file("nonexistent.fit") expect_null(result1) - + # Test with export_dir parameter result2 <- Athlytics:::parse_activity_file("nonexistent.fit", export_dir = ".") expect_null(result2) - + # Test with relative path resolution result3 <- Athlytics:::parse_activity_file("nonexistent.fit", export_dir = "/tmp") expect_null(result3) diff --git a/tests/testthat/test-parse-real-files.R b/tests/testthat/test-parse-real-files.R index a365376..a063254 100644 --- a/tests/testthat/test-parse-real-files.R +++ b/tests/testthat/test-parse-real-files.R @@ -10,30 +10,33 @@ activities_dir <- file.path(base_dir, "export_data", "activities") test_that("calculate_decoupling parses real FIT files", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(activities_dir), "Activities directory not found") - + # Load activities act <- load_local_activities(csv_path) - + # Get some Run activities (they're more likely to have good decoupling data) runs <- act[act$type == "Run", ] - + if (nrow(runs) >= 10) { # Try decoupling calculation which requires parsing activity files - decoupling <- tryCatch({ - calculate_decoupling( - activities_data = runs[1:min(10, nrow(runs)), ], - export_dir = file.path(base_dir, "export_data") - ) - }, error = function(e) { - message("Decoupling error: ", e$message) - NULL - }) - + decoupling <- tryCatch( + { + calculate_decoupling( + activities_data = runs[1:min(10, nrow(runs)), ], + export_dir = file.path(base_dir, "export_data") + ) + }, + error = function(e) { + message("Decoupling error: ", e$message) + NULL + } + ) + if (!is.null(decoupling)) { expect_true(is.data.frame(decoupling) || inherits(decoupling, "tbl")) } } - + # Always succeed since we're just trying to execute code expect_true(TRUE) }) @@ -41,66 +44,72 @@ test_that("calculate_decoupling parses real FIT files", { test_that("calculate_pbs parses real activity files", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(activities_dir), "Activities directory not found") - + # Load activities act <- load_local_activities(csv_path) - + # Get some Run activities runs <- act[act$type == "Run", ] - + if (nrow(runs) >= 20) { # Try PBS calculation which requires parsing activity files - pbs <- tryCatch({ - calculate_pbs( - activities_data = runs[1:min(20, nrow(runs)), ], - export_dir = file.path(base_dir, "export_data"), - distance_meters = c(1000, 5000) - ) - }, error = function(e) { - message("PBS error: ", e$message) - NULL - }) - + pbs <- tryCatch( + { + calculate_pbs( + activities_data = runs[1:min(20, nrow(runs)), ], + export_dir = file.path(base_dir, "export_data"), + distance_meters = c(1000, 5000) + ) + }, + error = function(e) { + message("PBS error: ", e$message) + NULL + } + ) + if (!is.null(pbs)) { expect_true(is.data.frame(pbs) || inherits(pbs, "tbl")) } } - + expect_true(TRUE) }) test_that("calculate_decoupling with various activity types", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(activities_dir), "Activities directory not found") - + act <- load_local_activities(csv_path) - + # Test with different activity types for (atype in c("Run", "Ride", "VirtualRide")) { type_act <- act[act$type == atype, ] - + if (nrow(type_act) >= 5) { - decoupling <- tryCatch({ - calculate_decoupling( - activities_data = type_act[1:min(5, nrow(type_act)), ], - export_dir = file.path(base_dir, "export_data") - ) - }, error = function(e) NULL) - + decoupling <- tryCatch( + { + calculate_decoupling( + activities_data = type_act[1:min(5, nrow(type_act)), ], + export_dir = file.path(base_dir, "export_data") + ) + }, + error = function(e) NULL + ) + # Just try to execute, don't fail on errors } } - + expect_true(TRUE) }) test_that("calculate_pbs with different distances", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(activities_dir), "Activities directory not found") - + act <- load_local_activities(csv_path) runs <- act[act$type == "Run", ] - + if (nrow(runs) >= 30) { # Test various distance combinations distance_sets <- list( @@ -110,74 +119,83 @@ test_that("calculate_pbs with different distances", { c(5000, 10000), c(1000, 5000, 10000, 21097, 42195) ) - + for (distances in distance_sets) { - pbs <- tryCatch({ - calculate_pbs( - activities_data = runs[1:min(30, nrow(runs)), ], - export_dir = file.path(base_dir, "export_data"), - distance_meters = distances - ) - }, error = function(e) NULL) + pbs <- tryCatch( + { + calculate_pbs( + activities_data = runs[1:min(30, nrow(runs)), ], + export_dir = file.path(base_dir, "export_data"), + distance_meters = distances + ) + }, + error = function(e) NULL + ) } } - + expect_true(TRUE) }) test_that("decoupling and pbs with date ranges", { skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(activities_dir), "Activities directory not found") - + act <- load_local_activities(csv_path) runs <- act[act$type == "Run", ] - + if (nrow(runs) >= 50) { # Get date range dates <- range(runs$date, na.rm = TRUE) span <- as.numeric(diff(dates)) - + # Test first quarter q1_end <- dates[1] + span * 0.25 runs_q1 <- runs[runs$date <= q1_end, ] - + if (nrow(runs_q1) >= 10) { - dec_q1 <- tryCatch({ - calculate_decoupling( - activities_data = runs_q1[1:min(10, nrow(runs_q1)), ], - export_dir = file.path(base_dir, "export_data") - ) - }, error = function(e) NULL) + dec_q1 <- tryCatch( + { + calculate_decoupling( + activities_data = runs_q1[1:min(10, nrow(runs_q1)), ], + export_dir = file.path(base_dir, "export_data") + ) + }, + error = function(e) NULL + ) } - + # Test last quarter q3_start <- dates[1] + span * 0.75 runs_q3 <- runs[runs$date >= q3_start, ] - + if (nrow(runs_q3) >= 10) { - pbs_q3 <- tryCatch({ - calculate_pbs( - activities_data = runs_q3[1:min(10, nrow(runs_q3)), ], - export_dir = file.path(base_dir, "export_data"), - distance_meters = c(1000, 5000) - ) - }, error = function(e) NULL) + pbs_q3 <- tryCatch( + { + calculate_pbs( + activities_data = runs_q3[1:min(10, nrow(runs_q3)), ], + export_dir = file.path(base_dir, "export_data"), + distance_meters = c(1000, 5000) + ) + }, + error = function(e) NULL + ) } } - + expect_true(TRUE) }) test_that("parse different file formats", { skip_if(!dir.exists(activities_dir), "Activities directory not found") - + # Get sample files of each type all_files <- list.files(activities_dir, full.names = FALSE) - + fit_files <- all_files[grepl("\\.fit", all_files, ignore.case = TRUE)] tcx_files <- all_files[grepl("\\.tcx", all_files, ignore.case = TRUE)] gpx_files <- all_files[grepl("\\.gpx", all_files, ignore.case = TRUE)] - + # Create mini dataset for each file type if (length(fit_files) >= 5) { fit_ids <- sub("\\.fit.*", "", fit_files[1:5]) @@ -190,15 +208,18 @@ test_that("parse different file formats", { duration_mins = 30, stringsAsFactors = FALSE ) - - dec_fit <- tryCatch({ - calculate_decoupling( - activities_data = fit_data, - export_dir = file.path(base_dir, "export_data") - ) - }, error = function(e) NULL) + + dec_fit <- tryCatch( + { + calculate_decoupling( + activities_data = fit_data, + export_dir = file.path(base_dir, "export_data") + ) + }, + error = function(e) NULL + ) } - + if (length(tcx_files) >= 5) { tcx_ids <- sub("\\.tcx.*", "", tcx_files[1:5]) tcx_data <- data.frame( @@ -210,15 +231,18 @@ test_that("parse different file formats", { duration_mins = 30, stringsAsFactors = FALSE ) - - dec_tcx <- tryCatch({ - calculate_decoupling( - activities_data = tcx_data, - export_dir = file.path(base_dir, "export_data") - ) - }, error = function(e) NULL) + + dec_tcx <- tryCatch( + { + calculate_decoupling( + activities_data = tcx_data, + export_dir = file.path(base_dir, "export_data") + ) + }, + error = function(e) NULL + ) } - + if (length(gpx_files) >= 3) { gpx_ids <- sub("\\.gpx.*", "", gpx_files[1:3]) gpx_data <- data.frame( @@ -230,16 +254,19 @@ test_that("parse different file formats", { duration_mins = 30, stringsAsFactors = FALSE ) - - pbs_gpx <- tryCatch({ - calculate_pbs( - activities_data = gpx_data, - export_dir = file.path(base_dir, "export_data"), - distance_meters = c(1000) - ) - }, error = function(e) NULL) + + pbs_gpx <- tryCatch( + { + calculate_pbs( + activities_data = gpx_data, + export_dir = file.path(base_dir, "export_data"), + distance_meters = c(1000) + ) + }, + error = function(e) NULL + ) } - + expect_true(TRUE) }) @@ -247,48 +274,59 @@ test_that("plot functions with file-based data", { skip_if_not_installed("ggplot2") skip_if(!file.exists(csv_path), "CSV not found") skip_if(!dir.exists(activities_dir), "Activities directory not found") - + act <- load_local_activities(csv_path) runs <- act[act$type == "Run", ] - + if (nrow(runs) >= 20) { # Calculate with file parsing - decoupling <- tryCatch({ - calculate_decoupling( - activities_data = runs[1:min(20, nrow(runs)), ], - export_dir = file.path(base_dir, "export_data") - ) - }, error = function(e) NULL) - + decoupling <- tryCatch( + { + calculate_decoupling( + activities_data = runs[1:min(20, nrow(runs)), ], + export_dir = file.path(base_dir, "export_data") + ) + }, + error = function(e) NULL + ) + if (!is.null(decoupling) && nrow(decoupling) > 0) { - p1 <- tryCatch({ - plot_decoupling(decoupling) - }, error = function(e) NULL) - + p1 <- tryCatch( + { + plot_decoupling(decoupling) + }, + error = function(e) NULL + ) + if (!is.null(p1)) { expect_s3_class(p1, "gg") } } - - pbs <- tryCatch({ - calculate_pbs( - activities_data = runs[1:min(20, nrow(runs)), ], - export_dir = file.path(base_dir, "export_data"), - distance_meters = c(1000, 5000) - ) - }, error = function(e) NULL) - + + pbs <- tryCatch( + { + calculate_pbs( + activities_data = runs[1:min(20, nrow(runs)), ], + export_dir = file.path(base_dir, "export_data"), + distance_meters = c(1000, 5000) + ) + }, + error = function(e) NULL + ) + if (!is.null(pbs) && nrow(pbs) > 0) { - p2 <- tryCatch({ - plot_pbs(pbs_df = pbs) - }, error = function(e) NULL) - + p2 <- tryCatch( + { + plot_pbs(pbs_df = pbs) + }, + error = function(e) NULL + ) + if (!is.null(p2)) { expect_s3_class(p2, "gg") } } } - + expect_true(TRUE) }) - diff --git a/tests/testthat/test-pbs.R b/tests/testthat/test-pbs.R index bed30ad..2a0c1a4 100644 --- a/tests/testthat/test-pbs.R +++ b/tests/testthat/test-pbs.R @@ -6,7 +6,7 @@ library(ggplot2) # Explicitly load for s3_class checks if not automatically avai library(lubridate) # For seconds_to_period if used in manual_df # Load data: sample data from package & mock API returns from helper -data(Athlytics_sample_data) +data(sample_pbs) source(test_path("helper-mockdata.R"), local = TRUE) # NOTE: calculate_pbs tests are currently skipped because they require @@ -39,9 +39,9 @@ test_that("plot_pbs returns a ggplot object with valid pbs_df input", { # that calculate_pbs would output and plot_pbs expects. manual_pbs_df <- data.frame( activity_date = as.Date(c("2023-01-01", "2023-01-08", "2023-01-15", "2023-01-01", "2023-01-20")), - time_seconds = c(1200, 1180, 1190, 300, 1170), # Example times - distance = c(5000, 5000, 5000, 1000, 5000), # Example distances - is_pb = c(TRUE, TRUE, FALSE, TRUE, TRUE), # Example PB flags + time_seconds = c(1200, 1180, 1190, 300, 1170), # Example times + distance = c(5000, 5000, 5000, 1000, 5000), # Example distances + is_pb = c(TRUE, TRUE, FALSE, TRUE, TRUE), # Example PB flags distance_label = factor(c("5k", "5k", "5k", "1k", "5k"), levels = c("1k", "5k")), activity_id = as.character(1:5), elapsed_time = c(1200, 1180, 1190, 300, 1170), @@ -61,18 +61,17 @@ test_that("plot_pbs returns a ggplot object with valid pbs_df input", { # 2. Call plot_pbs with this manually created data p <- plot_pbs(pbs_df = manual_pbs_df, distance_meters = test_distance_meters) - + # 3. Perform assertions on the plot object 'p' expect_s3_class(p, "ggplot") - + # Check for expected layers if possible (e.g., points, lines) expect_true(length(p$layers) >= 2) # Expect at least geom_line and geom_point - + # Check labels (example) expect_equal(p$labels$x, "Activity Date") expect_equal(p$labels$y, "Best Time (MM:SS)") expect_equal(p$labels$title, "Personal Best Running Times Trend") - }) test_that("plot_pbs handles empty data frame input", { @@ -90,28 +89,28 @@ test_that("plot_pbs handles empty data frame input", { time_period = lubridate::seconds_to_period(numeric()), stringsAsFactors = FALSE ) - + # plot_pbs requires distance_meters to be specified, even if pbs_df is empty, # because it uses it for filtering and potentially for calculate_pbs call. # However, if pbs_df is empty, the internal calculate_pbs won't be called. - # The warning comes from `pbs_df[pbs_df$distance %in% distance_meters,]` if it results in empty or + # The warning comes from `pbs_df[pbs_df$distance %in% distance_meters,]` if it results in empty or # directly from the `nrow(pbs_df) == 0` check. expect_warning( - p_empty <- plot_pbs(pbs_df = empty_df, distance_meters = c(1000, 5000)), + p_empty <- plot_pbs(pbs_df = empty_df, distance_meters = c(1000, 5000)), regexp = "No PB data available|pbs_df does not contain data for the specified distance_meters" ) - expect_s3_class(p_empty, "ggplot") + expect_s3_class(p_empty, "ggplot") expect_true(grepl("No PB data available|No PB data for specified distances", p_empty$labels$title, ignore.case = TRUE)) }) # Test for add_trend_line argument test_that("plot_pbs handles add_trend_line argument", { - manual_pbs_df <- data.frame( - activity_date = as.Date(c("2023-01-01", "2023-01-08", "2023-01-15")), + manual_pbs_df <- data.frame( + activity_date = as.Date(c("2023-01-01", "2023-01-08", "2023-01-15")), time_seconds = c(1200, 1180, 1190), distance = c(5000, 5000, 5000), - is_pb = c(TRUE, TRUE, FALSE), distance_label = factor(c("5k", "5k", "5k")), - activity_id = as.character(1:3), elapsed_time = c(1200,1180,1190), - moving_time = c(1200,1180,1190), cumulative_pb_seconds = c(1200,1180,1180), + is_pb = c(TRUE, TRUE, FALSE), distance_label = factor(c("5k", "5k", "5k")), + activity_id = as.character(1:3), elapsed_time = c(1200, 1180, 1190), + moving_time = c(1200, 1180, 1190), cumulative_pb_seconds = c(1200, 1180, 1180), stringsAsFactors = FALSE ) manual_pbs_df$time_period <- lubridate::seconds_to_period(manual_pbs_df$time_seconds) @@ -119,7 +118,7 @@ test_that("plot_pbs handles add_trend_line argument", { p_trend <- plot_pbs(pbs_df = manual_pbs_df, distance_meters = test_dist_meters, add_trend_line = TRUE) p_no_trend <- plot_pbs(pbs_df = manual_pbs_df, distance_meters = test_dist_meters, add_trend_line = FALSE) - + get_smooth_layers <- function(p) sum(sapply(p$layers, function(l) inherits(l$geom, "GeomSmooth"))) expect_equal(get_smooth_layers(p_trend), 1) expect_equal(get_smooth_layers(p_no_trend), 0) @@ -128,18 +127,18 @@ test_that("plot_pbs handles add_trend_line argument", { # Optional: Test faceting if multiple distances are present test_that("plot_pbs facets for multiple distances", { manual_pbs_df_multi_dist <- data.frame( - activity_date = as.Date(c("2023-01-01", "2023-01-08", "2023-01-01")), + activity_date = as.Date(c("2023-01-01", "2023-01-08", "2023-01-01")), time_seconds = c(1200, 1180, 300), distance = c(5000, 5000, 1000), - is_pb = c(TRUE, TRUE, TRUE), distance_label = factor(c("5k", "5k", "1k"), levels=c("1k", "5k")), - activity_id = as.character(1:3), elapsed_time = c(1200,1180,300), - moving_time = c(1200,1180,300), cumulative_pb_seconds = c(1200,1180,300), + is_pb = c(TRUE, TRUE, TRUE), distance_label = factor(c("5k", "5k", "1k"), levels = c("1k", "5k")), + activity_id = as.character(1:3), elapsed_time = c(1200, 1180, 300), + moving_time = c(1200, 1180, 300), cumulative_pb_seconds = c(1200, 1180, 300), stringsAsFactors = FALSE ) manual_pbs_df_multi_dist$time_period <- lubridate::seconds_to_period(manual_pbs_df_multi_dist$time_seconds) test_dist_meters_multi <- unique(manual_pbs_df_multi_dist$distance) p_multi <- plot_pbs(pbs_df = manual_pbs_df_multi_dist, distance_meters = test_dist_meters_multi) - + # Check if faceting is applied (presence of FacetWrap class in plot object) is_faceted <- inherits(p_multi$facet, "FacetWrap") expect_true(is_faceted) @@ -148,4 +147,4 @@ test_that("plot_pbs facets for multiple distances", { # test_that("plot_pbs works with multiple distances", { # Covered by the first test # # Use mock_pbs_df which already has multiple distances # expect_s3_class(plot_pbs(pbs_df = mock_pbs_df), "ggplot") -# }) \ No newline at end of file +# }) diff --git a/tests/testthat/test-plot-acwr-enhanced.R b/tests/testthat/test-plot-acwr-enhanced.R index 1352ec7..6134f01 100644 --- a/tests/testthat/test-plot-acwr-enhanced.R +++ b/tests/testthat/test-plot-acwr-enhanced.R @@ -30,7 +30,7 @@ create_test_reference_data <- function() { # Test basic functionality test_that("plot_acwr_enhanced works with basic data", { acwr_data <- create_test_acwr_data() - + p <- plot_acwr_enhanced(acwr_data) expect_s3_class(p, "gg") }) @@ -41,7 +41,7 @@ test_that("plot_acwr_enhanced validates input data", { plot_acwr_enhanced("not_a_dataframe"), "`acwr_data` must be a data frame" ) - + # Test with missing required columns bad_data <- data.frame(date = Sys.Date(), other_col = 1) expect_error( @@ -52,15 +52,15 @@ test_that("plot_acwr_enhanced validates input data", { test_that("plot_acwr_enhanced handles confidence intervals", { acwr_data <- create_test_acwr_data() - + # Test with CI enabled (should work) p1 <- plot_acwr_enhanced(acwr_data, show_ci = TRUE) expect_s3_class(p1, "gg") - + # Test with CI disabled p2 <- plot_acwr_enhanced(acwr_data, show_ci = FALSE) expect_s3_class(p2, "gg") - + # Test with data missing CI columns acwr_no_ci <- acwr_data[, !names(acwr_data) %in% c("acwr_lower", "acwr_upper")] p3 <- plot_acwr_enhanced(acwr_no_ci, show_ci = TRUE) @@ -70,15 +70,15 @@ test_that("plot_acwr_enhanced handles confidence intervals", { test_that("plot_acwr_enhanced handles reference data", { acwr_data <- create_test_acwr_data() reference_data <- create_test_reference_data() - + # Test with reference data p1 <- plot_acwr_enhanced(acwr_data, reference_data = reference_data) expect_s3_class(p1, "gg") - + # Test with reference disabled p2 <- plot_acwr_enhanced(acwr_data, reference_data = reference_data, show_reference = FALSE) expect_s3_class(p2, "gg") - + # Test with no reference data provided p3 <- plot_acwr_enhanced(acwr_data, show_reference = TRUE) expect_s3_class(p3, "gg") @@ -87,28 +87,34 @@ test_that("plot_acwr_enhanced handles reference data", { test_that("plot_acwr_enhanced handles different reference bands", { acwr_data <- create_test_acwr_data() reference_data <- create_test_reference_data() - + # Test with different band combinations - p1 <- plot_acwr_enhanced(acwr_data, reference_data = reference_data, - reference_bands = c("p25_p75")) + p1 <- plot_acwr_enhanced(acwr_data, + reference_data = reference_data, + reference_bands = c("p25_p75") + ) expect_s3_class(p1, "gg") - - p2 <- plot_acwr_enhanced(acwr_data, reference_data = reference_data, - reference_bands = c("p05_p95", "p50")) + + p2 <- plot_acwr_enhanced(acwr_data, + reference_data = reference_data, + reference_bands = c("p05_p95", "p50") + ) expect_s3_class(p2, "gg") - - p3 <- plot_acwr_enhanced(acwr_data, reference_data = reference_data, - reference_bands = c("p50")) + + p3 <- plot_acwr_enhanced(acwr_data, + reference_data = reference_data, + reference_bands = c("p50") + ) expect_s3_class(p3, "gg") }) test_that("plot_acwr_enhanced handles risk zones", { acwr_data <- create_test_acwr_data() - + # Test with zones enabled p1 <- plot_acwr_enhanced(acwr_data, highlight_zones = TRUE) expect_s3_class(p1, "gg") - + # Test with zones disabled p2 <- plot_acwr_enhanced(acwr_data, highlight_zones = FALSE) expect_s3_class(p2, "gg") @@ -116,13 +122,14 @@ test_that("plot_acwr_enhanced handles risk zones", { test_that("plot_acwr_enhanced handles custom titles", { acwr_data <- create_test_acwr_data() - + # Test with custom title and subtitle - p1 <- plot_acwr_enhanced(acwr_data, - title = "Custom Title", - subtitle = "Custom Subtitle") + p1 <- plot_acwr_enhanced(acwr_data, + title = "Custom Title", + subtitle = "Custom Subtitle" + ) expect_s3_class(p1, "gg") - + # Test with method label p2 <- plot_acwr_enhanced(acwr_data, method_label = "EWMA") expect_s3_class(p2, "gg") @@ -131,7 +138,7 @@ test_that("plot_acwr_enhanced handles custom titles", { test_that("plot_acwr_enhanced handles all combinations", { acwr_data <- create_test_acwr_data() reference_data <- create_test_reference_data() - + # Test with all features enabled p <- plot_acwr_enhanced( acwr_data, @@ -151,11 +158,11 @@ test_that("plot_acwr_enhanced handles all combinations", { test_that("plot_acwr_comparison works correctly", { acwr_ra <- create_test_acwr_data() acwr_ewma <- create_test_acwr_data() - + # Test basic comparison p1 <- plot_acwr_comparison(acwr_ra, acwr_ewma) expect_s3_class(p1, "gg") - + # Test with custom title p2 <- plot_acwr_comparison(acwr_ra, acwr_ewma, title = "Custom Comparison") expect_s3_class(p2, "gg") @@ -164,13 +171,13 @@ test_that("plot_acwr_comparison works correctly", { test_that("plot_acwr_comparison handles data binding", { acwr_ra <- create_test_acwr_data() acwr_ewma <- create_test_acwr_data() - + # The function should combine the data correctly p <- plot_acwr_comparison(acwr_ra, acwr_ewma) - + # Check that the plot has the expected structure expect_s3_class(p, "gg") - + # The plot should be a valid ggplot expect_s3_class(p, "gg") }) @@ -184,21 +191,21 @@ test_that("plot_acwr_enhanced handles edge cases", { acwr_lower = 0.8, acwr_upper = 1.2 ) - + p <- plot_acwr_enhanced(single_point) expect_s3_class(p, "gg") - + # Test with NA values acwr_with_na <- create_test_acwr_data() acwr_with_na$acwr_smooth[5:10] <- NA - + p2 <- plot_acwr_enhanced(acwr_with_na) expect_s3_class(p2, "gg") }) test_that("plot_acwr_enhanced handles missing reference percentiles", { acwr_data <- create_test_acwr_data() - + # Create reference data missing some percentiles incomplete_ref <- data.frame( date = seq(Sys.Date() - 30, Sys.Date(), by = "day"), @@ -206,7 +213,7 @@ test_that("plot_acwr_enhanced handles missing reference percentiles", { value = runif(62, 0.5, 2.0), stringsAsFactors = FALSE ) - + # Should still work but only show available bands p <- plot_acwr_enhanced(acwr_data, reference_data = incomplete_ref) expect_s3_class(p, "gg") diff --git a/tests/testthat/test-plot-ef-advanced.R b/tests/testthat/test-plot-ef-advanced.R index 0807f0e..96382c2 100644 --- a/tests/testthat/test-plot-ef-advanced.R +++ b/tests/testthat/test-plot-ef-advanced.R @@ -12,22 +12,26 @@ test_that("plot_ef handles complex data scenarios", { filename = rep(NA, 67), stringsAsFactors = FALSE ) - + # Test plot_ef with complex data calculation - p <- plot_ef(data = mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - start_date = Sys.Date() - 100, - end_date = Sys.Date(), - min_duration_mins = 15) + p <- plot_ef( + data = mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + start_date = Sys.Date() - 100, + end_date = Sys.Date(), + min_duration_mins = 15 + ) expect_s3_class(p, "ggplot") - + # Test with different smoothing parameters - p2 <- plot_ef(data = mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - smoothing_method = "loess", - add_trend_line = TRUE) + p2 <- plot_ef( + data = mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + smoothing_method = "loess", + add_trend_line = TRUE + ) expect_s3_class(p2, "ggplot") }) @@ -43,95 +47,103 @@ test_that("plot_ef handles edge cases with data", { filename = rep(NA, 4), stringsAsFactors = FALSE ) - - p <- plot_ef(data = mock_gapped, - activity_type = "Run", - ef_metric = "pace_hr") + + p <- plot_ef( + data = mock_gapped, + activity_type = "Run", + ef_metric = "pace_hr" + ) expect_s3_class(p, "ggplot") - + # Test with data that has outliers mock_outliers <- data.frame( date = seq(Sys.Date() - 50, Sys.Date(), by = "7 days"), type = rep("Run", 8), moving_time = rep(2400, 8), distance = rep(8000, 8), - average_heartrate = c(150, 155, 160, 200, 165, 170, 175, 180), # Outlier at 200 + average_heartrate = c(150, 155, 160, 200, 165, 170, 175, 180), # Outlier at 200 average_watts = rep(200, 8), filename = rep(NA, 8), stringsAsFactors = FALSE ) - - p2 <- plot_ef(data = mock_outliers, - activity_type = "Run", - ef_metric = "pace_hr") + + p2 <- plot_ef( + data = mock_outliers, + activity_type = "Run", + ef_metric = "pace_hr" + ) expect_s3_class(p2, "ggplot") }) test_that("plot_ef handles different smoothing scenarios", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with different smoothing methods and parameters - p1 <- plot_ef(athlytics_sample_ef, smoothing_method = "loess", add_trend_line = TRUE) + p1 <- plot_ef(sample_ef, smoothing_method = "loess", add_trend_line = TRUE) expect_s3_class(p1, "ggplot") - - p2 <- plot_ef(athlytics_sample_ef, smoothing_method = "lm", add_trend_line = FALSE) + + p2 <- plot_ef(sample_ef, smoothing_method = "lm", add_trend_line = FALSE) expect_s3_class(p2, "ggplot") - - p3 <- plot_ef(athlytics_sample_ef, smoothing_method = "gam", add_trend_line = TRUE) + + p3 <- plot_ef(sample_ef, smoothing_method = "gam", add_trend_line = TRUE) expect_s3_class(p3, "ggplot") }) test_that("plot_ef handles activity type filtering edge cases", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with activity type that exists in data - p1 <- plot_ef(athlytics_sample_ef, activity_type = "Run") + p1 <- plot_ef(sample_ef, activity_type = "Run") expect_s3_class(p1, "ggplot") - + # Test with activity type that doesn't exist in data - p2 <- plot_ef(athlytics_sample_ef, activity_type = "Swim") + p2 <- plot_ef(sample_ef, activity_type = "Swim") expect_s3_class(p2, "ggplot") - + # Test with multiple activity types - p3 <- plot_ef(athlytics_sample_ef, activity_type = c("Run", "Ride")) + p3 <- plot_ef(sample_ef, activity_type = c("Run", "Ride")) expect_s3_class(p3, "ggplot") }) test_that("plot_ef handles date filtering edge cases", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with date range that includes all data - p1 <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() - 365, - end_date = Sys.Date() + 1) + p1 <- plot_ef(sample_ef, + start_date = Sys.Date() - 365, + end_date = Sys.Date() + 1 + ) expect_s3_class(p1, "ggplot") - + # Test with date range that includes no data - p2 <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() + 1, - end_date = Sys.Date() + 100) + p2 <- plot_ef(sample_ef, + start_date = Sys.Date() + 1, + end_date = Sys.Date() + 100 + ) expect_s3_class(p2, "ggplot") - + # Test with only start_date - p3 <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() - 30) + p3 <- plot_ef(sample_ef, + start_date = Sys.Date() - 30 + ) expect_s3_class(p3, "ggplot") - + # Test with only end_date - p4 <- plot_ef(athlytics_sample_ef, - end_date = Sys.Date()) + p4 <- plot_ef(sample_ef, + end_date = Sys.Date() + ) expect_s3_class(p4, "ggplot") }) test_that("plot_ef handles ef_metric edge cases", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with pace_hr metric - p1 <- plot_ef(athlytics_sample_ef, ef_metric = "pace_hr") + p1 <- plot_ef(sample_ef, ef_metric = "pace_hr") expect_s3_class(p1, "ggplot") - + # Test with power_hr metric - p2 <- plot_ef(athlytics_sample_ef, ef_metric = "power_hr") + p2 <- plot_ef(sample_ef, ef_metric = "power_hr") expect_s3_class(p2, "ggplot") }) @@ -142,10 +154,10 @@ test_that("plot_ef handles data structure variations", { activity_type = c("Run", "Run", "Run"), ef_value = c(0.02, 0.021, 0.019) ) - + p1 <- plot_ef(minimal_data) expect_s3_class(p1, "ggplot") - + # Test with extra columns extra_data <- data.frame( date = c(Sys.Date(), Sys.Date() - 1, Sys.Date() - 2), @@ -154,7 +166,7 @@ test_that("plot_ef handles data structure variations", { extra_col1 = c("A", "B", "C"), extra_col2 = c(1, 2, 3) ) - + p2 <- plot_ef(extra_data) expect_s3_class(p2, "ggplot") }) @@ -166,7 +178,7 @@ test_that("plot_ef handles single data point", { activity_type = "Run", ef_value = 0.02 ) - + p <- plot_ef(single_data) expect_s3_class(p, "ggplot") }) @@ -178,32 +190,33 @@ test_that("plot_ef handles data with NA values", { activity_type = c("Run", "Run", "Run"), ef_value = c(0.02, NA, 0.019) ) - + p <- plot_ef(na_data) expect_s3_class(p, "ggplot") - + # Test with all NA ef_values all_na_data <- data.frame( date = c(Sys.Date(), Sys.Date() - 1), activity_type = c("Run", "Run"), ef_value = c(NA, NA) ) - + p2 <- plot_ef(all_na_data) expect_s3_class(p2, "ggplot") }) test_that("plot_ef handles complex parameter combinations", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test multiple parameters together - p <- plot_ef(athlytics_sample_ef, - activity_type = "Run", - ef_metric = "pace_hr", - add_trend_line = TRUE, - smoothing_method = "loess", - start_date = Sys.Date() - 30, - end_date = Sys.Date(), - min_duration_mins = 15) + p <- plot_ef(sample_ef, + activity_type = "Run", + ef_metric = "pace_hr", + add_trend_line = TRUE, + smoothing_method = "loess", + start_date = Sys.Date() - 30, + end_date = Sys.Date(), + min_duration_mins = 15 + ) expect_s3_class(p, "ggplot") }) diff --git a/tests/testthat/test-plot-ef-comprehensive.R b/tests/testthat/test-plot-ef-comprehensive.R index 6aadab5..c51dc3c 100644 --- a/tests/testthat/test-plot-ef-comprehensive.R +++ b/tests/testthat/test-plot-ef-comprehensive.R @@ -12,94 +12,101 @@ test_that("plot_ef handles data calculation from activities", { filename = rep(NA, 15), stringsAsFactors = FALSE ) - + # Test plot_ef calculating EF from activities data - p <- plot_ef(data = mock_activities, - activity_type = "Run", - ef_metric = "pace_hr") + p <- plot_ef( + data = mock_activities, + activity_type = "Run", + ef_metric = "pace_hr" + ) expect_s3_class(p, "ggplot") - + # Test with different parameters - p2 <- plot_ef(data = mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - start_date = Sys.Date() - 50, - end_date = Sys.Date(), - min_duration_mins = 15) + p2 <- plot_ef( + data = mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + start_date = Sys.Date() - 50, + end_date = Sys.Date(), + min_duration_mins = 15 + ) expect_s3_class(p2, "ggplot") }) test_that("plot_ef handles different smoothing methods", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test different smoothing methods - p_loess <- plot_ef(athlytics_sample_ef, smoothing_method = "loess") + p_loess <- plot_ef(sample_ef, smoothing_method = "loess") expect_s3_class(p_loess, "ggplot") - - p_lm <- plot_ef(athlytics_sample_ef, smoothing_method = "lm") + + p_lm <- plot_ef(sample_ef, smoothing_method = "lm") expect_s3_class(p_lm, "ggplot") - - p_gam <- plot_ef(athlytics_sample_ef, smoothing_method = "gam") + + p_gam <- plot_ef(sample_ef, smoothing_method = "gam") expect_s3_class(p_gam, "ggplot") }) test_that("plot_ef handles different activity type combinations", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with single activity type - p_run <- plot_ef(athlytics_sample_ef, activity_type = "Run") + p_run <- plot_ef(sample_ef, activity_type = "Run") expect_s3_class(p_run, "ggplot") - + # Test with multiple activity types - p_multi <- plot_ef(athlytics_sample_ef, activity_type = c("Run", "Ride")) + p_multi <- plot_ef(sample_ef, activity_type = c("Run", "Ride")) expect_s3_class(p_multi, "ggplot") - + # Test with activity type not in data - p_none <- plot_ef(athlytics_sample_ef, activity_type = "Swim") + p_none <- plot_ef(sample_ef, activity_type = "Swim") expect_s3_class(p_none, "ggplot") }) test_that("plot_ef handles date filtering", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with date range - p_date <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() - 30, - end_date = Sys.Date()) + p_date <- plot_ef(sample_ef, + start_date = Sys.Date() - 30, + end_date = Sys.Date() + ) expect_s3_class(p_date, "ggplot") - + # Test with only start_date - p_start <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() - 30) + p_start <- plot_ef(sample_ef, + start_date = Sys.Date() - 30 + ) expect_s3_class(p_start, "ggplot") - + # Test with only end_date - p_end <- plot_ef(athlytics_sample_ef, - end_date = Sys.Date()) + p_end <- plot_ef(sample_ef, + end_date = Sys.Date() + ) expect_s3_class(p_end, "ggplot") }) test_that("plot_ef handles different ef_metric values", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with pace_hr metric - p_pace <- plot_ef(athlytics_sample_ef, ef_metric = "pace_hr") + p_pace <- plot_ef(sample_ef, ef_metric = "pace_hr") expect_s3_class(p_pace, "ggplot") - + # Test with power_hr metric - p_power <- plot_ef(athlytics_sample_ef, ef_metric = "power_hr") + p_power <- plot_ef(sample_ef, ef_metric = "power_hr") expect_s3_class(p_power, "ggplot") }) test_that("plot_ef handles trend line options", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with trend line - p_trend <- plot_ef(athlytics_sample_ef, add_trend_line = TRUE) + p_trend <- plot_ef(sample_ef, add_trend_line = TRUE) expect_s3_class(p_trend, "ggplot") - + # Test without trend line - p_no_trend <- plot_ef(athlytics_sample_ef, add_trend_line = FALSE) + p_no_trend <- plot_ef(sample_ef, add_trend_line = FALSE) expect_s3_class(p_no_trend, "ggplot") }) @@ -110,10 +117,10 @@ test_that("plot_ef handles data with different structures", { activity_type = c("Run", "Run"), ef_value = c(0.02, 0.021) ) - + p_minimal <- plot_ef(minimal_data) expect_s3_class(p_minimal, "ggplot") - + # Test with extra columns extra_data <- data.frame( date = c(Sys.Date(), Sys.Date() - 1), @@ -121,7 +128,7 @@ test_that("plot_ef handles data with different structures", { ef_value = c(0.02, 0.021), extra_col = c("A", "B") ) - + p_extra <- plot_ef(extra_data) expect_s3_class(p_extra, "ggplot") }) @@ -133,32 +140,33 @@ test_that("plot_ef handles edge cases with data", { activity_type = "Run", ef_value = 0.02 ) - + p_single <- plot_ef(single_row) expect_s3_class(p_single, "ggplot") - + # Test with all NA ef_values na_data <- data.frame( date = c(Sys.Date(), Sys.Date() - 1), activity_type = c("Run", "Run"), ef_value = c(NA, NA) ) - + p_na <- plot_ef(na_data) expect_s3_class(p_na, "ggplot") }) test_that("plot_ef handles parameter combinations", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test multiple parameters together - p_combo <- plot_ef(athlytics_sample_ef, - activity_type = "Run", - ef_metric = "pace_hr", - add_trend_line = TRUE, - smoothing_method = "loess", - start_date = Sys.Date() - 30, - end_date = Sys.Date(), - min_duration_mins = 15) + p_combo <- plot_ef(sample_ef, + activity_type = "Run", + ef_metric = "pace_hr", + add_trend_line = TRUE, + smoothing_method = "loess", + start_date = Sys.Date() - 30, + end_date = Sys.Date(), + min_duration_mins = 15 + ) expect_s3_class(p_combo, "ggplot") }) diff --git a/tests/testthat/test-plot-ef-extended.R b/tests/testthat/test-plot-ef-extended.R index 5aef423..e265d64 100644 --- a/tests/testthat/test-plot-ef-extended.R +++ b/tests/testthat/test-plot-ef-extended.R @@ -16,55 +16,55 @@ create_mock_ef_data <- function(n = 30) { test_that("plot_ef recognizes ef_value column", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(40) - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef handles single activity type", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(30) ef_data$activity_type <- "Run" - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef handles multiple activity types", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(40) ef_data$activity_type <- rep(c("Run", "Ride", "VirtualRun"), length.out = 40) - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef works without trend line", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(25) - + p <- plot_ef(ef_data, add_trend_line = FALSE) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef works with different smoothing methods", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(50) - + # Test loess p1 <- plot_ef(ef_data, smoothing_method = "loess") expect_s3_class(p1, "ggplot") - + # Test lm p2 <- plot_ef(ef_data, smoothing_method = "lm") expect_s3_class(p2, "ggplot") @@ -72,59 +72,58 @@ test_that("plot_ef works with different smoothing methods", { test_that("plot_ef handles date filtering", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(60) - + p <- plot_ef( ef_data, start_date = Sys.Date() - 40, end_date = Sys.Date() - 10 ) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef handles NA values in ef_value", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(30) ef_data$ef_value[c(5, 10, 15)] <- NA - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef handles small datasets", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(5) - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef works with pace_hr metric", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(30) ef_data$ef_metric <- "pace_hr" - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_ef works with power_hr metric", { skip_if_not_installed("ggplot2") - + ef_data <- create_mock_ef_data(30) ef_data$ef_metric <- "power_hr" ef_data$activity_type <- "Ride" - + p <- plot_ef(ef_data) - + expect_s3_class(p, "ggplot") }) - diff --git a/tests/testthat/test-plot-ef-simple.R b/tests/testthat/test-plot-ef-simple.R index fcb2284..b9bca71 100644 --- a/tests/testthat/test-plot-ef-simple.R +++ b/tests/testthat/test-plot-ef-simple.R @@ -1,18 +1,18 @@ # Simple test for plot_ef.R to boost coverage test_that("plot_ef basic functionality", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test basic plotting - p1 <- plot_ef(athlytics_sample_ef) + p1 <- plot_ef(sample_ef) expect_s3_class(p1, "ggplot") - + # Test with add_trend_line = FALSE - p2 <- plot_ef(athlytics_sample_ef, add_trend_line = FALSE) + p2 <- plot_ef(sample_ef, add_trend_line = FALSE) expect_s3_class(p2, "ggplot") - + # Test with different smoothing methods - p3 <- plot_ef(athlytics_sample_ef, smoothing_method = "lm") + p3 <- plot_ef(sample_ef, smoothing_method = "lm") expect_s3_class(p3, "ggplot") }) @@ -23,52 +23,52 @@ test_that("plot_ef handles edge cases", { activity_type = character(0), ef_value = numeric(0) ) - + p_empty <- plot_ef(empty_ef) expect_s3_class(p_empty, "ggplot") - + # Test with single data point single_ef <- data.frame( date = Sys.Date(), activity_type = "Run", ef_value = 0.02 ) - + p_single <- plot_ef(single_ef) expect_s3_class(p_single, "ggplot") }) test_that("plot_ef handles different ef_metric values", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with pace_hr metric - p_pace <- plot_ef(athlytics_sample_ef, ef_metric = "pace_hr") + p_pace <- plot_ef(sample_ef, ef_metric = "pace_hr") expect_s3_class(p_pace, "ggplot") - + # Test with power_hr metric - p_power <- plot_ef(athlytics_sample_ef, ef_metric = "power_hr") + p_power <- plot_ef(sample_ef, ef_metric = "power_hr") expect_s3_class(p_power, "ggplot") }) test_that("plot_ef handles different activity types", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with different activity types - p_run <- plot_ef(athlytics_sample_ef, activity_type = "Run") + p_run <- plot_ef(sample_ef, activity_type = "Run") expect_s3_class(p_run, "ggplot") - + # Test with multiple activity types - p_multi <- plot_ef(athlytics_sample_ef, activity_type = c("Run", "Ride")) + p_multi <- plot_ef(sample_ef, activity_type = c("Run", "Ride")) expect_s3_class(p_multi, "ggplot") }) test_that("plot_ef handles NA values gracefully", { - data("athlytics_sample_ef") - + data("sample_ef") + # Add some NA values - ef_with_na <- athlytics_sample_ef + ef_with_na <- sample_ef ef_with_na$ef_value[1:5] <- NA - + p <- plot_ef(ef_with_na) expect_s3_class(p, "ggplot") }) diff --git a/tests/testthat/test-plot-ef-stream.R b/tests/testthat/test-plot-ef-stream.R index b2f81ed..566f8c3 100644 --- a/tests/testthat/test-plot-ef-stream.R +++ b/tests/testthat/test-plot-ef-stream.R @@ -12,22 +12,26 @@ test_that("plot_ef handles complex data scenarios", { filename = rep(NA, 67), stringsAsFactors = FALSE ) - + # Test plot_ef with complex data calculation - p <- plot_ef(data = mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - start_date = Sys.Date() - 100, - end_date = Sys.Date(), - min_duration_mins = 15) + p <- plot_ef( + data = mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + start_date = Sys.Date() - 100, + end_date = Sys.Date(), + min_duration_mins = 15 + ) expect_s3_class(p, "ggplot") - + # Test with different smoothing parameters - p2 <- plot_ef(data = mock_activities, - activity_type = "Run", - ef_metric = "pace_hr", - smoothing_method = "loess", - add_trend_line = TRUE) + p2 <- plot_ef( + data = mock_activities, + activity_type = "Run", + ef_metric = "pace_hr", + smoothing_method = "loess", + add_trend_line = TRUE + ) expect_s3_class(p2, "ggplot") }) @@ -43,95 +47,103 @@ test_that("plot_ef handles edge cases with data", { filename = rep(NA, 4), stringsAsFactors = FALSE ) - - p <- plot_ef(data = mock_gapped, - activity_type = "Run", - ef_metric = "pace_hr") + + p <- plot_ef( + data = mock_gapped, + activity_type = "Run", + ef_metric = "pace_hr" + ) expect_s3_class(p, "ggplot") - + # Test with data that has outliers mock_outliers <- data.frame( date = seq(Sys.Date() - 50, Sys.Date(), by = "7 days"), type = rep("Run", 8), moving_time = rep(2400, 8), distance = rep(8000, 8), - average_heartrate = c(150, 155, 160, 200, 165, 170, 175, 180), # Outlier at 200 + average_heartrate = c(150, 155, 160, 200, 165, 170, 175, 180), # Outlier at 200 average_watts = rep(200, 8), filename = rep(NA, 8), stringsAsFactors = FALSE ) - - p2 <- plot_ef(data = mock_outliers, - activity_type = "Run", - ef_metric = "pace_hr") + + p2 <- plot_ef( + data = mock_outliers, + activity_type = "Run", + ef_metric = "pace_hr" + ) expect_s3_class(p2, "ggplot") }) test_that("plot_ef handles different smoothing scenarios", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with different smoothing methods and parameters - p1 <- plot_ef(athlytics_sample_ef, smoothing_method = "loess", add_trend_line = TRUE) + p1 <- plot_ef(sample_ef, smoothing_method = "loess", add_trend_line = TRUE) expect_s3_class(p1, "ggplot") - - p2 <- plot_ef(athlytics_sample_ef, smoothing_method = "lm", add_trend_line = FALSE) + + p2 <- plot_ef(sample_ef, smoothing_method = "lm", add_trend_line = FALSE) expect_s3_class(p2, "ggplot") - - p3 <- plot_ef(athlytics_sample_ef, smoothing_method = "gam", add_trend_line = TRUE) + + p3 <- plot_ef(sample_ef, smoothing_method = "gam", add_trend_line = TRUE) expect_s3_class(p3, "ggplot") }) test_that("plot_ef handles activity type filtering edge cases", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with activity type that exists in data - p1 <- plot_ef(athlytics_sample_ef, activity_type = "Run") + p1 <- plot_ef(sample_ef, activity_type = "Run") expect_s3_class(p1, "ggplot") - + # Test with activity type that doesn't exist in data - p2 <- plot_ef(athlytics_sample_ef, activity_type = "Swim") + p2 <- plot_ef(sample_ef, activity_type = "Swim") expect_s3_class(p2, "ggplot") - + # Test with multiple activity types - p3 <- plot_ef(athlytics_sample_ef, activity_type = c("Run", "Ride")) + p3 <- plot_ef(sample_ef, activity_type = c("Run", "Ride")) expect_s3_class(p3, "ggplot") }) test_that("plot_ef handles date filtering edge cases", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with date range that includes all data - p1 <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() - 365, - end_date = Sys.Date() + 1) + p1 <- plot_ef(sample_ef, + start_date = Sys.Date() - 365, + end_date = Sys.Date() + 1 + ) expect_s3_class(p1, "ggplot") - + # Test with date range that includes no data - p2 <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() + 1, - end_date = Sys.Date() + 100) + p2 <- plot_ef(sample_ef, + start_date = Sys.Date() + 1, + end_date = Sys.Date() + 100 + ) expect_s3_class(p2, "ggplot") - + # Test with only start_date - p3 <- plot_ef(athlytics_sample_ef, - start_date = Sys.Date() - 30) + p3 <- plot_ef(sample_ef, + start_date = Sys.Date() - 30 + ) expect_s3_class(p3, "ggplot") - + # Test with only end_date - p4 <- plot_ef(athlytics_sample_ef, - end_date = Sys.Date()) + p4 <- plot_ef(sample_ef, + end_date = Sys.Date() + ) expect_s3_class(p4, "ggplot") }) test_that("plot_ef handles ef_metric edge cases", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test with pace_hr metric - p1 <- plot_ef(athlytics_sample_ef, ef_metric = "pace_hr") + p1 <- plot_ef(sample_ef, ef_metric = "pace_hr") expect_s3_class(p1, "ggplot") - + # Test with power_hr metric - p2 <- plot_ef(athlytics_sample_ef, ef_metric = "power_hr") + p2 <- plot_ef(sample_ef, ef_metric = "power_hr") expect_s3_class(p2, "ggplot") }) @@ -142,10 +154,10 @@ test_that("plot_ef handles data structure variations", { activity_type = c("Run", "Run", "Run"), ef_value = c(0.02, 0.021, 0.019) ) - + p1 <- plot_ef(minimal_data) expect_s3_class(p1, "ggplot") - + # Test with extra columns extra_data <- data.frame( date = c(Sys.Date(), Sys.Date() - 1, Sys.Date() - 2), @@ -154,7 +166,7 @@ test_that("plot_ef handles data structure variations", { extra_col1 = c("A", "B", "C"), extra_col2 = c(1, 2, 3) ) - + p2 <- plot_ef(extra_data) expect_s3_class(p2, "ggplot") }) @@ -166,7 +178,7 @@ test_that("plot_ef handles single data point", { activity_type = "Run", ef_value = 0.02 ) - + p <- plot_ef(single_data) expect_s3_class(p, "ggplot") }) @@ -178,32 +190,33 @@ test_that("plot_ef handles data with NA values", { activity_type = c("Run", "Run", "Run"), ef_value = c(0.02, NA, 0.019) ) - + p <- plot_ef(na_data) expect_s3_class(p, "ggplot") - + # Test with all NA ef_values all_na_data <- data.frame( date = c(Sys.Date(), Sys.Date() - 1), activity_type = c("Run", "Run"), ef_value = c(NA, NA) ) - + p2 <- plot_ef(all_na_data) expect_s3_class(p2, "ggplot") }) test_that("plot_ef handles complex parameter combinations", { - data("athlytics_sample_ef") - + data("sample_ef") + # Test multiple parameters together - p <- plot_ef(athlytics_sample_ef, - activity_type = "Run", - ef_metric = "pace_hr", - add_trend_line = TRUE, - smoothing_method = "loess", - start_date = Sys.Date() - 30, - end_date = Sys.Date(), - min_duration_mins = 15) + p <- plot_ef(sample_ef, + activity_type = "Run", + ef_metric = "pace_hr", + add_trend_line = TRUE, + smoothing_method = "loess", + start_date = Sys.Date() - 30, + end_date = Sys.Date(), + min_duration_mins = 15 + ) expect_s3_class(p, "ggplot") }) diff --git a/tests/testthat/test-plot-exposure-comprehensive.R b/tests/testthat/test-plot-exposure-comprehensive.R index c1369eb..16d746a 100644 --- a/tests/testthat/test-plot-exposure-comprehensive.R +++ b/tests/testthat/test-plot-exposure-comprehensive.R @@ -1,18 +1,18 @@ # Comprehensive test for plot_exposure.R to boost coverage test_that("plot_exposure handles pre-calculated data", { - data("athlytics_sample_exposure") - + data("sample_exposure") + # Test basic plotting with pre-calculated data - p1 <- plot_exposure(exposure_df = athlytics_sample_exposure) + p1 <- plot_exposure(exposure_df = sample_exposure) expect_s3_class(p1, "ggplot") - + # Test with risk_zones = FALSE - p2 <- plot_exposure(exposure_df = athlytics_sample_exposure, risk_zones = FALSE) + p2 <- plot_exposure(exposure_df = sample_exposure, risk_zones = FALSE) expect_s3_class(p2, "ggplot") - + # Test with risk_zones = TRUE - p3 <- plot_exposure(exposure_df = athlytics_sample_exposure, risk_zones = TRUE) + p3 <- plot_exposure(exposure_df = sample_exposure, risk_zones = TRUE) expect_s3_class(p3, "ggplot") }) @@ -27,20 +27,24 @@ test_that("plot_exposure handles data calculation from activities", { filename = rep(NA, 101), stringsAsFactors = FALSE ) - + # Test plot_exposure calculating from activities data - p <- plot_exposure(data = mock_activities, - activity_type = "Run", - load_metric = "duration_mins") + p <- plot_exposure( + data = mock_activities, + activity_type = "Run", + load_metric = "duration_mins" + ) expect_s3_class(p, "ggplot") - + # Test with different parameters - p2 <- plot_exposure(data = mock_activities, - activity_type = "Run", - load_metric = "duration_mins", - acute_period = 5, - chronic_period = 30, - end_date = Sys.Date()) + p2 <- plot_exposure( + data = mock_activities, + activity_type = "Run", + load_metric = "duration_mins", + acute_period = 5, + chronic_period = 30, + end_date = Sys.Date() + ) expect_s3_class(p2, "ggplot") }) @@ -55,72 +59,90 @@ test_that("plot_exposure handles different load metrics", { filename = rep(NA, 101), stringsAsFactors = FALSE ) - + # Test with duration_mins - p_duration <- plot_exposure(data = mock_activities, - activity_type = "Run", - load_metric = "duration_mins") + p_duration <- plot_exposure( + data = mock_activities, + activity_type = "Run", + load_metric = "duration_mins" + ) expect_s3_class(p_duration, "ggplot") - + # Test with tss (requires user_ftp) - may fail if no power data - p_tss <- tryCatch({ - plot_exposure(data = mock_activities, - activity_type = "Run", - load_metric = "tss", - user_ftp = 250) - }, error = function(e) { - # If it fails, create a simple plot instead - ggplot2::ggplot() + ggplot2::theme_void() - }) + p_tss <- tryCatch( + { + plot_exposure( + data = mock_activities, + activity_type = "Run", + load_metric = "tss", + user_ftp = 250 + ) + }, + error = function(e) { + # If it fails, create a simple plot instead + ggplot2::ggplot() + + ggplot2::theme_void() + } + ) expect_s3_class(p_tss, "ggplot") - + # Test with hrss (requires HR parameters) - p_hrss <- plot_exposure(data = mock_activities, - activity_type = "Run", - load_metric = "hrss", - user_max_hr = 200, - user_resting_hr = 50) + p_hrss <- plot_exposure( + data = mock_activities, + activity_type = "Run", + load_metric = "hrss", + user_max_hr = 200, + user_resting_hr = 50 + ) expect_s3_class(p_hrss, "ggplot") }) test_that("plot_exposure handles different activity types", { - data("athlytics_sample_exposure") - + data("sample_exposure") + # Test with single activity type - p_run <- plot_exposure(exposure_df = athlytics_sample_exposure, activity_type = "Run") + p_run <- plot_exposure(exposure_df = sample_exposure, activity_type = "Run") expect_s3_class(p_run, "ggplot") - + # Test with multiple activity types - p_multi <- plot_exposure(exposure_df = athlytics_sample_exposure, activity_type = c("Run", "Ride")) + p_multi <- plot_exposure(exposure_df = sample_exposure, activity_type = c("Run", "Ride")) expect_s3_class(p_multi, "ggplot") }) test_that("plot_exposure handles different period configurations", { - data("athlytics_sample_exposure") - + data("sample_exposure") + # Test with different acute/chronic periods - p1 <- plot_exposure(exposure_df = athlytics_sample_exposure, - acute_period = 5, - chronic_period = 30) + p1 <- plot_exposure( + exposure_df = sample_exposure, + acute_period = 5, + chronic_period = 30 + ) expect_s3_class(p1, "ggplot") - - p2 <- plot_exposure(exposure_df = athlytics_sample_exposure, - acute_period = 10, - chronic_period = 60) + + p2 <- plot_exposure( + exposure_df = sample_exposure, + acute_period = 10, + chronic_period = 60 + ) expect_s3_class(p2, "ggplot") }) test_that("plot_exposure handles date filtering", { - data("athlytics_sample_exposure") - + data("sample_exposure") + # Test with end_date - p_date <- plot_exposure(exposure_df = athlytics_sample_exposure, - end_date = Sys.Date()) + p_date <- plot_exposure( + exposure_df = sample_exposure, + end_date = Sys.Date() + ) expect_s3_class(p_date, "ggplot") - + # Test with end_date in the past - p_past <- plot_exposure(exposure_df = athlytics_sample_exposure, - end_date = Sys.Date() - 30) + p_past <- plot_exposure( + exposure_df = sample_exposure, + end_date = Sys.Date() - 30 + ) expect_s3_class(p_past, "ggplot") }) @@ -132,10 +154,10 @@ test_that("plot_exposure handles edge cases", { ctl = numeric(0), acwr = numeric(0) ) - + p_empty <- plot_exposure(exposure_df = empty_exposure) expect_s3_class(p_empty, "ggplot") - + # Test with single data point single_exposure <- data.frame( date = Sys.Date(), @@ -143,7 +165,7 @@ test_that("plot_exposure handles edge cases", { ctl = 40, acwr = 1.25 ) - + p_single <- plot_exposure(exposure_df = single_exposure) expect_s3_class(p_single, "ggplot") }) @@ -155,20 +177,22 @@ test_that("plot_exposure handles missing columns gracefully", { atl = c(50, 45), ctl = c(40, 38) ) - + p_no_acwr <- plot_exposure(exposure_df = exposure_no_acwr, risk_zones = FALSE) expect_s3_class(p_no_acwr, "ggplot") }) test_that("plot_exposure handles parameter combinations", { - data("athlytics_sample_exposure") - + data("sample_exposure") + # Test multiple parameters together - p_combo <- plot_exposure(exposure_df = athlytics_sample_exposure, - activity_type = "Run", - acute_period = 7, - chronic_period = 42, - risk_zones = TRUE, - end_date = Sys.Date()) + p_combo <- plot_exposure( + exposure_df = sample_exposure, + activity_type = "Run", + acute_period = 7, + chronic_period = 42, + risk_zones = TRUE, + end_date = Sys.Date() + ) expect_s3_class(p_combo, "ggplot") }) diff --git a/tests/testthat/test-plot-pbs-comprehensive.R b/tests/testthat/test-plot-pbs-comprehensive.R index fe3476f..0d04dda 100644 --- a/tests/testthat/test-plot-pbs-comprehensive.R +++ b/tests/testthat/test-plot-pbs-comprehensive.R @@ -1,18 +1,18 @@ # Comprehensive test for plot_pbs.R to boost coverage test_that("plot_pbs handles pre-calculated data", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Test basic plotting with pre-calculated data - p1 <- plot_pbs(pbs_df = athlytics_sample_pbs) + p1 <- plot_pbs(pbs_df = sample_pbs) expect_s3_class(p1, "ggplot") - + # Test with add_trend_line = FALSE - p2 <- plot_pbs(pbs_df = athlytics_sample_pbs, add_trend_line = FALSE) + p2 <- plot_pbs(pbs_df = sample_pbs, add_trend_line = FALSE) expect_s3_class(p2, "ggplot") - + # Test with add_trend_line = TRUE - p3 <- plot_pbs(pbs_df = athlytics_sample_pbs, add_trend_line = TRUE) + p3 <- plot_pbs(pbs_df = sample_pbs, add_trend_line = TRUE) expect_s3_class(p3, "ggplot") }) @@ -27,85 +27,101 @@ test_that("plot_pbs handles data calculation from activities", { filename = rep(NA, 15), stringsAsFactors = FALSE ) - + # Test plot_pbs calculating from activities data (may fail without export_dir) - p <- tryCatch({ - plot_pbs(data = mock_activities, - activity_type = "Run", - distance_meters = c(1000, 5000)) - }, error = function(e) { - # If it fails, create a simple plot instead - ggplot2::ggplot() + ggplot2::theme_void() - }) + p <- tryCatch( + { + plot_pbs( + data = mock_activities, + activity_type = "Run", + distance_meters = c(1000, 5000) + ) + }, + error = function(e) { + # If it fails, create a simple plot instead + ggplot2::ggplot() + + ggplot2::theme_void() + } + ) expect_s3_class(p, "ggplot") - + # Test with different parameters (may fail without export_dir) - p2 <- tryCatch({ - plot_pbs(data = mock_activities, - activity_type = "Run", - distance_meters = c(1000, 5000), - max_activities = 100, - add_trend_line = FALSE) - }, error = function(e) { - # If it fails, create a simple plot instead - ggplot2::ggplot() + ggplot2::theme_void() - }) + p2 <- tryCatch( + { + plot_pbs( + data = mock_activities, + activity_type = "Run", + distance_meters = c(1000, 5000), + max_activities = 100, + add_trend_line = FALSE + ) + }, + error = function(e) { + # If it fails, create a simple plot instead + ggplot2::ggplot() + + ggplot2::theme_void() + } + ) expect_s3_class(p2, "ggplot") }) test_that("plot_pbs handles different activity types", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Test with single activity type - p_run <- plot_pbs(pbs_df = athlytics_sample_pbs, activity_type = "Run") + p_run <- plot_pbs(pbs_df = sample_pbs, activity_type = "Run") expect_s3_class(p_run, "ggplot") - + # Test with multiple activity types - p_multi <- plot_pbs(pbs_df = athlytics_sample_pbs, activity_type = c("Run", "Ride")) + p_multi <- plot_pbs(pbs_df = sample_pbs, activity_type = c("Run", "Ride")) expect_s3_class(p_multi, "ggplot") }) test_that("plot_pbs handles different distance configurations", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Test with single distance - p1 <- plot_pbs(pbs_df = athlytics_sample_pbs, distance_meters = 1000) + p1 <- plot_pbs(pbs_df = sample_pbs, distance_meters = 1000) expect_s3_class(p1, "ggplot") - + # Test with multiple distances - p2 <- plot_pbs(pbs_df = athlytics_sample_pbs, distance_meters = c(1000, 5000, 10000)) + p2 <- plot_pbs(pbs_df = sample_pbs, distance_meters = c(1000, 5000, 10000)) expect_s3_class(p2, "ggplot") - + # Test with different distance combinations - p3 <- plot_pbs(pbs_df = athlytics_sample_pbs, distance_meters = c(500, 1500, 3000)) + p3 <- plot_pbs(pbs_df = sample_pbs, distance_meters = c(500, 1500, 3000)) expect_s3_class(p3, "ggplot") }) test_that("plot_pbs handles date range filtering", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Test with date range - p_date <- plot_pbs(pbs_df = athlytics_sample_pbs, - date_range = c(Sys.Date() - 30, Sys.Date())) + p_date <- plot_pbs( + pbs_df = sample_pbs, + date_range = c(Sys.Date() - 30, Sys.Date()) + ) expect_s3_class(p_date, "ggplot") - + # Test with date range in the past - p_past <- plot_pbs(pbs_df = athlytics_sample_pbs, - date_range = c(Sys.Date() - 100, Sys.Date() - 50)) + p_past <- plot_pbs( + pbs_df = sample_pbs, + date_range = c(Sys.Date() - 100, Sys.Date() - 50) + ) expect_s3_class(p_past, "ggplot") }) test_that("plot_pbs handles max_activities parameter", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Test with different max_activities values - p1 <- plot_pbs(pbs_df = athlytics_sample_pbs, max_activities = 50) + p1 <- plot_pbs(pbs_df = sample_pbs, max_activities = 50) expect_s3_class(p1, "ggplot") - - p2 <- plot_pbs(pbs_df = athlytics_sample_pbs, max_activities = 200) + + p2 <- plot_pbs(pbs_df = sample_pbs, max_activities = 200) expect_s3_class(p2, "ggplot") - - p3 <- plot_pbs(pbs_df = athlytics_sample_pbs, max_activities = 1000) + + p3 <- plot_pbs(pbs_df = sample_pbs, max_activities = 1000) expect_s3_class(p3, "ggplot") }) @@ -117,10 +133,10 @@ test_that("plot_pbs handles edge cases", { time_seconds = numeric(0), is_pb = logical(0) ) - + p_empty <- plot_pbs(pbs_df = empty_pbs) expect_s3_class(p_empty, "ggplot") - + # Test with single data point single_pbs <- data.frame( activity_date = Sys.Date(), @@ -128,7 +144,7 @@ test_that("plot_pbs handles edge cases", { time_seconds = 300, is_pb = TRUE ) - + p_single <- plot_pbs(pbs_df = single_pbs) expect_s3_class(p_single, "ggplot") }) @@ -140,21 +156,23 @@ test_that("plot_pbs handles missing columns gracefully", { distance_meters = c(1000, 1000), time_seconds = c(300, 310) ) - + p_no_pb <- plot_pbs(pbs_df = pbs_no_pb) expect_s3_class(p_no_pb, "ggplot") }) test_that("plot_pbs handles parameter combinations", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Test multiple parameters together - p_combo <- plot_pbs(pbs_df = athlytics_sample_pbs, - activity_type = "Run", - distance_meters = c(1000, 5000), - max_activities = 100, - date_range = c(Sys.Date() - 30, Sys.Date()), - add_trend_line = TRUE) + p_combo <- plot_pbs( + pbs_df = sample_pbs, + activity_type = "Run", + distance_meters = c(1000, 5000), + max_activities = 100, + date_range = c(Sys.Date() - 30, Sys.Date()), + add_trend_line = TRUE + ) expect_s3_class(p_combo, "ggplot") }) @@ -166,10 +184,10 @@ test_that("plot_pbs handles data with different structures", { time_seconds = c(300, 310), is_pb = c(TRUE, FALSE) ) - + p_minimal <- plot_pbs(pbs_df = minimal_pbs) expect_s3_class(p_minimal, "ggplot") - + # Test with extra columns extra_pbs <- data.frame( activity_date = c(Sys.Date(), Sys.Date() - 1), @@ -178,7 +196,7 @@ test_that("plot_pbs handles data with different structures", { is_pb = c(TRUE, FALSE), extra_col = c("A", "B") ) - + p_extra <- plot_pbs(pbs_df = extra_pbs) expect_s3_class(p_extra, "ggplot") }) diff --git a/tests/testthat/test-plot-pbs-extended.R b/tests/testthat/test-plot-pbs-extended.R index 24fe97b..9ee7b7b 100644 --- a/tests/testthat/test-plot-pbs-extended.R +++ b/tests/testthat/test-plot-pbs-extended.R @@ -7,7 +7,7 @@ library(ggplot2) create_mock_pbs <- function(n = 20) { data.frame( activity_id = 1:n, - activity_date = seq(Sys.Date() - n*5, by = "5 days", length.out = n), + activity_date = seq(Sys.Date() - n * 5, by = "5 days", length.out = n), distance = rep(c(1000, 5000, 10000, 21097), length.out = n), time_seconds = runif(n, 180, 7200), is_pb = sample(c(TRUE, FALSE), n, replace = TRUE, prob = c(0.3, 0.7)), @@ -20,69 +20,69 @@ create_mock_pbs <- function(n = 20) { test_that("plot_pbs works with basic pbs_df", { skip_if_not_installed("ggplot2") - + pbs_data <- create_mock_pbs(15) - + # Create plot using pbs_df parameter p <- plot_pbs(pbs_df = pbs_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_pbs handles different distance groups", { skip_if_not_installed("ggplot2") - + pbs_data <- create_mock_pbs(30) pbs_data$distance <- rep(c(1000, 5000, 10000), 10) - + p <- plot_pbs(pbs_df = pbs_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_pbs handles date range filtering", { skip_if_not_installed("ggplot2") - + pbs_data <- create_mock_pbs(40) - + p <- plot_pbs( pbs_df = pbs_data, date_range = c(Sys.Date() - 100, Sys.Date() - 50) ) - + expect_s3_class(p, "ggplot") }) test_that("plot_pbs handles data with no PBs", { skip_if_not_installed("ggplot2") - + pbs_data <- create_mock_pbs(10) pbs_data$is_pb <- FALSE - + p <- plot_pbs(pbs_df = pbs_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_pbs handles data with all PBs", { skip_if_not_installed("ggplot2") - + pbs_data <- create_mock_pbs(10) pbs_data$is_pb <- TRUE - + p <- plot_pbs(pbs_df = pbs_data) - + expect_s3_class(p, "ggplot") }) test_that("plot_pbs handles single distance", { skip_if_not_installed("ggplot2") - + pbs_data <- create_mock_pbs(15) - pbs_data$distance <- 5000 # All same distance - + pbs_data$distance <- 5000 # All same distance + p <- plot_pbs(pbs_df = pbs_data) - + expect_s3_class(p, "ggplot") }) @@ -90,4 +90,3 @@ test_that("plot_pbs works with activities data", { skip_if_not_installed("ggplot2") skip("Requires export_dir - tested elsewhere") }) - diff --git a/tests/testthat/test-plot-pbs-simple.R b/tests/testthat/test-plot-pbs-simple.R index 36fec71..07a9e2d 100644 --- a/tests/testthat/test-plot-pbs-simple.R +++ b/tests/testthat/test-plot-pbs-simple.R @@ -1,14 +1,14 @@ # Simple test for plot_pbs.R to boost coverage test_that("plot_pbs basic functionality", { - data("athlytics_sample_pbs") - + data("sample_pbs") + # Prepare pbs_df with proper column names - pbs_df <- athlytics_sample_pbs + pbs_df <- sample_pbs if ("date" %in% names(pbs_df) && !"activity_date" %in% names(pbs_df)) { names(pbs_df)[names(pbs_df) == "date"] <- "activity_date" } - + # Get distance_meters from the data req_dist_meters <- NULL if ("distance" %in% names(pbs_df)) { @@ -16,15 +16,15 @@ test_that("plot_pbs basic functionality", { } else if ("distance_target_m" %in% names(pbs_df)) { req_dist_meters <- unique(pbs_df$distance_target_m) } - + if (is.null(req_dist_meters) || length(req_dist_meters) == 0) { req_dist_meters <- c(1000, 5000, 10000) } - + # Test basic plotting p1 <- plot_pbs(pbs_df = pbs_df, distance_meters = req_dist_meters) expect_s3_class(p1, "ggplot") - + # Test with add_trend_line = FALSE p2 <- plot_pbs(pbs_df = pbs_df, distance_meters = req_dist_meters, add_trend_line = FALSE) expect_s3_class(p2, "ggplot") @@ -33,7 +33,7 @@ test_that("plot_pbs basic functionality", { test_that("plot_pbs handles edge cases", { # Test with NULL pbs_df and missing distance_meters expect_error(plot_pbs(pbs_df = NULL), "Either.*data.*or.*pbs_df.*must be provided") - + # Test with single data point single_pbs <- data.frame( activity_date = Sys.Date(), @@ -41,7 +41,7 @@ test_that("plot_pbs handles edge cases", { elapsed_time = 300, is_new_pb = TRUE ) - + p_single <- plot_pbs(pbs_df = single_pbs, distance_meters = 1000) expect_s3_class(p_single, "ggplot") }) @@ -54,10 +54,10 @@ test_that("plot_pbs handles different PBS value ranges", { elapsed_time = runif(31, 180, 240), is_new_pb = sample(c(TRUE, FALSE), 31, replace = TRUE) ) - + p_low <- plot_pbs(pbs_df = low_pbs, distance_meters = 1000) expect_s3_class(p_low, "ggplot") - + # Test with high time values high_pbs <- data.frame( activity_date = seq(Sys.Date() - 30, Sys.Date(), by = "1 day"), @@ -65,7 +65,7 @@ test_that("plot_pbs handles different PBS value ranges", { elapsed_time = runif(31, 1200, 1500), is_new_pb = sample(c(TRUE, FALSE), 31, replace = TRUE) ) - + p_high <- plot_pbs(pbs_df = high_pbs, distance_meters = 5000) expect_s3_class(p_high, "ggplot") }) diff --git a/tests/testthat/test-smoke-and-errors.R b/tests/testthat/test-smoke-and-errors.R index 6b628df..1f35611 100644 --- a/tests/testthat/test-smoke-and-errors.R +++ b/tests/testthat/test-smoke-and-errors.R @@ -11,24 +11,28 @@ test_that("input validation errors", { expect_error(calculate_ef(NULL, activity_type = "Run", ef_metric = "pace_hr")) expect_error(calculate_ef("not_a_df", activity_type = "Run", ef_metric = "pace_hr")) expect_error(calculate_ef(data.frame(), activity_type = "Run", ef_metric = "pace_hr")) - + # Invalid parameters - df <- data.frame(id = 1, date = Sys.Date(), type = "Run", moving_time = 1800, - distance = 5000, average_heartrate = 150, average_speed = 10) + df <- data.frame( + id = 1, date = Sys.Date(), type = "Run", moving_time = 1800, + distance = 5000, average_heartrate = 150, average_speed = 10 + ) expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", min_duration_mins = -5)) expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", min_steady_minutes = -10)) expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", steady_cv_threshold = 1.5)) expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", steady_cv_threshold = 0)) expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", min_hr_coverage = 1.5)) expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", min_hr_coverage = 0)) - expect_error(calculate_ef(df, activity_type = "Run", ef_metric = "pace_hr", - start_date = Sys.Date(), end_date = Sys.Date() - 30)) - + expect_error(calculate_ef(df, + activity_type = "Run", ef_metric = "pace_hr", + start_date = Sys.Date(), end_date = Sys.Date() - 30 + )) + # calculate_acwr errors expect_error(calculate_acwr()) expect_error(calculate_acwr(NULL)) expect_error(calculate_acwr(data.frame())) - + # load_local_activities errors expect_error(load_local_activities()) expect_error(load_local_activities(NULL)) @@ -44,13 +48,13 @@ test_that("all palette functions work", { pal_vibrant <- athlytics_palette_vibrant() pal_science <- athlytics_palette_science() pal_cell <- athlytics_palette_cell() - + expect_length(pal_nature, 9) expect_length(pal_academic, 8) expect_length(pal_vibrant, 8) expect_length(pal_science, 8) expect_length(pal_cell, 8) - + expect_true(all(grepl("^#", pal_nature))) expect_true(all(grepl("^#", pal_academic))) }) @@ -59,7 +63,7 @@ test_that("all color functions work", { acwr_colors <- athlytics_colors_acwr_zones() load_colors <- athlytics_colors_training_load() ef_colors <- athlytics_colors_ef() - + expect_true(is.character(acwr_colors) || is.list(acwr_colors)) expect_true(is.character(load_colors) || is.list(load_colors)) expect_true(is.character(ef_colors) || is.list(ef_colors)) @@ -71,7 +75,7 @@ test_that("theme functions work", { theme <- theme_athlytics(base_size = size) expect_s3_class(theme, "theme") } - + for (pal in c("nature", "academic", "vibrant")) { scale_c <- scale_athlytics(pal, type = "color") scale_f <- scale_athlytics(pal, type = "fill") @@ -84,23 +88,23 @@ test_that("theme functions work", { # ========== Real data tests (will work if data exists) ========== test_that("real data workflow if available", { csv_file <- "C:/Users/Ang/Documents/GitHub/Athlytics/export_data/activities.csv" - + if (file.exists(csv_file)) { # Load data act <- load_local_activities(csv_file) expect_gt(nrow(act), 0) - + # Test with main type types <- table(act$type) if (length(types) > 0) { main_type <- names(which.max(types)) type_act <- act[act$type == main_type, ] - + if (nrow(type_act) >= 60) { # ACWR calculation acwr <- calculate_acwr(type_act, activity_type = main_type) expect_gt(nrow(acwr), 0) - + # Plot ACWR if (requireNamespace("ggplot2", quietly = TRUE)) { p <- plot_acwr(acwr) @@ -122,29 +126,29 @@ test_that("quality flag functions", { cadence = rnorm(1000, 85, 10), speed = runif(1000, 2, 5) ) - + # Add bad values streams$heartrate[c(100, 200)] <- c(250, 30) streams$power[c(150, 250)] <- c(1200, 1500) - + # Test flag_quality flagged_run <- flag_quality(streams, sport = "Run") expect_s3_class(flagged_run, "data.frame") expect_gt(ncol(flagged_run), ncol(streams)) - + flagged_ride <- flag_quality(streams, sport = "Ride") expect_s3_class(flagged_ride, "data.frame") - + # Test quality_summary - summary <- quality_summary(flagged_run) + summary <- summarize_quality(flagged_run) expect_type(summary, "list") expect_true("total_points" %in% names(summary)) expect_true("flagged_points" %in% names(summary)) - + # Test with different parameters flagged2 <- flag_quality(streams, sport = "Run", hr_range = c(40, 200)) expect_s3_class(flagged2, "data.frame") - + flagged3 <- flag_quality(streams, sport = "Ride", pw_range = c(50, 1000)) expect_s3_class(flagged3, "data.frame") }) @@ -154,7 +158,7 @@ test_that("cohort_reference comprehensive", { # Create cohort data n_athletes <- 25 n_days <- 60 - + cohort <- data.frame( athlete_id = rep(paste0("A", 1:n_athletes), each = n_days), date = rep(seq(Sys.Date() - n_days, Sys.Date() - 1, by = "day"), n_athletes), @@ -163,28 +167,28 @@ test_that("cohort_reference comprehensive", { sport = rep(c("Run", "Ride", "Swim"), length.out = n_athletes * n_days), level = rep(c("Beginner", "Advanced"), length.out = n_athletes * n_days) ) - + # Basic cohort reference - ref1 <- cohort_reference(cohort, metric = "acwr_smooth") + ref1 <- calculate_cohort_reference(cohort, metric = "acwr_smooth") expect_s3_class(ref1, "data.frame") - + # With grouping - ref2 <- cohort_reference(cohort, metric = "acwr_smooth", by = "sport") + ref2 <- calculate_cohort_reference(cohort, metric = "acwr_smooth", by = "sport") expect_s3_class(ref2, "data.frame") - - ref3 <- cohort_reference(cohort, metric = "ef_value", by = c("sport", "level")) + + ref3 <- calculate_cohort_reference(cohort, metric = "ef_value", by = c("sport", "level")) expect_s3_class(ref3, "data.frame") - + # Different percentiles - ref4 <- cohort_reference(cohort, metric = "acwr_smooth", probs = c(0.1, 0.5, 0.9)) + ref4 <- calculate_cohort_reference(cohort, metric = "acwr_smooth", probs = c(0.1, 0.5, 0.9)) expect_s3_class(ref4, "data.frame") - + # Different min_athletes - ref5 <- cohort_reference(cohort, metric = "acwr_smooth", min_athletes = 5) + ref5 <- calculate_cohort_reference(cohort, metric = "acwr_smooth", min_athletes = 5) expect_s3_class(ref5, "data.frame") - + # Test errors - expect_error(cohort_reference(cohort[1:50, ], metric = "acwr_smooth", min_athletes = 100)) + expect_error(calculate_cohort_reference(cohort[1:50, ], metric = "acwr_smooth", min_athletes = 100)) }) # ========== Mock data calculation tests ========== @@ -202,27 +206,31 @@ test_that("calculations with mock data", { average_speed = runif(100, 8, 15), average_watts = runif(100, 150, 300) ) - + # Calculate ACWR acwr_run <- calculate_acwr(mock_act[mock_act$type == "Run", ], activity_type = "Run") expect_s3_class(acwr_run, "data.frame") - + # Calculate ACWR EWMA - acwr_ewma <- calculate_acwr_ewma(mock_act[mock_act$type == "Run", ], - activity_type = "Run", method = "ewma") + acwr_ewma <- calculate_acwr_ewma(mock_act[mock_act$type == "Run", ], + activity_type = "Run", method = "ewma" + ) expect_s3_class(acwr_ewma, "data.frame") - + acwr_ra <- calculate_acwr_ewma(mock_act[mock_act$type == "Run", ], - activity_type = "Run", method = "ra") + activity_type = "Run", method = "ra" + ) expect_s3_class(acwr_ra, "data.frame") - + # Calculate EF - ef_run <- calculate_ef(mock_act[mock_act$type == "Run", ], - activity_type = "Run", ef_metric = "pace_hr") + ef_run <- calculate_ef(mock_act[mock_act$type == "Run", ], + activity_type = "Run", ef_metric = "pace_hr" + ) expect_s3_class(ef_run, "data.frame") - + ef_ride <- calculate_ef(mock_act[mock_act$type == "Ride", ], - activity_type = "Ride", ef_metric = "power_hr") + activity_type = "Ride", ef_metric = "power_hr" + ) expect_s3_class(ef_ride, "data.frame") }) @@ -231,7 +239,7 @@ test_that("plots with mock data", { if (!requireNamespace("ggplot2", quietly = TRUE)) { skip("ggplot2 not available") } - + # Mock ACWR data acwr_data <- data.frame( date = seq(Sys.Date() - 100, Sys.Date(), length.out = 100), @@ -239,16 +247,16 @@ test_that("plots with mock data", { acute_load = runif(100, 200, 600), chronic_load = runif(100, 300, 500) ) - + p1 <- plot_acwr(acwr_data) expect_s3_class(p1, "gg") - + p2 <- plot_acwr_enhanced(acwr_data, highlight_zones = TRUE) expect_s3_class(p2, "gg") - + p3 <- plot_acwr_enhanced(acwr_data, highlight_zones = FALSE) expect_s3_class(p3, "gg") - + # Mock EF data mock_runs <- data.frame( id = 1:50, @@ -261,16 +269,16 @@ test_that("plots with mock data", { average_heartrate = runif(50, 130, 165), average_speed = runif(50, 9, 14) ) - + p4 <- plot_ef(mock_runs, activity_type = "Run", ef_metric = "pace_hr") expect_s3_class(p4, "gg") - + p5 <- plot_ef(mock_runs, activity_type = "Run", ef_metric = "pace_hr", add_trend_line = FALSE) expect_s3_class(p5, "gg") - + p6 <- plot_ef(mock_runs, activity_type = "Run", ef_metric = "pace_hr", smoothing_method = "lm") expect_s3_class(p6, "gg") - + # Mock PBs data pbs_data <- data.frame( activity_id = 1:60, @@ -282,13 +290,13 @@ test_that("plots with mock data", { speed_km_per_h = runif(60, 10, 20), activity_type = "Run" ) - + p7 <- plot_pbs(pbs_df = pbs_data) expect_s3_class(p7, "gg") - + p8 <- plot_pbs(pbs_df = pbs_data, add_trend_line = FALSE) expect_s3_class(p8, "gg") - + p9 <- plot_pbs(pbs_df = pbs_data, date_range = c(Sys.Date() - 150, Sys.Date() - 30)) expect_s3_class(p9, "gg") }) @@ -305,18 +313,23 @@ test_that("edge cases", { average_heartrate = 150, average_speed = 10 ) - - result <- tryCatch({ - calculate_ef(empty_act, activity_type = "Run", ef_metric = "pace_hr", - start_date = Sys.Date() - 10, end_date = Sys.Date()) - }, error = function(e) { - expect_true(TRUE) # Error is expected - data.frame() - }, warning = function(w) { - expect_true(TRUE) # Warning is also acceptable - data.frame() - }) - - expect_true(TRUE) # Test passed if we got here -}) + result <- tryCatch( + { + calculate_ef(empty_act, + activity_type = "Run", ef_metric = "pace_hr", + start_date = Sys.Date() - 10, end_date = Sys.Date() + ) + }, + error = function(e) { + expect_true(TRUE) # Error is expected + data.frame() + }, + warning = function(w) { + expect_true(TRUE) # Warning is also acceptable + data.frame() + } + ) + + expect_true(TRUE) # Test passed if we got here +}) diff --git a/tests/testthat/test-uncovered-branches.R b/tests/testthat/test-uncovered-branches.R index 59f5716..5a02d03 100644 --- a/tests/testthat/test-uncovered-branches.R +++ b/tests/testthat/test-uncovered-branches.R @@ -17,12 +17,12 @@ test_that("parse_activity_file with unsupported format", { # Line 55-56: Unsupported file format temp_file <- tempfile(fileext = ".unknown") writeLines("test", temp_file) - + expect_warning( result <- Athlytics:::parse_activity_file(temp_file), "Unsupported file format" ) - + unlink(temp_file) }) @@ -31,24 +31,28 @@ test_that("parse_activity_file with .gz compression", { # Create a simple text file and compress it temp_txt <- tempfile(fileext = ".txt") writeLines("test content", temp_txt) - + temp_gz <- paste0(temp_txt, ".gz") - + # Compress the file if R.utils is available if (requireNamespace("R.utils", quietly = TRUE)) { R.utils::gzip(temp_txt, destname = temp_gz, remove = FALSE) - + # Try to parse (will fail but covers the decompression branch) - result <- tryCatch({ - Athlytics:::parse_activity_file(temp_gz) - }, error = function(e) NULL, warning = function(w) NULL) - + result <- tryCatch( + { + Athlytics:::parse_activity_file(temp_gz) + }, + error = function(e) NULL, + warning = function(w) NULL + ) + # Clean up unlink(temp_txt) unlink(temp_gz) } - - expect_true(TRUE) # Test passed if we got here + + expect_true(TRUE) # Test passed if we got here }) test_that("parse_fit_file without FITfileR package", { @@ -57,14 +61,14 @@ test_that("parse_fit_file without FITfileR package", { # This tests the package check branch temp_fit <- tempfile(fileext = ".fit") writeLines("fake fit data", temp_fit) - + # Temporarily unload FITfileR if loaded if ("package:FITfileR" %in% search()) { detach("package:FITfileR", unload = TRUE) } - + result <- Athlytics:::parse_fit_file(temp_fit) - + unlink(temp_fit) expect_true(TRUE) }) @@ -74,14 +78,14 @@ test_that("parse_tcx_file without XML package", { # Line 109-112: XML not available warning temp_tcx <- tempfile(fileext = ".tcx") writeLines("test", temp_tcx) - + # Temporarily unload XML if loaded if ("package:XML" %in% search()) { detach("package:XML", unload = TRUE) } - + result <- Athlytics:::parse_tcx_file(temp_tcx) - + unlink(temp_tcx) expect_true(TRUE) }) @@ -93,15 +97,15 @@ test_that("load_local_activities with empty ZIP", { temp_zip <- tempfile(fileext = ".zip") temp_txt <- tempfile(fileext = ".txt") writeLines("test", temp_txt) - + # Create a ZIP without activities.csv utils::zip(temp_zip, temp_txt, flags = "-q") - + expect_error( load_local_activities(temp_zip), "No activities.csv file found in ZIP" ) - + unlink(temp_zip) unlink(temp_txt) }) @@ -109,38 +113,41 @@ test_that("load_local_activities with empty ZIP", { test_that("load_local_activities with multiple activities.csv in ZIP", { # Line 117-120: Multiple activities.csv warning temp_zip <- tempfile(fileext = ".zip") - + # Create two CSV files temp_csv1 <- tempfile(fileext = "activities.csv") temp_csv2 <- tempfile(fileext = "ACTIVITIES.CSV") - + writeLines("Activity ID,Activity Date,Activity Type,Distance,Elapsed Time,Moving Time,Elevation Gain", temp_csv1) writeLines("Activity ID,Activity Date,Activity Type,Distance,Elapsed Time,Moving Time,Elevation Gain", temp_csv2) - + # Create ZIP with both files old_wd <- getwd() - tryCatch({ - temp_dir <- tempdir() - file.copy(temp_csv1, file.path(temp_dir, "activities.csv")) - file.copy(temp_csv2, file.path(temp_dir, "ACTIVITIES.CSV")) - - setwd(temp_dir) - utils::zip(temp_zip, c("activities.csv", "ACTIVITIES.CSV"), flags = "-q") - setwd(old_wd) - - # Should warn about multiple files - expect_warning( - result <- load_local_activities(temp_zip), - "Multiple activities.csv files found" - ) - - # Clean up - unlink(file.path(temp_dir, "activities.csv")) - unlink(file.path(temp_dir, "ACTIVITIES.CSV")) - }, error = function(e) { - setwd(old_wd) - }) - + tryCatch( + { + temp_dir <- tempdir() + file.copy(temp_csv1, file.path(temp_dir, "activities.csv")) + file.copy(temp_csv2, file.path(temp_dir, "ACTIVITIES.CSV")) + + setwd(temp_dir) + utils::zip(temp_zip, c("activities.csv", "ACTIVITIES.CSV"), flags = "-q") + setwd(old_wd) + + # Should warn about multiple files + expect_warning( + result <- load_local_activities(temp_zip), + "Multiple activities.csv files found" + ) + + # Clean up + unlink(file.path(temp_dir, "activities.csv")) + unlink(file.path(temp_dir, "ACTIVITIES.CSV")) + }, + error = function(e) { + setwd(old_wd) + } + ) + unlink(temp_zip) unlink(temp_csv1) unlink(temp_csv2) @@ -150,14 +157,14 @@ test_that("load_local_activities with empty CSV", { # Line 143-150: Empty CSV warning temp_csv <- tempfile(fileext = ".csv") writeLines("Activity ID,Activity Date,Activity Type,Distance,Elapsed Time,Moving Time,Elevation Gain", temp_csv) - + expect_warning( result <- load_local_activities(temp_csv), "No activities found in CSV file" ) - + expect_equal(nrow(result), 0) - + unlink(temp_csv) }) @@ -167,36 +174,39 @@ test_that("calculate_ef stream data branches", { base_dir <- "C:/Users/Ang/Documents/GitHub/Athlytics" csv_path <- file.path(base_dir, "export_data", "activities.csv") export_dir <- file.path(base_dir, "export_data") - + if (!file.exists(csv_path) || !dir.exists(export_dir)) { skip("Real data not available") } - + act <- load_local_activities(csv_path) act_files <- act[!is.na(act$filename) & nchar(act$filename) > 0, ] - + if (nrow(act_files) < 15) { skip("Not enough activities with files") } - + # Test with export_dir to trigger stream parsing branches # This should hit various internal branches in calculate_ef_from_stream for (i in 1:min(15, nrow(act_files))) { - ef <- tryCatch({ - calculate_ef( - act_files[i, ], - activity_type = act_files$type[i], - ef_metric = "pace_hr", - export_dir = export_dir, - quality_control = "filter", - min_duration_mins = 5, - min_steady_minutes = 5, - steady_cv_threshold = 0.15, - min_hr_coverage = 0.7 - ) - }, error = function(e) data.frame()) + ef <- tryCatch( + { + calculate_ef( + act_files[i, ], + activity_type = act_files$type[i], + ef_metric = "pace_hr", + export_dir = export_dir, + quality_control = "filter", + min_duration_mins = 5, + min_steady_minutes = 5, + steady_cv_threshold = 0.15, + min_hr_coverage = 0.7 + ) + }, + error = function(e) data.frame() + ) } - + expect_true(TRUE) }) @@ -206,7 +216,7 @@ test_that("plot_ef with various data conditions", { if (!requireNamespace("ggplot2", quietly = TRUE)) { skip("ggplot2 not available") } - + # Test with very sparse data sparse_runs <- data.frame( id = 1:3, @@ -219,11 +229,11 @@ test_that("plot_ef with various data conditions", { average_heartrate = c(150, 148, 152), average_speed = c(10, 10.2, 9.8) ) - + # Should handle sparse data p1 <- plot_ef(sparse_runs, activity_type = "Run", ef_metric = "pace_hr") expect_s3_class(p1, "gg") - + # Test with all smoothing methods denser_runs <- data.frame( id = 1:30, @@ -236,13 +246,18 @@ test_that("plot_ef with various data conditions", { average_heartrate = runif(30, 130, 160), average_speed = runif(30, 9, 13) ) - + for (method in c("loess", "lm", "gam", "glm")) { - p <- tryCatch({ - plot_ef(denser_runs, activity_type = "Run", ef_metric = "pace_hr", - smoothing_method = method) - }, error = function(e) NULL) - + p <- tryCatch( + { + plot_ef(denser_runs, + activity_type = "Run", ef_metric = "pace_hr", + smoothing_method = method + ) + }, + error = function(e) NULL + ) + if (!is.null(p)) { expect_s3_class(p, "gg") } @@ -253,7 +268,7 @@ test_that("plot_pbs with various data densities", { if (!requireNamespace("ggplot2", quietly = TRUE)) { skip("ggplot2 not available") } - + # Very sparse sparse_pbs <- data.frame( activity_id = 1:5, @@ -265,19 +280,21 @@ test_that("plot_pbs with various data densities", { speed_km_per_h = runif(5, 12, 15), activity_type = "Run" ) - + p1 <- plot_pbs(pbs_df = sparse_pbs) expect_s3_class(p1, "gg") - + p2 <- plot_pbs(pbs_df = sparse_pbs, add_trend_line = TRUE) expect_s3_class(p2, "gg") - + p3 <- plot_pbs(pbs_df = sparse_pbs, add_trend_line = FALSE) expect_s3_class(p3, "gg") - + # With date_range - p4 <- plot_pbs(pbs_df = sparse_pbs, - date_range = c(Sys.Date() - 180, Sys.Date() - 20)) + p4 <- plot_pbs( + pbs_df = sparse_pbs, + date_range = c(Sys.Date() - 180, Sys.Date() - 20) + ) expect_s3_class(p4, "gg") }) @@ -287,13 +304,13 @@ test_that("calculate functions with invalid data structures", { # Test various invalid inputs expect_error(calculate_acwr(data.frame(x = 1))) expect_error(calculate_ef(data.frame(x = 1), activity_type = "Run", ef_metric = "pace_hr")) - + # Test with data frame missing required columns incomplete_df <- data.frame( id = 1:10, date = seq(Sys.Date() - 20, Sys.Date(), length.out = 10) ) - + expect_error(calculate_acwr(incomplete_df, activity_type = "Run")) }) @@ -306,16 +323,19 @@ test_that("cohort_reference with insufficient data", { date = seq(Sys.Date() - 30, Sys.Date() - 1, by = "day"), metric_value = runif(30, 0.8, 1.5) ) - + # Should either error or return empty result - result <- tryCatch({ - cohort_reference(small_cohort, metric = "metric_value", min_athletes = 10) - }, error = function(e) { - expect_true(TRUE) # Error is expected - data.frame() - }) - - expect_true(TRUE) # Test passed + result <- tryCatch( + { + calculate_cohort_reference(small_cohort, metric = "metric_value", min_athletes = 10) + }, + error = function(e) { + expect_true(TRUE) # Error is expected + data.frame() + } + ) + + expect_true(TRUE) # Test passed }) # ========== Quality control branches ========== @@ -330,7 +350,7 @@ test_that("flag_quality with various data patterns", { cadence = rnorm(500, 85, 8), speed = runif(500, 2.5, 3.5) ) - + streams_bad <- data.frame( time = 1:500, distance = seq(0, 5000, length.out = 500), @@ -339,24 +359,23 @@ test_that("flag_quality with various data patterns", { cadence = c(rnorm(400, 85, 8), rep(200, 100)), speed = c(runif(400, 2.5, 3.5), rep(20, 100)) ) - + # Test with both Run and Ride flag_run_good <- flag_quality(streams_good, sport = "Run") flag_run_bad <- flag_quality(streams_bad, sport = "Run") flag_ride_good <- flag_quality(streams_good, sport = "Ride") flag_ride_bad <- flag_quality(streams_bad, sport = "Ride") - + expect_s3_class(flag_run_good, "data.frame") expect_s3_class(flag_run_bad, "data.frame") expect_s3_class(flag_ride_good, "data.frame") expect_s3_class(flag_ride_bad, "data.frame") - + # Test quality_summary - sum_good <- quality_summary(flag_run_good) - sum_bad <- quality_summary(flag_run_bad) - + sum_good <- summarize_quality(flag_run_good) + sum_bad <- summarize_quality(flag_run_bad) + expect_type(sum_good, "list") expect_type(sum_bad, "list") expect_true(sum_bad$flagged_points > sum_good$flagged_points) }) - diff --git a/tests/testthat/test-utils-extended.R b/tests/testthat/test-utils-extended.R index 08d8eab..565ee6e 100644 --- a/tests/testthat/test-utils-extended.R +++ b/tests/testthat/test-utils-extended.R @@ -5,7 +5,7 @@ library(Athlytics) test_that("utils functions exist and work", { # Test any utility functions that might exist - expect_true(TRUE) # Placeholder if no specific utils to test + expect_true(TRUE) # Placeholder if no specific utils to test }) test_that("package loads without errors", { @@ -13,17 +13,17 @@ test_that("package loads without errors", { }) test_that("sample data exists", { - data("athlytics_sample_acwr", package = "Athlytics") - data("athlytics_sample_ef", package = "Athlytics") - data("athlytics_sample_exposure", package = "Athlytics") - data("athlytics_sample_decoupling", package = "Athlytics") - data("athlytics_sample_pbs", package = "Athlytics") - - expect_true(!is.null(athlytics_sample_acwr)) - expect_true(!is.null(athlytics_sample_ef)) - expect_true(!is.null(athlytics_sample_exposure)) - expect_true(!is.null(athlytics_sample_decoupling)) - expect_true(!is.null(athlytics_sample_pbs)) + data("sample_acwr", package = "Athlytics") + data("sample_ef", package = "Athlytics") + data("sample_exposure", package = "Athlytics") + data("sample_decoupling", package = "Athlytics") + data("sample_pbs", package = "Athlytics") + + expect_true(!is.null(sample_acwr)) + expect_true(!is.null(sample_ef)) + expect_true(!is.null(sample_exposure)) + expect_true(!is.null(sample_decoupling)) + expect_true(!is.null(sample_pbs)) }) test_that("color palettes are accessible", { @@ -32,13 +32,13 @@ test_that("color palettes are accessible", { vibrant <- athlytics_palette_vibrant() science <- athlytics_palette_science() cell <- athlytics_palette_cell() - + expect_true(is.character(nature)) expect_true(is.character(academic)) expect_true(is.character(vibrant)) expect_true(is.character(science)) expect_true(is.character(cell)) - + expect_gt(length(nature), 0) expect_gt(length(academic), 0) expect_gt(length(vibrant), 0) @@ -50,11 +50,11 @@ test_that("color zone functions work", { acwr_zones <- athlytics_colors_acwr_zones() training_load <- athlytics_colors_training_load() ef_colors <- athlytics_colors_ef() - + expect_true(is.list(acwr_zones)) expect_true(is.list(training_load)) expect_true(is.list(ef_colors)) - + expect_true(length(acwr_zones) > 0) expect_true(length(training_load) > 0) expect_true(length(ef_colors) > 0) @@ -62,61 +62,60 @@ test_that("color zone functions work", { test_that("theme_athlytics works", { skip_if_not_installed("ggplot2") - + theme <- theme_athlytics() expect_s3_class(theme, "theme") - + # Test with different base sizes theme_small <- theme_athlytics(base_size = 10) expect_s3_class(theme_small, "theme") - + theme_large <- theme_athlytics(base_size = 14) expect_s3_class(theme_large, "theme") }) test_that("scale_athlytics works for different palettes", { skip_if_not_installed("ggplot2") - + # Test different palettes scale_nature <- scale_athlytics("nature", type = "color") expect_s3_class(scale_nature, "ScaleDiscrete") - + scale_academic <- scale_athlytics("academic", type = "fill") expect_s3_class(scale_academic, "ScaleDiscrete") - + scale_vibrant <- scale_athlytics("vibrant", type = "color") expect_s3_class(scale_vibrant, "ScaleDiscrete") - + scale_science <- scale_athlytics("science", type = "fill") expect_s3_class(scale_science, "ScaleDiscrete") - + scale_cell <- scale_athlytics("cell", type = "color") expect_s3_class(scale_cell, "ScaleDiscrete") }) test_that("scale_athlytics handles invalid palette names", { skip_if_not_installed("ggplot2") - + # Should default to nature palette scale_default <- scale_athlytics("invalid_name", type = "color") expect_s3_class(scale_default, "ScaleDiscrete") }) test_that("package datasets are properly formatted", { - data("athlytics_sample_acwr", package = "Athlytics") - - expect_s3_class(athlytics_sample_acwr, "data.frame") - expect_true("date" %in% names(athlytics_sample_acwr)) - expect_true("acwr" %in% names(athlytics_sample_acwr) || "acwr_smooth" %in% names(athlytics_sample_acwr)) + data("sample_acwr", package = "Athlytics") + + expect_s3_class(sample_acwr, "data.frame") + expect_true("date" %in% names(sample_acwr)) + expect_true("acwr" %in% names(sample_acwr) || "acwr_smooth" %in% names(sample_acwr)) }) test_that("plot functions handle sample data", { skip_if_not_installed("ggplot2") - - data("athlytics_sample_acwr", package = "Athlytics") - - # Test that plot can be created - p <- plot_acwr(athlytics_sample_acwr) + + data("sample_acwr", package = "Athlytics") + + # Test that plot can be created + p <- plot_acwr(sample_acwr) expect_s3_class(p, "ggplot") }) - diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 9fef4a1..62b8f37 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -22,11 +22,11 @@ test_that("english_month_year correctly formats dates", { # Test with a leap year date leap_date <- ymd("2024-02-29") expect_equal(Athlytics:::english_month_year(leap_date), "Feb 2024") - + # Test with an empty vector of dates (should return empty character vector) empty_dates <- ymd(character(0)) expect_equal(Athlytics:::english_month_year(empty_dates), character(0)) - + # Test with NA date # expect_equal(Athlytics:::english_month_year(ymd(NA)), NA_character_) -}) +}) diff --git a/vignettes/advanced_features.Rmd b/vignettes/advanced_features.Rmd index 2af7094..6b352d1 100644 --- a/vignettes/advanced_features.Rmd +++ b/vignettes/advanced_features.Rmd @@ -51,17 +51,17 @@ stream_data <- parse_activity_file("path/to/activity.fit") flagged_data <- flag_quality( stream_data, sport = "Run", - hr_range = c(30, 220), # Valid HR range - pw_range = c(0, 1500), # Valid power range - max_run_speed = 7.0, # Max speed (m/s) ≈ 2:23/km pace - max_hr_jump = 10, # Max HR change per second - max_pw_jump = 300, # Max power change per second - min_steady_minutes = 20, # Min duration for steady-state - steady_cv_threshold = 8 # CV% threshold for steady-state + hr_range = c(30, 220), # Valid HR range + pw_range = c(0, 1500), # Valid power range + max_run_speed = 7.0, # Max speed (m/s) ≈ 2:23/km pace + max_hr_jump = 10, # Max HR change per second + max_pw_jump = 300, # Max power change per second + min_steady_minutes = 20, # Min duration for steady-state + steady_cv_threshold = 8 # CV% threshold for steady-state ) # View quality summary -summary_stats <- quality_summary(flagged_data) +summary_stats <- summarize_quality(flagged_data) print(summary_stats) ``` @@ -112,21 +112,27 @@ acwr_ewma <- calculate_acwr_ewma( activities, activity_type = "Run", method = "ewma", - half_life_acute = 3.5, # Acute load half-life (days) - half_life_chronic = 14, # Chronic load half-life (days) + half_life_acute = 3.5, # Acute load half-life (days) + half_life_chronic = 14, # Chronic load half-life (days) load_metric = "duration_mins" ) # Compare the two methods library(ggplot2) ggplot() + - geom_line(data = acwr_ra, aes(x = date, y = acwr_smooth), - color = "blue", size = 1, linetype = "solid") + - geom_line(data = acwr_ewma, aes(x = date, y = acwr_smooth), - color = "red", size = 1, linetype = "dashed") + - labs(title = "ACWR: Rolling Average vs EWMA", - subtitle = "Blue = RA (7:28d) | Red = EWMA (3.5:14d half-life)", - x = "Date", y = "ACWR") + + geom_line( + data = acwr_ra, aes(x = date, y = acwr_smooth), + color = "blue", size = 1, linetype = "solid" + ) + + geom_line( + data = acwr_ewma, aes(x = date, y = acwr_smooth), + color = "red", size = 1, linetype = "dashed" + ) + + labs( + title = "ACWR: Rolling Average vs EWMA", + subtitle = "Blue = RA (7:28d) | Red = EWMA (3.5:14d half-life)", + x = "Date", y = "ACWR" + ) + theme_minimal() ``` @@ -147,22 +153,25 @@ acwr_ewma_ci <- calculate_acwr_ewma( half_life_acute = 3.5, half_life_chronic = 14, load_metric = "duration_mins", - ci = TRUE, # Enable confidence intervals - B = 200, # Bootstrap iterations - block_len = 7, # Block length (days) for bootstrap - conf_level = 0.95 # 95% CI + ci = TRUE, # Enable confidence intervals + B = 200, # Bootstrap iterations + block_len = 7, # Block length (days) for bootstrap + conf_level = 0.95 # 95% CI ) # Plot with confidence bands ggplot(acwr_ewma_ci, aes(x = date)) + - geom_ribbon(aes(ymin = acwr_lower, ymax = acwr_upper), - fill = "gray70", alpha = 0.5) + + geom_ribbon(aes(ymin = acwr_lower, ymax = acwr_upper), + fill = "gray70", alpha = 0.5 + ) + geom_line(aes(y = acwr_smooth), color = "black", size = 1) + geom_hline(yintercept = c(0.8, 1.3), linetype = "dotted", color = "green") + geom_hline(yintercept = 1.5, linetype = "dotted", color = "red") + - labs(title = "ACWR with 95% Confidence Bands", - subtitle = "Gray band = bootstrap confidence interval", - x = "Date", y = "ACWR") + + labs( + title = "ACWR with 95% Confidence Bands", + subtitle = "Gray band = bootstrap confidence interval", + x = "Date", y = "ACWR" + ) + theme_minimal() ``` @@ -217,12 +226,12 @@ cohort_acwr <- cohort_data %>% ```{r eval=FALSE} # Calculate cohort reference by sport and sex -reference <- cohort_reference( +reference <- calculate_cohort_reference( cohort_acwr, metric = "acwr_smooth", - by = c("sport", "sex"), # Group by sport and sex - probs = c(0.05, 0.25, 0.5, 0.75, 0.95), # Percentiles - min_athletes = 3 # Minimum athletes per group + by = c("sport", "sex"), # Group by sport and sex + probs = c(0.05, 0.25, 0.5, 0.75, 0.95), # Percentiles + min_athletes = 3 # Minimum athletes per group ) # View reference structure @@ -245,13 +254,13 @@ head(reference) ```{r eval=FALSE} # Extract one athlete's data -individual <- cohort_acwr %>% +individual <- cohort_acwr %>% filter(athlete_id == "athlete1") # Plot with cohort reference p <- plot_with_reference( individual = individual, - reference = reference %>% filter(sex == "M"), # Match athlete's group + reference = reference %>% filter(sex == "M"), # Match athlete's group metric = "acwr_smooth", bands = c("p25_p75", "p05_p95", "p50") ) @@ -304,12 +313,12 @@ cohort_acwr <- cohort_data %>% half_life_chronic = 14, load_metric = "duration_mins", ci = TRUE, - B = 100 # Reduced for speed in example + B = 100 # Reduced for speed in example )) %>% ungroup() # --- Step 4: Calculate cohort reference --- -reference <- cohort_reference( +reference <- calculate_cohort_reference( cohort_acwr, metric = "acwr_smooth", by = c("sport"), @@ -322,9 +331,11 @@ individual <- cohort_acwr %>% filter(athlete_id == "athlete1") p <- plot_with_reference(individual, reference, metric = "acwr_smooth") + # Add individual's confidence bands - geom_ribbon(data = individual, - aes(x = date, ymin = acwr_lower, ymax = acwr_upper), - fill = "blue", alpha = 0.2) + geom_ribbon( + data = individual, + aes(x = date, ymin = acwr_lower, ymax = acwr_upper), + fill = "blue", alpha = 0.2 + ) print(p) diff --git a/vignettes/athlytics_introduction.Rmd b/vignettes/athlytics_introduction.Rmd index a753c25..f3a53cb 100644 --- a/vignettes/athlytics_introduction.Rmd +++ b/vignettes/athlytics_introduction.Rmd @@ -16,6 +16,8 @@ knitr::opts_chunk$set( fig.width = 7, fig.height = 5 ) +library(Athlytics) +library(ggplot2) ``` # Welcome to Athlytics @@ -46,12 +48,12 @@ For installation instructions, see the [README](https://github.com/HzaCode/Athly install.packages("Athlytics") # GitHub (latest features) -remotes::install_github('HzaCode/Athlytics') +remotes::install_github("HzaCode/Athlytics") ``` ## Your Strava Data Export -You'll need a Strava data export ZIP file. If you haven't exported your data yet, see the [Strava Export Guide](https://support.strava.com/hc/en-us/articles/216918437-Exporting-your-Data-and-Bulk-Export) or follow the steps in the [README Quick Start](https://github.com/HzaCode/Athlytics#quick-start). +You'll need a Strava data export ZIP file. If you haven't exported your data yet, start from [Strava](https://www.strava.com/) and follow the steps in the [README Quick Start](https://github.com/HzaCode/Athlytics#quick-start). **Quick Summary:** 1. Go to Strava Settings → My Account → Download or Delete Your Account @@ -68,7 +70,7 @@ You'll need a Strava data export ZIP file. If you haven't exported your data yet ```{r eval=FALSE} library(Athlytics) -library(dplyr) # For data manipulation +library(dplyr) # For data manipulation # Load your activities activities <- load_local_activities("path/to/export_12345678.zip") @@ -128,7 +130,7 @@ sum(!is.na(activities$avg_hr)) / nrow(activities) * 100 # Shows % of activities with HR data # Activities without HR data -activities %>% +activities %>% filter(is.na(avg_hr)) %>% count(sport) ``` @@ -141,21 +143,23 @@ For focused analysis, you'll often want to filter by sport or date: ```{r eval=FALSE} # Only running activities -runs <- activities %>% +runs <- activities %>% filter(sport == "Run") # Recent activities (last 6 months) -recent <- activities %>% +recent <- activities %>% filter(date >= Sys.Date() - 180) # Runs with heart rate data from 2024 -runs_2024_hr <- activities %>% - filter(sport == "Run", - !is.na(avg_hr), - lubridate::year(date) == 2024) +runs_2024_hr <- activities %>% + filter( + sport == "Run", + !is.na(avg_hr), + lubridate::year(date) == 2024 + ) # Long runs only (> 15 km) -long_runs <- activities %>% +long_runs <- activities %>% filter(sport == "Run", distance_km > 15) ``` @@ -186,10 +190,10 @@ The Acute:Chronic Workload Ratio (ACWR) compares your recent training (acute loa # Calculate ACWR for all running activities acwr_data <- calculate_acwr( activities_data = runs, - activity_type = "Run", # Filter by sport + activity_type = "Run", # Filter by sport load_metric = "duration_mins", # Can also be "distance_km" or "hrss" - acute_period = 7, # 7-day rolling average - chronic_period = 28 # 28-day rolling average + acute_period = 7, # 7-day rolling average + chronic_period = 28 # 28-day rolling average ) # View results @@ -214,6 +218,16 @@ plot_acwr(acwr_data) plot_acwr(acwr_data, highlight_zones = TRUE) ``` +**Demo with Sample Data:** + +```{r acwr-demo, fig.cap="ACWR visualization using sample data"} +# Load built-in sample data +data("sample_acwr", package = "Athlytics") + +# Plot ACWR with risk zones +plot_acwr(sample_acwr, highlight_zones = TRUE) +``` + ### Interpreting Your ACWR **What to look for:** @@ -253,7 +267,7 @@ Different load metrics for different goals: # Calculate using HRSS (heart rate stress score) acwr_hrss <- calculate_acwr( activities_data = runs, - load_metric = "hrss" # Automatically calculated if avg_hr available + load_metric = "hrss" # Automatically calculated if avg_hr available ) ``` @@ -283,7 +297,7 @@ Efficiency Factor measures how much output (speed/power) you generate per unit o ef_runs <- calculate_ef( activities_data = runs, activity_type = "Run", - ef_metric = "pace_hr" # Pace divided by HR + ef_metric = "pace_hr" # Pace divided by HR ) # For cycling (Power/HR) @@ -291,7 +305,7 @@ rides <- activities %>% filter(sport == "Ride") ef_cycling <- calculate_ef( activities_data = rides, activity_type = "Ride", - ef_metric = "power_hr" # Power divided by HR + ef_metric = "power_hr" # Power divided by HR ) # View results @@ -315,6 +329,16 @@ plot_ef(ef_runs) plot_ef(ef_runs, add_trend_line = TRUE) ``` +**Demo with Sample Data:** + +```{r ef-demo, fig.cap="Efficiency Factor trend using sample data"} +# Load built-in sample data +data("sample_ef", package = "Athlytics") + +# Plot EF with trend line +plot_ef(sample_ef, add_trend_line = TRUE) +``` + ### Interpreting EF **Best Practices:** @@ -341,13 +365,19 @@ ef_monthly <- ef_runs %>% print(ef_monthly) # Compare first vs last 3 months -recent_ef <- ef_runs %>% filter(date >= Sys.Date() - 90) %>% pull(ef_value) -baseline_ef <- ef_runs %>% filter(date < Sys.Date() - 90, date >= Sys.Date() - 180) %>% pull(ef_value) - -cat(sprintf("Recent EF: %.2f\nBaseline EF: %.2f\nChange: %.1f%%\n", - mean(recent_ef, na.rm = TRUE), - mean(baseline_ef, na.rm = TRUE), - (mean(recent_ef, na.rm = TRUE) / mean(baseline_ef, na.rm = TRUE) - 1) * 100)) +recent_ef <- ef_runs %>% + filter(date >= Sys.Date() - 90) %>% + pull(ef_value) +baseline_ef <- ef_runs %>% + filter(date < Sys.Date() - 90, date >= Sys.Date() - 180) %>% + pull(ef_value) + +cat(sprintf( + "Recent EF: %.2f\nBaseline EF: %.2f\nChange: %.1f%%\n", + mean(recent_ef, na.rm = TRUE), + mean(baseline_ef, na.rm = TRUE), + (mean(recent_ef, na.rm = TRUE) / mean(baseline_ef, na.rm = TRUE) - 1) * 100 +)) ``` --- @@ -382,7 +412,7 @@ decoupling_runs <- calculate_decoupling( activities_data = runs, activity_type = "Run", decouple_metric = "pace_hr", - min_duration_mins = 60 # Only analyze runs ≥ 60 minutes + min_duration_mins = 60 # Only analyze runs ≥ 60 minutes ) # For cycling @@ -390,7 +420,7 @@ decoupling_rides <- calculate_decoupling( activities_data = rides, activity_type = "Ride", decouple_metric = "power_hr", - min_duration_mins = 90 # Longer threshold for cycling + min_duration_mins = 90 # Longer threshold for cycling ) # View results @@ -414,6 +444,16 @@ plot_decoupling(decoupling_runs) plot_decoupling(decoupling_runs, decouple_metric = "pace_hr") ``` +**Demo with Sample Data:** + +```{r decoupling-demo, fig.cap="Cardiovascular decoupling using sample data"} +# Load built-in sample data +data("sample_decoupling", package = "Athlytics") + +# Plot decoupling trend (use decoupling_df parameter) +plot_decoupling(decoupling_df = sample_decoupling) +``` + ### Practical Applications **1. Assess Aerobic Base:** @@ -445,9 +485,11 @@ decoupling_runs %>% geom_smooth(method = "loess", se = TRUE) + geom_hline(yintercept = 5, linetype = "dashed", color = "green") + geom_hline(yintercept = 10, linetype = "dashed", color = "orange") + - labs(title = "Decoupling Trend Over Time", - subtitle = "Lower values = better aerobic endurance", - x = "Date", y = "Decoupling (%)") + + labs( + title = "Decoupling Trend Over Time", + subtitle = "Lower values = better aerobic endurance", + x = "Date", y = "Decoupling (%)" + ) + theme_minimal() ``` @@ -489,6 +531,16 @@ pbs_5k <- pbs %>% filter(distance == "5k") print(pbs_5k) ``` +**Demo with Sample Data:** + +```{r pbs-demo, fig.cap="Personal bests progression using sample data"} +# Load built-in sample data +data("sample_pbs", package = "Athlytics") + +# Plot PB progression (use pbs_df parameter) +plot_pbs(pbs_df = sample_pbs) +``` + --- ## 5. Load Exposure Analysis @@ -509,6 +561,16 @@ exposure <- calculate_exposure( plot_exposure(exposure, highlight_zones = TRUE) ``` +**Demo with Sample Data:** + +```{r exposure-demo, fig.cap="Load exposure analysis using sample data"} +# Load built-in sample data +data("sample_exposure", package = "Athlytics") + +# Plot exposure (use exposure_df parameter) +plot_exposure(exposure_df = sample_exposure, activity_type = "Run") +``` + **Interpretation:** - **Points above diagonal** = Acute > chronic (ramping up training) @@ -531,7 +593,7 @@ library(ggplot2) activities <- load_local_activities("my_strava_export.zip") # Focus on running activities with HR data -runs <- activities %>% +runs <- activities %>% filter(sport == "Run", !is.na(avg_hr)) cat(sprintf("Loaded %d running activities with HR data\n", nrow(runs))) @@ -543,7 +605,7 @@ acwr_data <- calculate_acwr( ) # Check current training status -current_acwr <- acwr_data %>% +current_acwr <- acwr_data %>% filter(date >= Sys.Date() - 30) %>% tail(1) %>% pull(acwr_smooth) @@ -579,10 +641,13 @@ decoupling_data <- calculate_decoupling( ) avg_decouple <- mean(decoupling_data$decoupling_pct, na.rm = TRUE) -cat(sprintf("Average decoupling: %.1f%% (%s aerobic base)\n", - avg_decouple, - ifelse(avg_decouple < 5, "excellent", - ifelse(avg_decouple < 10, "good", "needs work")))) +cat(sprintf( + "Average decoupling: %.1f%% (%s aerobic base)\n", + avg_decouple, + ifelse(avg_decouple < 5, "excellent", + ifelse(avg_decouple < 10, "good", "needs work") + ) +)) p3 <- plot_decoupling(decoupling_data) + labs(title = "Cardiovascular Drift in Long Runs") @@ -687,7 +752,7 @@ Ready to go deeper? Check out: If you're using Athlytics for research: -1. **Cohort Studies**: See [cohort_reference()](../reference/cohort_reference.html) for multi-athlete percentile comparisons +1. **Cohort Studies**: See [calculate_cohort_reference()](../reference/calculate_cohort_reference.html) for multi-athlete percentile comparisons 2. **Data Quality**: Use [flag_quality()](../reference/flag_quality.html) for stream data quality control 3. **Statistical Analysis**: All functions return tidy data frames ready for lme4, survival analysis, etc. From 98c50d5d2141bae6e43d065b84f93ec250aea680 Mon Sep 17 00:00:00 2001 From: Ang Date: Sat, 17 Jan 2026 05:56:13 +0800 Subject: [PATCH 2/2] fix: update _pkgdown.yml for renamed sample datasets and functions --- _pkgdown.yml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index b646f9c..6b3772c 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -50,10 +50,10 @@ reference: - title: Advanced Analysis desc: Cohort analysis and quality control contents: - - cohort_reference + - calculate_cohort_reference - add_reference_bands - flag_quality - - quality_summary + - summarize_quality - title: Themes and Colors desc: Visualization customization @@ -66,7 +66,11 @@ reference: - title: Sample Data desc: Example datasets for testing and learning contents: - - starts_with("athlytics_sample") + - sample_acwr + - sample_decoupling + - sample_ef + - sample_exposure + - sample_pbs articles: - title: Getting Started