refactor cod_check_age_type

R/cod_check_age.R

@@ -47,42 +47,38 @@ cod_check_age <- function(age_value,
   age_check <- vector(mode = "integer", length = length(age_value))
 
   ## Classify errors/issues ----
-  if (age_type == "D") {
-    age_check <- ifelse(age_value >= 28 & age_value <= 31, 1, age_check)
-    age_check <- ifelse(age_value > 31, 2, age_check)
-  }
+  age_check[age_type == "D" & age_value >= 28 & age_value <= 31] <- 1L
+  age_check[age_type == "D" & age_value > 31] <- 2L
 
-  if (age_type == "M") {
-    age_check <- ifelse(age_value < 1, 3, age_check)
-    age_check <- ifelse(age_value >= 12, 4, age_check)
-  }
+  age_check[age_type == "M" & age_value < 1] <- 3L
+  age_check[age_type == "M" & age_value >= 12] <- 4L
 
-  if (age_type == "Y") {
-    age_check <- ifelse(age_value < 1, 5, age_check)
-    age_check <- ifelse(age_value > 125, 6, age_check)
-  }
+  age_check[age_type == "Y" & age_value < 1] <- 5L
+  age_check[age_type == "Y" & age_value > 125] <- 6L
 
-  if (is.na(age_value)) age_check <- 7
-  if (is.na(age_type)) age_check <- 8
+  age_check[is.na(age_value) & !is.na(age_type)] <- 7L
+  age_check[!is.na(age_value) & is.na(age_type)] <- 8L
+  age_check[is.na(age_value) & is.na(age_type)] <- 9L
 
   age_check_note <- cut(
     x = age_check,
-    breaks = c(0, 1, 2, 3, 4, 5, 6, 7, 8, Inf),
+    breaks = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, Inf),
     labels = c(
       "No issues with age value and age type",
       "Should probably be age value of 1 and age type of months (M)",
-      "Should probably be converted to age value of age type months (M)",
+      "Should probably be converted to age value of age type months (M) not days (D)",
       "Should probably be converted to age value of age type days (D)",
       "Should probably be converted to age value of age type years (Y)",
-      "Should probably be converted to age value of age type months (M)",
+      "Should probably be converted to age value of age type months (M) not years (Y)",
       "Age value is more than 125 years which is highly unlikely",
       "Missing age value",
-      "Missing age type"
+      "Missing age type",
+      "Missing age value and age type"
     ),
     include.lowest = TRUE, right = FALSE
   )
 
-
   ## Return age checks ----
   tibble::tibble(age_check, age_check_note)
 }
+

R/cod_check_sex.R

@@ -0,0 +1,35 @@
+#'
+#' Check sex values in cause of death data based on CoDEdit rules
+#'
+#' @param sex_value An integer value or vector of values for age based on the
+#'   CoDEdit rules.
+#'
+
+cod_check_sex <- function(sex_value) {
+  ## Create sex_check vector ----
+  sex_check <- vector(mode = "integer", length = length(sex_value))
+
+  ## Check that sex_value is of the correct class ----
+  sex_check <- ifelse(!is.integer(sex_value), 1L, sex_check)
+
+  ## Check that sex_value is either 1L for males, 2L for females, and 9L for
+  ## unknown
+  sex_check <- ifelse(
+    any(!sex_value %in% c(1L, 2L, 9L)), sex_check + 2L, sex_check
+  )
+
+
+  ## Check if sex_value is missing ----
+  sex_check <- ifelse(is.na(sex_value), sex_check + 4L, sex_check)
+
+  ## Create sex_check note vector ----
+  sex_check_note <- vector(mode = "character", length = length(sex_value))
+
+  sex_check_note[sex_check == 0] <- "No issues with sex values"
+  sex_check_note[sex_check == 1] <- "Sex value is not an integer"
+  sex_check_note[sex_check == 2] <- "Sex value is not any of the expected values"
+  sex_check_note[sex_check == 3] <- "Sex value is not an integer; Sex value is not any of the expected values"
+  sex_check_note[sex_check == 4] <- "Missing sex value"
+  sex_check_note[sex_check == 5] <- ""
+
+}

tests/testthat/test-cod_check_age.R

@@ -0,0 +1,55 @@
+# Tests for check age functions ------------------------------------------------
+
+age_value <- c(25, 35, 5, NA, 104, 999)
+age_type <- c("D", "D", "M", "Y", NA_character_, "Y")
+
+expected_score <- c(0L, 2L, 0L, 7L, 8L, 6L)
+expected_note <- c(
+  "No issues with age value and age type",
+  "Should probably be converted to age value of age type months (M) not days (D)",
+  "No issues with age value and age type",
+  "Missing age value",
+  "Missing age type",
+  "Age value is more than 125 years which is highly unlikely"
+) |>
+  factor(
+    levels = c(
+      "No issues with age value and age type",
+      "Should probably be age value of 1 and age type of months (M)",
+      "Should probably be converted to age value of age type months (M) not days (D)",
+      "Should probably be converted to age value of age type days (D)",
+      "Should probably be converted to age value of age type years (Y)",
+      "Should probably be converted to age value of age type months (M) not years (Y)",
+      "Age value is more than 125 years which is highly unlikely",
+      "Missing age value",
+      "Missing age type",
+      "Missing age value and age type"
+    )
+  )
+
+
+test_that(
+  "output is as expected", {
+    expect_s3_class(
+      cod_check_age(age_value = age_value, age_type = age_type), "tbl"
+    )
+
+    expect_equal(
+      cod_check_age(age_value = age_value, age_type = age_type),
+      tibble::tibble(
+        age_check = expected_score,
+        age_check_note = expected_note
+      )
+    )
+
+    expect_type(
+      cod_check_age(age_value = age_value, age_type = age_type)$age_check,
+      "integer"
+    )
+
+    expect_s3_class(
+      cod_check_age(age_value = age_value, age_type = age_type)$age_check_note,
+      "factor"
+    )
+  }
+)