refac: replaced 'censore' by 'censor'. This misspelling had propagate…

…d throughout all the new functions

NAMESPACE

@@ -1,6 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
-export(censore_match)
+export(censor_match)
 export(coh_coverage)
 export(coh_eff_noconf)
 export(coh_test_noconf)

R/coh_matching.R

@@ -151,9 +151,9 @@ match_cohort <- function(data,
   return(match)
 }
 
-#' @title Censore couple after matching
+#' @title Censor couple after matching
 #'
-#' @description This function censores a couple whether the case or the control
+#' @description This function censors a couple whether the case or the control
 #' have a censoring date. It imputes the censoring date to the whole couple
 #' using the matching id provided in subclass. This column comes with the output
 #' of `match_cohort`.
@@ -179,15 +179,15 @@ match_cohort <- function(data,
 #' )
 #'
 #' # add column with censoring date for match
-#' matched_cohort$censoring_date <-  censore_match(
+#' matched_cohort$censoring_date <-  censor_match(
 #'   data = matched_cohort,
 #'   censoring_date_col = "death_other_causes"
 #' )
 #'
 #' # view data with added column
 #' head(matched_cohort)
 #' @export
-censore_match <- function(data, censoring_date_col) {
+censor_match <- function(data, censoring_date_col) {
   censoring_date <- unlist(
     tapply(data[[censoring_date_col]],
       data$subclass,

tests/testthat/test-censor_match.R

@@ -0,0 +1,63 @@
+#### Tests for censor_match()
+
+## prepare data
+data("cohortdata")
+start_cohort <- as.Date("2044-01-01")
+end_cohort <- as.Date("2044-12-31")
+
+# sample cohort to make tests faster - take a bigger sample
+sample_size <- 5000
+sample_indices <- sample(nrow(cohortdata), sample_size)
+sample_cohort <- cohortdata[sample_indices, ]
+rownames(sample_cohort) <- NULL
+
+# assign vaccination status
+sample_cohort$vaccine_status <- set_status(
+  data = sample_cohort,
+  col_names = "vaccine_date_2",
+  status = c("v", "u")
+)
+# match cohort
+matched_cohort <- match_cohort(data = sample_cohort,
+  status_vacc_col = "vaccine_status",
+  exact = "sex"
+)
+# add column with censoring date for match
+matched_cohort$censoring_date <- censor_match(
+  data = matched_cohort,
+  censoring_date_col = "death_other_causes"
+)
+
+# snapshot test basic expectations
+test_that("`censor_match`: basic expectations", {
+  # expect date
+  expect_vector(
+    matched_cohort$censoring_date,
+    ptype = as.Date("2045-01-01")
+  )
+  # filter registers with censoring date informed
+  censored_original <-
+    matched_cohort[!is.na(matched_cohort$death_other_causes), ]
+  # filter registers with censoring date created after matching
+  censored_match <-
+    matched_cohort[!is.na(matched_cohort$censoring_date), ]
+
+  # All the subclass IDs in censored_match must be contained in
+  # censored_original
+  expect_true(
+    all(censored_match$subclass %in% censored_original$subclass)
+  )
+})
+
+test_that("`censor_match`: take minimum censoring date", {
+  censored_twodates <-
+    matched_cohort[!is.na(matched_cohort$censoring_date)  &
+      !is.na(matched_cohort$death_other_causes),
+    ]
+
+  expect_true(
+    all(
+      censored_twodates$censoring_date <= censored_twodates$death_other_causes
+    )
+  )
+})

tests/testthat/test-censore_match.R

@@ -1,4 +1,4 @@
-#### Tests for censore_match()
+#### Tests for censor_match()
 
 ## prepare data
 data("cohortdata")
@@ -23,13 +23,13 @@ matched_cohort <- match_cohort(data = sample_cohort,
   exact = "sex"
 )
 # add column with censoring date for match
-matched_cohort$censoring_date <- censore_match(
+matched_cohort$censoring_date <- censor_match(
   data = matched_cohort,
   censoring_date_col = "death_other_causes"
 )
 
 # snapshot test basic expectations
-test_that("`censore_match`: basic expectations", {
+test_that("`censor_match`: basic expectations", {
   # expect date
   expect_vector(
     matched_cohort$censoring_date,
@@ -49,7 +49,7 @@ test_that("`censore_match`: basic expectations", {
   )
 })
 
-test_that("`censore_match`: take minimum censoring date", {
+test_that("`censor_match`: take minimum censoring date", {
   censored_twodates <-
     matched_cohort[!is.na(matched_cohort$censoring_date)  &
       !is.na(matched_cohort$death_other_causes),

tests/testthat/test-match_cohort.R

@@ -1,4 +1,4 @@
-#### Tests for censore_match()
+#### Tests for censor_match()
 
 ## prepare data
 data("cohortdata")