Fix issues with dataframes missing resolution columns (#20)

* Create qualtrics_fetch2 dataset

* Update link to iptools

* Reassign column names when rename = TRUE

Fix bug where column names are wrong when rename = TRUE and column names are specified

* Remove .data$ from column references

Avoids tidyselect errors but still has "no visible binding for global variable" notes when checking

* Revert "Remove .data$ from column references"

This reverts commit 98f5b51.

* Remove .data from selections

* Fix tests with rename = FALSE

* Tidy up DESCRIPTION

* Alert when columns are already named correctly for rename_columns()

* Fix bug when no resolution column is present

DESCRIPTION

@@ -17,9 +17,9 @@ License: GPL (>= 3)
 URL: https://docs.ropensci.org/excluder/,
     https://github.com/ropensci/excluder/
 BugReports: https://github.com/ropensci/excluder/issues/
-Depends: 
+Depends:
     R (>= 3.5.0)
-Imports: 
+Imports:
     cli,
     curl,
     dplyr,
@@ -32,15 +32,15 @@ Imports:
     stringr,
     tidyr,
     tidyselect
-Suggests: 
+Suggests:
     covr,
     knitr,
     lifecycle,
     readr,
     rmarkdown,
     testthat (>= 3.0.0),
     withr
-VignetteBuilder: 
+VignetteBuilder:
     knitr
 Config/testthat/edition: 3
 Encoding: UTF-8

R/rename_columns.R

@@ -69,7 +69,7 @@ rename_columns <- function(x, alert = TRUE) {
         UserLanguage = "User Language"
       ) %>%
       dplyr::rename_with(~ gsub(throwaway, "", .x), dplyr::contains(throwaway))
-  } else if (any(grepl("_Resolution", column_names))) {
+  } else if (column_names[1] == "StartDate" & any(grepl("_Resolution", column_names))) {
     # Find extraneous text to remove from computer info columns
     text <- x %>%
       dplyr::select(dplyr::contains("_Resolution")) %>%
@@ -80,6 +80,11 @@ rename_columns <- function(x, alert = TRUE) {
     # Rename columns
     x %>%
       dplyr::rename_with(~ gsub(throwaway, "", .x), dplyr::contains(throwaway))
+  } else if (column_names[1] == "StartDate") {
+    if (alert) {
+      cli::cli_alert_warning("The columns are already named correctly.")
+    }
+    invisible(x)
   } else { # if first column is not `Started Date`
     if (alert) {
       cli::cli_alert_warning("The columns cannot be renamed.")

R/use_labels.R

@@ -31,16 +31,17 @@ use_labels <- function(x) {
     colnames(x) <- attributes(x)$column_map[attributes(x)$column_map$qname %in% column_names, ]$description
 
     # Find extraneous text to remove from computer info columns
-    text <- x %>%
-      dplyr::select(dplyr::contains(" - Resolution")) %>%
-      names() %>%
-      strsplit(split = " - ")
-    throwaway <- paste0(text[[1]][1], " - ")
-
-    # Rename columns
-    x <- x %>%
-      dplyr::rename_with(~ gsub(throwaway, "", .x), dplyr::contains(throwaway))
+    if (any(grepl("Resolution", column_names))) {
+      text <- x %>%
+        dplyr::select(dplyr::contains("Resolution")) %>%
+        names() %>%
+        strsplit(split = " - ")
+      throwaway <- paste0(text[[1]][1], " - ")
 
+      # Rename columns
+      x <- x %>%
+        dplyr::rename_with(~ gsub(throwaway, "", .x), dplyr::contains(throwaway))
+    }
     return(x)
   }
 }

tests/testthat/test-rename_columns.R

@@ -1,9 +1,13 @@
 # Test rename_columns()
 
+qualtrics_wrong <- qualtrics_fetch %>%
+  dplyr::rename(date = StartDate)
+
 test_that("alert works", {
-  expect_message(rename_columns(qualtrics_numeric))
-  expect_message(rename_columns(qualtrics_numeric, alert = FALSE), NA)
-  expect_message(rename_columns(qualtrics_fetch), NA)
+  expect_message(rename_columns(qualtrics_numeric), "The columns are already named correctly")
+  expect_message(rename_columns(qualtrics_wrong), "The columns cannot be renamed")
+  expect_no_message(rename_columns(qualtrics_numeric, alert = FALSE))
+  expect_no_message(rename_columns(qualtrics_fetch))
 })
 
 test_that("column names are correct", {
@@ -13,6 +17,9 @@ test_that("column names are correct", {
   expect_true(names(rename_columns(use_labels(qualtrics_fetch)))[1] == "StartDate")
   expect_true(names(rename_columns(use_labels(qualtrics_fetch)))[3] == "Status")
   expect_true(names(rename_columns(use_labels(qualtrics_fetch)))[16] == "Resolution")
-  expect_true(names(rename_columns(qualtrics_numeric, alert = FALSE))[1] ==
-    "StartDate")
+  expect_true(names(rename_columns(qualtrics_numeric, alert = FALSE))[1] == "StartDate")
+})
+
+test_that("dataframes without resolution column are OK", {
+  suppressMessages(expect_no_error(rename_columns(qualtrics_fetch %>% dplyr::select(!contains("Resolution")))))
 })

tests/testthat/test-use_labels.R

@@ -1,5 +1,5 @@
 test_that("alert works", {
-  expect_error(use_labels(qualtrics_numeric))
+  expect_error(use_labels(qualtrics_numeric), "Data frame does not have proper Qualtrics labels")
   expect_error(use_labels(qualtrics_fetch, NA))
 })
 
@@ -10,3 +10,7 @@ test_that("labels are correct", {
   expect_true(colnames(qualtrics_fetch)[16] == "Q1_Resolution")
   expect_true(colnames(use_labels(qualtrics_fetch))[16] == "Resolution")
 })
+
+test_that("dataframes without resolution are OK", {
+  expect_no_error(use_labels(qualtrics_fetch %>% dplyr::select(!contains("Resolution"))))
+})