setter to use for loop; remove labels if NA

R/formatters_var_labels.R

@@ -84,16 +84,22 @@ col_labels <- function(x, fill = FALSE) {
       names(x)
     } else if (any(names(value) == "")) {
       specified_cols <- names(value)[names(value) != ""]
-      checkmate::assert_subset(specified_cols, names(x), .var.name = "column names")
+      checkmate::assert_subset(specified_cols, names(x), .var.name = "names of value")
       res <- names(value)
       res[res == ""] <- setdiff(names(x), specified_cols)
       res
     } else {
-      checkmate::assert_set_equal(names(value), names(x), .var.name = "column names")
+      checkmate::assert_set_equal(names(value), names(x), .var.name = "names of value")
       names(value)
     }
 
-  x[varnames] <- mapply(`attr<-`, x = x[varnames], which = "label", value = value, SIMPLIFY = FALSE)
+  for (i in seq_along(value)) {
+    if (is.na(value[i])) {
+      attr(x[[varnames[i]]], "label") <- NULL
+    } else {
+      attr(x[[varnames[i]]], "label") <- value[[i]]
+    }
+  }
   x
 }
 
@@ -108,8 +114,14 @@ col_relabel <- function(x, ...) {
   varnames <- names(value)
 
   checkmate::assert_subset(varnames, names(x), .var.name = "names of ...")
-  lapply(value, checkmate::assert_string, .var.name = "element of ...")
+  lapply(value, checkmate::assert_string, .var.name = "element of ...", na.ok = TRUE)
 
-  x[varnames] <- mapply(`attr<-`, x = x[varnames], which = "label", value = value, SIMPLIFY = FALSE)
+  for (i in seq_along(value)) {
+    if (is.na(value[i])) {
+      attr(x[[varnames[i]]], "label") <- NULL
+    } else {
+      attr(x[[varnames[i]]], "label") <- value[[i]]
+    }
+  }
   x
 }

tests/testthat/test-formatters_var_labels.R

@@ -80,7 +80,7 @@ testthat::test_that("col_labels<- value names must be same as variable names", {
   iris_df <- utils::head(iris, 2)
   testthat::expect_error(
     col_labels(iris_df) <- stats::setNames(as.character(1:5), toupper(names(iris_df))),
-    "Assertion on 'column names' failed: Must be a permutation of set"
+    "Assertion on 'names of value' failed: Must be a permutation of set"
   )
 })
 
@@ -132,6 +132,16 @@ testthat::test_that("col_labels<- matches labels to variables by names of values
   )
 })
 
+testthat::test_that("col_labels<- removes labels on NA_character_", {
+  x <- data.frame(a = 1, b = 2, c = 3)
+  col_labels(x) <- c("A", "B", "C")
+  col_labels(x) <- c(b = NA, "AA", NA)
+  testthat::expect_identical(
+    col_labels(x),
+    c(a = "AA", b = NA, c = NA)
+  )
+})
+
 
 # col_relabel ----
 testthat::test_that("col_relabel correctly changes column labels in a data frame", {
@@ -154,3 +164,13 @@ testthat::test_that("col_relabel returns the original data.frame when no new lab
   iris_df <- col_relabel(iris)
   testthat::expect_equal(iris_df, iris)
 })
+
+testthat::test_that("col_relabel removes labels on NA_character_", {
+  x <- data.frame(a = 1, b = 2, c = 3)
+  col_labels(x) <- c("A", "B", "C")
+  x <- col_relabel(x, b = NA_character_)
+  testthat::expect_identical(
+    col_labels(x),
+    c(a = "A", b = NA, c = "C")
+  )
+})