add other exercises, restructure dataframes

Author: fabian-s

R/bodyweight.R

@@ -1,22 +1,36 @@
-#' Bicycle Crunch data
+#' Bodyweight Exercise Data
 #'
 #' @description
-#' Sensor-based measurements and quality ratings of athletes performing the
-#' Bicycle Crunch exercise, recorded across multiple sets and repetitions.
+#' Sensor-based measurements and quality ratings of athletes performing different
+#' exercises, recorded across multiple sets and repetitions at different locations
+#' on their bodies.
+#'
+#' Argument values for acceleration and rotation are in ms since start of the repetition.
+#'
+#' The data sets / exercises are:
+#'
+#'  - `bi`: "Bicycle Crunch" (one rep is left side - right side),
+#'  - `cr`: "Crunch",
+#'  - `ha`: "Jumping Jack",
+#'  - `kn`: "Squat",
+#'  - `lu`: "Lunge",
+#'  - `mo`: "Mountain Climber"
 #'
 #' @source <https://github.com/andrebert/body-weight-exercises>
 #' @references `r format_bib("ebert2018open")`
-#' @format A tibble with 20,760 rows and 8 variables:
+#' @format A tibble with 8 variables:
 #' \describe{
 #'   \item{id}{ID of the athlete.}
+#'   \item{ex}{exercise type}
 #'   \item{set}{The set number of the exercise.}
 #'   \item{loc}{Location of body extremity.}
-#'   \item{sens}{Indicator for acceleration (acc) or rotation (rot).}
-#'   \item{dim}{Dimension of rotation.}
-#'   \item{rep}{The number of repetitions.}
-#'   \item{rating}{Quality of their exercise sets within a range of 1 to 5.}
-#'   \item{activity}{The bicycle crunch activity.}
+#'   \item{dim}{Direction of rotation / acceleration}
+#'   \item{rep}{The count of the repetition.}
+#'   \item{acc}{Acceleration in \eqn{m/s^2}}
+#'   \item{rot}{Rotation in \eqn{rad/s}}
+#'   \item{rating}{Quality of the exercise (range of 1 (best) to 5)}
 #' }
+#' @aliases bodyweight bi cr ha kn lu mo
 #' @examples
-#' bodyweight
+#' tibble::glimpse(bi)
 "bodyweight"

data-raw/bodyweight.R

@@ -1,6 +1,9 @@
 library(dplyr)
 library(stringr)
 
+library(parallel)
+use_cores <- detectCores() - 2
+
 # source: https://github.com/andrebert/body-weight-exercises
 path <- "~/github/body-weight-exercises"
 files <- list.files(path, recursive = TRUE)
