Remove columns argument

NEWS.md

@@ -3,6 +3,7 @@
 ## Major & breaking changes
 
 * The `cite` function has been deprecated and replaced with `get_citation` (#84).
+* the `columns` argument has been removed from `check.survey()` (#81).
 
 ## Internal changes
 

R/check.r

@@ -7,7 +7,7 @@ check <- function(x, ...) UseMethod("check")
 #' @description Checks that a survey fulfills all the requirements to work with the 'contact_matrix' function
 #'
 #' @param x A [survey()] object
-#' @param columns if given, a named character vector containing the name of the "id", "participant.age" and "contact.age" columns
+#' @param columns deprecated argument, ignored
 #' @param id.column the column in both the `participants` and `contacts` data frames that links contacts to participants
 #' @param participant.age.column the column in the `participants` data frame containing participants' age
 #' @param country.column the column in the `participants` data frame containing the country in which the participant was queried
@@ -19,58 +19,63 @@ check <- function(x, ...) UseMethod("check")
 #' data(polymod)
 #' check(polymod)
 #' @export
-check.survey <- function(x, columns = FALSE, id.column = "part_id", participant.age.column = "part_age", country.column = "country", year.column = "year", contact.age.column = "cnt_age", ...) {
+check.survey <- function(x, columns, id.column = "part_id", participant.age.column = "part_age", country.column = "country", year.column = "year", contact.age.column = "cnt_age", ...) {
   chkDots(...)
   if (!is.data.frame(x$participants) || !is.data.frame(x$contacts)) {
     stop("The 'participants' and 'contacts' elements of 'x' must be data.frames")
   }
 
+  if (!missing(columns)) {
+    warning(
+      "The 'columns' argument is deprecated and will cause an error from ",
+      "version 1.0.0. The behaviour of the function now always corresponds ",
+      "to the previous documented case for `columns = TRUE`"
+    )
+  }
+
   x <- clean(x)
 
   success <- TRUE
-  if (!missing(columns)) {
-    if (!(id.column %in% colnames(x$participants) &&
-      id.column %in% colnames(x$contacts))) {
-      warning(
-        "id.columns '", id.column, "' does not exist in both the ",
-        "participants and contacts data frames"
-      )
-      success <- FALSE
-    }
-
-    if (!(participant.age.column %in% colnames(x$participants))) {
-      warning(
-        "participant age column '", participant.age.column, "' does not exist ",
-        "in the participant data frame"
-      )
-      success <- FALSE
-    }
+  if (!(id.column %in% colnames(x$participants) &&
+    id.column %in% colnames(x$contacts))) {
+    warning(
+      "id.columns '", id.column, "' does not exist in both the ",
+      "participants and contacts data frames"
+    )
+    success <- FALSE
+  }
 
-    if (!(contact.age.column %in% colnames(x$contacts))) {
-      exact.column <- paste(contact.age.column, "exact", sep = "_")
-      min.column <- paste(contact.age.column, "est_min", sep = "_")
-      max.column <- paste(contact.age.column, "est_max", sep = "_")
+  if (!(participant.age.column %in% colnames(x$participants))) {
+    warning(
+      "participant age column '", participant.age.column, "' does not exist ",
+      "in the participant data frame"
+    )
+    success <- FALSE
+  }
 
-      if (!((exact.column %in% colnames(x$contacts)) ||
-        (min.column %in% colnames(x$contacts) && max.column %in% colnames(x$contacts)))) {
-        warning(
-          "contact age column '", contact.age.column,
-          "' or columns to estimate contact age ('", exact.column, "' or '",
-          min.column, "' and '", max.column, "') do not exist in the contact data frame"
-        )
-        success <- FALSE
-      }
-    }
+  if (!(contact.age.column %in% colnames(x$contacts))) {
+    exact.column <- paste(contact.age.column, "exact", sep = "_")
+    min.column <- paste(contact.age.column, "est_min", sep = "_")
+    max.column <- paste(contact.age.column, "est_max", sep = "_")
 
-    if (!(country.column %in% colnames(x$participants))) {
+    if (!((exact.column %in% colnames(x$contacts)) ||
+      (min.column %in% colnames(x$contacts) && max.column %in% colnames(x$contacts)))) {
       warning(
-        "country column '", country.column, "' does not exist ",
-        "in the participant data frame"
+        "contact age column '", contact.age.column,
+        "' or columns to estimate contact age ('", exact.column, "' or '",
+        min.column, "' and '", max.column, "') do not exist in the contact data frame"
       )
       success <- FALSE
     }
   }
 
+  if (!(country.column %in% colnames(x$participants))) {
+    warning(
+      "country column '", country.column, "' does not exist ",
+      "in the participant data frame"
+    )
+    success <- FALSE
+  }
   if (success) message("Check OK.") else message("Check FAILED.")
 
   invisible(c(

R/cite.r

@@ -17,7 +17,7 @@ cite <- function(x, ...) UseMethod("cite")
 #' @export
 cite.survey <- function(x, ...) {
   warning(
-    "The cite function is deprecated and will stop working in version 0.4.0. ",
+    "The cite function is deprecated and will stop working in version 1.0.0. ",
     "Please use get_citation() instead."
   )
   chkDots(...)

R/contact_matrix.r

@@ -59,7 +59,7 @@ contact_matrix <- function(survey, countries = NULL, survey.pop, age.limits, fil
   ## get the survey
   survey <- get_survey(survey)
   ## check and get columns
-  columns <- suppressMessages(check(survey, columns = TRUE, ...))
+  columns <- suppressMessages(check(survey, ...))
 
   if (!missing(n)) {
     warning(

tests/testthat/test-checks.r

@@ -1,4 +1,5 @@
 context("Survey data checks")
+library(data.table)
 
 erroneous_survey <- survey(polymod$participants, polymod$contacts, polymod$reference)
 
@@ -20,6 +21,10 @@ erroneous_structure3 <- copy(erroneous_survey)
 erroneous_structure3$contacts$cnt_age_est_min <- NULL
 
 test_that("incorrect structure of data frames is correctly identified", {
-  expect_warning(check(erroneous_structure1, columns = TRUE))
-  expect_warning(check(erroneous_structure2, columns = TRUE))
+  expect_warning(check(erroneous_structure1), "does not exist")
+  expect_warning(check(erroneous_structure2), "does not exist")
+})
+
+test_that("deprecated arguments are warned about", {
+  expect_warning(check(polymod, columns = TRUE), "deprecated")
 })

tests/testthat/test-matrix.r

@@ -136,19 +136,19 @@ test_that("warning is thrown if country has no survey population", {
 })
 
 test_that("warning is thrown if contact survey has no age information", {
-  expect_warning(check(x = polymod6, columns = TRUE), "do not exist")
+  expect_warning(check(x = polymod6), "do not exist")
 })
 
 test_that("warning is thrown if participant data has no country", {
-  expect_warning(check(x = polymod4, columns = TRUE), "does not exist")
+  expect_warning(check(x = polymod4), "does not exist")
 })
 
 test_that("user is informed about removing missing data", {
   expect_message(contact_matrix(survey = polymod), "Removing")
 })
 
 test_that("check result is reported back", {
-  expect_message(check(x = polymod6), "Check")
+  expect_message(check(x = polymod2), "Check")
 })
 
 test_that("good suggestions are made", {