Fix 38 age interval get age group

R/all_data_prep.R

@@ -1,14 +1,15 @@
 #' @title Construct age-group variable from age column
 #'
 #' @description This method splits an age interval from `min_val` to `max_val`
-#' into `(max_val - min_val) / step` intervals.
-#' By default `min_val` is set to 0, however it can be assigned by
-#' convenience.
+#' into intervals of size `step`.
 #' If the method finds ages greater or equal than `max_val`
 #' it assigns the string `">max_val"`.
-#' To avoid errors it is necessary to set `step < max_val`.
-#' It is also suggested to choose the step such
-#' that `max_val %% (step + 1) == 0`.
+#' By default `min_val` is set to 0, however it can be assigned by
+#' convenience. If the method finds ages lower or equal
+#' than `min_val` it assigns the string `"<min_val-1"`.
+#' The function warns when (max_val - min_val) is not an integer multiple of
+#' step. In that case the last interval is truncated to the upper value
+#' closest to max_val for which (closest_upper - min_val) is multiple of step.
 #'
 #' @param data dataset with at least a column containing the age
 #' information
@@ -30,7 +31,7 @@
 #'   data = cohortdata,
 #'   col_age = "age",
 #'   max_val = 80,
-#'   step = 9
+#'   step = 10
 #' )
 #'
 #' # view the data frame with new column
@@ -46,25 +47,33 @@ get_age_group <- function(data, col_age, max_val, min_val = 0, step) {
     names(data),
     must.include = col_age
   )
-  checkmate::assert_number(min_val, lower = 0)
-  checkmate::assert_number(max_val, lower = min_val)
-  checkmate::assert_number(step, lower = 1, upper = max_val)
+  checkmate::assert_int(min_val, lower = 0)
+  checkmate::assert_int(max_val, lower = min_val)
+  checkmate::assert_int(step, lower = 1, upper = max_val)
 
   # get breaks
-  n_steps <- as.integer((max_val - min_val) / step) + 1
-  limits_low <- seq.int(
-    min_val, max_val,
-    length.out = n_steps
-  )
-  limits_high <- limits_low + step
+  limits_low <- seq.int(min_val, max_val, by = step)
+  limits_high <- limits_low + step - 1
 
   # prepare labels
   lim_labels <- paste(limits_low, limits_high, sep = "-")
   lim_labels[length(lim_labels)] <- paste0(
-    ">",
-    limits_low[length(limits_low)]
+    ">", limits_low[length(limits_low)]
   )
-  lim_breaks <- c(-Inf, limits_low[seq(2, length(limits_low))] - 1, Inf)
+  if (min_val == 0) {
+    lim_breaks <- c(limits_low[seq(1, length(limits_low))] - 1, Inf)
+  }  else {
+    lim_labels <- c(paste0("<", min_val - 1), lim_labels)
+    lim_breaks <- c(-Inf, limits_low[seq(1, length(limits_low))] - 1, Inf)
+  }
+
+  #Warning of module condition not satisfied
+  if ((max_val - min_val) %% step != 0) {
+    war_msg <- "(max_val - min_val) must be an integer multiple of step.
+    The last interval will be truncated to "
+    war_msg <- paste0(war_msg, lim_labels[length(lim_labels)])
+    warning(war_msg)
+  }
 
   # cut the age data and apply labels
   age_group <- cut(data[[col_age]],

tests/testthat/test-cohort_effectiveness.R

@@ -103,7 +103,7 @@ test_that("`coh_test_noconf`: accept PH", {
     data = cohortdata,
     col_age = "age",
     max_val = 80,
-    step = 9
+    step = 10
   )
   cohortdata_3039 <- cohortdata[cohortdata$age_group == "30-39", ]
 

tests/testthat/test-get_age_group.R

@@ -7,13 +7,13 @@ data("cohortdata")
 test_that("`get_age_groups`: basic expectations", {
   # prepare a vector of binned ages
   max_val <- 80
-  step_size <- 7
+  step_size <- 10
 
   age_groups <- get_age_group(
     data = cohortdata,
     col_age = "age",
-    max_val = 80,
-    step = 7
+    max_val = max_val,
+    step = step_size
   )
 
   # basic checks for return type
@@ -24,37 +24,27 @@ test_that("`get_age_groups`: basic expectations", {
   expect_length(
     unique(age_groups),
     # manual cutting of age groups - ROUGHLY CORRECT
-    length(
-      levels(
-        cut(
-          cohortdata$age,
-          breaks = c(
-            -Inf,
-            seq(step_size, max_val, step_size),
-            Inf
-          )
+    nlevels(
+      cut(
+        cohortdata$age,
+        breaks = c(
+          -Inf,
+          seq(step_size, max_val, step_size),
+          Inf
         )
       )
     )
   )
-  # check that last value is the same as max_val
-  expect_identical(
-    tail(levels(age_groups), 1),
-    sprintf(">%i", max_val) # hacky test to avoid regex extraction
-  )
 
   # check that breaks are correct
   # expect 0-50 and >80
-  expect_identical(
-    levels(
-      get_age_group(
-        data = cohortdata,
-        col_age = "age",
-        max_val = 80,
-        step = 50
-      )
-    ),
-    c("0-50", ">80")
+  expect_warning(
+    get_age_group(
+      data = cohortdata,
+      col_age = "age",
+      max_val = 80,
+      step = 50
+    )
   )
 })
 
@@ -120,6 +110,17 @@ test_that("`get_age_groups`: Input checking", {
     regexp = "Assertion on 'min_val' failed: May not be NA"
   )
 
+  # non-integer values passed
+  expect_error(
+    get_age_group(
+      data = cohortdata,
+      col_age = "age",
+      min_val = 0.7,
+      max_val = 1,
+      step = 1
+    )
+  )
+
   # step size is larger than difference in age limits
   # maximum age is less than the minimum age
   max_age <- 80
@@ -138,3 +139,23 @@ test_that("`get_age_groups`: Input checking", {
     )
   )
 })
+
+# tests to check for min_val != 0
+test_that("`get_age_groups`: non-zero min_val", {
+  min_val <- 10
+  cohortdata$age_group <- get_age_group(
+    data = cohortdata,
+    col_age = "age",
+    max_val = 80,
+    min_val = min_val,
+    step = 10
+  )
+
+  #expect none NA values are expected
+  expect_length(cohortdata[is.na(cohortdata$age_group), ]$age_group, 0)
+
+  #Check for registers < min_val
+  expect_true(
+    all(cohortdata[cohortdata$age < min_val, ]$age_group == "<9")
+  )
+})