Merge pull request #37 from OxfordIHTM/dev

refactor calculate age function and add tests

Author: ernestguevarra

NAMESPACE

@@ -1,10 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
 export(cod_calculate_age)
+export(cod_calculate_ages)
 export(cod_check_age)
 export(cod_recode_age_type)
 export(cod_recode_sex)
 export(get_age_values)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)

R/cod_calculate_age.R

@@ -73,3 +73,22 @@ cod_calculate_age <- function(dob,
   ## Return age_df ----
   age_df
 }
+
+#'
+#' @rdname cod_calculate_age
+#' @export
+#'
+
+cod_calculate_ages <- function(dob,
+                               dod,
+                               date_format = "%Y-%m-%d",
+                               codedit = TRUE) {
+  Map(
+    f = cod_calculate_age,
+    dob = dob,
+    dod = dod,
+    date_format = date_format,
+    codedit = codedit
+  ) |>
+    dplyr::bind_rows()
+}

R/cod_check_sex.R

@@ -3,9 +3,15 @@
 #'
 #' @param sex_value An integer value or vector of values for age based on the
 #'   CoDEdit rules.
+#' @param sex_code A character or integer vector of 2 values that indicate
+#'   which values are to be considered pertaining to males (first value in the
+#'   vector) or to females (second value in the vector).
 #'
 
-cod_check_sex <- function(sex_value) {
+cod_check_sex <- function(sex_value, sex_code) {
+  ## Recode sex ----
+  sex_value <- cod_recode_sex(sex_value = sex_value, sex_code = sex_code)
+
   ## Create sex_check vector ----
   sex_check <- vector(mode = "integer", length = length(sex_value))
 
@@ -14,22 +20,20 @@ cod_check_sex <- function(sex_value) {
 
   ## 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
-  )
-
+  sex_check <- ifelse(all(!sex_value %in% c(1L, 2L, 9L)), 2L, sex_check)
 
   ## Check if sex_value is missing ----
-  sex_check <- ifelse(is.na(sex_value), sex_check + 4L, sex_check)
+  sex_check <- ifelse(is.na(sex_value), 3L, 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] <- ""
+  sex_check_note[sex_check == 3] <- "Missing sex value"
+
 
+  ## Return check ----
+  tibble::tibble(sex_check, sex_check_note)
 }

R/codeditr-package.R

@@ -15,7 +15,7 @@
 #' @name codeditr
 #' @importFrom methods is
 #' @importFrom tibble tibble
-#' @importFrom dplyr mutate select case_when
+#' @importFrom dplyr mutate select case_when bind_rows
 #' @importFrom rlang .data
 #'
 "_PACKAGE"

man/cod_calculate_age.Rd

@@ -55,10 +55,12 @@ reference:
   - title: Calculate
     contents:
     - cod_calculate_age
+    - cod_calculate_ages
 
   - title: Check
     contents:
     - cod_check_age
+    - cod_check_sex
     - cod_check_missing
 
   - title: Utilities

man/cod_check_sex.Rd

@@ -0,0 +1,26 @@
+# Tests for calculating age function -------------------------------------------
+
+dob <- c("1977-11-05", "1971-04-04", "2012-08-13")
+dod <- Sys.Date()
+
+
+testthat::test_that(
+  "output is as expected", {
+    expect_s3_class(cod_calculate_ages(dob = dob, dod = dod), "tbl")
+
+    expect_named(
+      cod_calculate_ages(dob = dob, dod = dod),
+      expected = c("age_value", "age_type")
+    )
+
+    expect_s3_class(
+      cod_calculate_ages(dob = dob, dod = dod, codedit = FALSE),
+      "tbl"
+    )
+
+    expect_named(
+      cod_calculate_ages(dob = dob, dod = dod, codedit = FALSE),
+      expected = c("age_days", "age_months", "age_years")
+    )
+  }
+)