@@ -9,8 +12,11 @@ seg_files <- str_subset(files, "txt|INFO$", negate = TRUE)
 info_files <- str_subset(files, "INFO$")
 
 ratings <- lapply(file.path(path, info_files), function(file) {
-  readr::read_delim(file,
-    delim = ":", col_names = c("name", "value"), show_col_types = FALSE
+  readr::read_delim(
+    file,
+    delim = ":",
+    col_names = c("name", "value"),
+    show_col_types = FALSE
   ) |>
     filter(name == "Rating") |>
     pull(value) |>
@@ -23,42 +29,83 @@ bodyweight <- seg_files |>
   str_split("/|-", simplify = TRUE) |>
   as_tibble(.name_repair = "minimal") |>
   setNames(c("id", "ex", "set", "loc", "sens", "dim", "rep")) |>
-  filter(ex == "bi") |>
-  mutate(id = as.integer(id), rep = as.integer(rep))
-
-bw_files <- str_subset(seg_files, "bi")
-bi_files <- file.path(path, bw_files)
+  # rm participants w/o segmented exercises and exercises that were not segmented
+  filter(!(id %in% c(5, 9, 19)) & !(ex %in% c("", "li", "ru"))) |>
+  mutate(id = as.integer(id), rep = as.integer(rep), ex = factor(ex))
 
-bi <- lapply(bi_files, function(file) {
-  readr::read_table(file, col_names = FALSE, show_col_types = FALSE) |>
-    t() |>
+get_tfd <- function(files, label) {
+  f <- mclapply(
+    files,
+    function(file) {
+      readr::read_table(file, col_names = FALSE, show_col_types = FALSE) |>
+        t() |>
+        as_tibble(.name_repair = "minimal") |>
+        setNames(c("value", "arg")) |>
+        relocate(arg, value) |>
+        distinct(arg, .keep_all = TRUE)
+    },
+    mc.cores = use_cores
+  ) |>
+    tf::tfd()
+  files |>
+    str_remove(paste0(path, "/")) |>
+    str_split("/|-", simplify = TRUE) |>
     as_tibble(.name_repair = "minimal") |>
-    setNames(c("value", "arg")) |>
-    relocate(arg, value) |>
-    distinct(arg, .keep_all = TRUE)
-}) |>
-  tf::tfd()
+    setNames(c("id", "ex", "set", "loc", "sens", "dim", "rep")) |>
+    mutate("{{label}}" := f, rep = as.numeric(rep)) |>
+    select(-sens)
+}
 
-bi_ratings <- vapply(seq_len(nrow(bodyweight)), function(i) {
-  loc <- str_c(bodyweight[i, 1:3], collapse = "/")
-  rep <- bodyweight[i, "rep", drop = TRUE]
-  if (is.na(ratings[loc])) NA else ratings[[loc]][rep]
-}, numeric(1))
+get_ratings <- function(ex) {
+  ex_ratings <- ratings[str_detect(names(ratings), ex)]
+  str_split(names(ex_ratings), "/", simplify = TRUE) |>
+    as_tibble(.name_repair = "minimal") |>
+    setNames(c("id", "ex", "set")) |>
+    mutate(rating = ex_ratings) |>
+    unnest(cols = c(rating)) |>
+    group_by(id, ex, set) |>
+    mutate(rep = 1:n())
+}
 
-bodyweight <- bodyweight |>
-  mutate(
-    loc = factor(loc,
-      levels = c("TL", "TR", "BL", "BR", "CH"),
-      labels = c("left arm", "right arm", "left leg", "right leg", "chest")
-    ),
-    sens = factor(sens,
-      levels = c("acc", "rot"), labels = c("acceleration", "rotation")
-    ),
-    dim = as.factor(dim),
-    set = factor(set, levels = c("set1", "set2", "set3"), ordered = TRUE),
-    rating = bi_ratings,
-    activity = bi
-  ) |>
-  select(-ex)
+for (this_ex in levels(bodyweight$ex)) {
+  ex_filenames <- str_subset(seg_files, this_ex)
+  ex_files <- file.path(path, ex_filenames)
+  ex_acc_files <- str_subset(ex_files, "/acc-")
+  ex_rot_files <- str_subset(ex_files, "/rot-")
+  acc <- get_tfd(ex_acc_files, acc)
+  rot <- get_tfd(ex_rot_files, rot)
+  rating <- get_ratings(this_ex)
+  ex <- full_join(acc, rot) |>
+    right_join(rating) |>
+    mutate(
+      id = factor(id),
+      ex = factor(
+        ex,
+        levels = c("bi", "cr", "ha", "kn", "lu", "mo"),
+        labels = c(
+          "Bicycle Crunch",
+          "Crunch",
+          "Jumping Jack",
+          "Squat",
+          "Lunge",
+          "Mountain Climber"
+        )
+      ),
+      loc = factor(
+        loc,
+        levels = c("TL", "TR", "BL", "BR", "CH"),
+        labels = c("left arm", "right arm", "left leg", "right leg", "chest")
+      ),
+      dim = as.factor(dim),
+      set = factor(set, levels = c("set1", "set2", "set3"), ordered = TRUE)
+    )
+  assign(this_ex, ex)
+  cat(this_ex, "done\n")
+}
 
-usethis::use_data(bodyweight, overwrite = TRUE, compress = "xz")
+usethis::use_data(bi, overwrite = TRUE, compress = "xz")
+usethis::use_data(cr, overwrite = TRUE, compress = "xz")
+usethis::use_data(ha, overwrite = TRUE, compress = "xz")
+usethis::use_data(kn, overwrite = TRUE, compress = "xz")
+usethis::use_data(lu, overwrite = TRUE, compress = "xz")
+usethis::use_data(mo, overwrite = TRUE, compress = "xz")