Merge branch 'main' of https://github.com/larmarange/labelled

DESCRIPTION

@@ -17,11 +17,11 @@ Description: Work with labelled data imported from 'SPSS'
 License: GPL (>= 3)
 Encoding: UTF-8
 Depends:
-    R (>= 3.0)
+    R (>= 3.2)
 Imports:
     haven (>= 2.4.1),
     cli,
-    dplyr (>= 1.0.0),
+    dplyr (>= 1.1.0),
     lifecycle,
     rlang (>= 1.1.0),
     vctrs,
@@ -34,7 +34,6 @@ Suggests:
     rmarkdown,
     questionr,
     snakecase,
-    utf8,
     spelling
 Enhances: memisc
 URL: https://larmarange.github.io/labelled/, https://github.com/larmarange/labelled
@@ -45,3 +44,4 @@ RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 Language: en-US
 Config/testthat/edition: 3
+Config/Needs/check: memisc

NAMESPACE

@@ -174,9 +174,9 @@ export(val_labels)
 export(val_labels_to_na)
 export(var_label)
 import(rlang)
-importFrom(dplyr,.data)
 importFrom(dplyr,`%>%`)
 importFrom(dplyr,recode)
+importFrom(dplyr,where)
 importFrom(haven,format_tagged_na)
 importFrom(haven,is.labelled)
 importFrom(haven,is_tagged_na)

R/is_prefixed.R

@@ -8,7 +8,7 @@ is_prefixed <- function(x) {
       "({.arg x} is {class(x)})."
     ))
   l <- .get_prefixes.factor(x)
-  all(!is.na(l$code)) && all(!is.na(l$code)) && !any(duplicated(l$code))
+  !anyNA(l$code) && !anyNA(l$code) && !any(duplicated(l$code))
 }
 
 

R/labelled-package.R

@@ -1,10 +1,6 @@
 ## usethis namespace: start
 #' @importFrom lifecycle deprecate_soft
-#' @importFrom dplyr .data
+#' @importFrom dplyr where
 #' @import rlang
 ## usethis namespace: end
 NULL
-
-# because `where` is not exported by tidyselect
-# cf. https://github.com/r-lib/tidyselect/issues/201
-utils::globalVariables("where")

R/lookfor.R

@@ -25,6 +25,7 @@
 #' @param x a tibble returned by `look_for()`
 #' @return a tibble data frame featuring the variable position, name and
 #' description (if it exists) in the original data frame
+#' @seealso `vignette("look_for")`
 #' @details The function looks into the variable names for matches to the
 #' keywords. If available, variable labels are included in the search scope.
 #' Variable labels of data.frame imported with \pkg{foreign} or
@@ -178,7 +179,7 @@ look_for <- function(data,
 
     if (details != "none") {
       data <- data %>%
-        dplyr::select(res$variable)
+        dplyr::select(dplyr::all_of(res$variable))
 
       n_missing <- function(x) {
         sum(is.na(x))
@@ -195,7 +196,7 @@ look_for <- function(data,
 
     if (details == "full") {
       data <- data %>%
-        dplyr::select(res$variable)
+        dplyr::select(dplyr::all_of(res$variable))
 
       unique_values <- function(x) {
         length(unique(x))
@@ -267,7 +268,7 @@ print.look_for <- function(x, ...) {
             !is.na(.data$value_labels) ~ .data$value_labels,
             !is.na(.data$levels) ~ .data$levels,
             !is.na(.data$range) ~ paste("range:", .data$range),
-            TRUE ~ "" # zero-width space
+            .default = "" # zero-width space
           ),
           variable = dplyr::if_else(
             duplicated(.data$pos),
@@ -351,7 +352,7 @@ print.look_for <- function(x, ...) {
       lw <- dplyr::case_when(
         w_values < lw / 2 ~ lw - w_values,
         w_label < lw / 2 ~ lw - w_label,
-        TRUE ~ trunc(lw / 2)
+        .default = trunc(lw / 2)
       )
       # a minimum of 10
       lw <- max(10, lw)
@@ -407,7 +408,7 @@ convert_list_columns_to_character <- function(x) {
     dplyr::as_tibble() %>% # remove look_for class
     dplyr::mutate(
       dplyr::across(
-        where(is.list),
+        dplyr::where(is.list),
         ~ unlist(lapply(.x, paste, collapse = "; "))
       )
     )

R/recode.R

@@ -5,9 +5,9 @@
 #'
 #' @importFrom dplyr recode
 #' @inheritParams dplyr::recode
-#' @param .keep_value_labels If TRUE, keep original value labels.
-#'   If FALSE, remove value labels.
-#' @param .combine_value_labels If TRUE, will combine original value labels
+#' @param .keep_value_labels If `TRUE`, keep original value labels.
+#'   If `FALSE`, remove value labels.
+#' @param .combine_value_labels If `TRUE`, will combine original value labels
 #'   to generate new value labels. Note that unexpected results could be
 #'   obtained if a same old value is recoded into several different new values.
 #' @param .sep Separator to be used when combining value labels.

R/tagged_na.R

@@ -187,9 +187,9 @@ tagged_na_to_user_na.double <- function(x, user_na_start = NULL) {
   for (i in seq_along(tn)) {
     new_val <- user_na_start + i - 1
     if (any(x == new_val, na.rm = TRUE))
-      cli::cli_abort(paste(
+      cli::cli_abort(c(
         "Value {new_val} is already used in {.arg x}.",
-        "Please change {.arg user_na_start}."
+        i = "Please change {.arg user_na_start}."
       ))
     x[is_tagged_na(x, na_tag(tn[i]))] <- new_val
     if (any(is_tagged_na(labels, na_tag(tn[i])), na.rm = TRUE)) {

R/to_factor.R

@@ -94,7 +94,7 @@ to_factor.haven_labelled <- function(
   if (explicit_tagged_na && is.double(x)) {
     new_labels <- to_character(val_labels(x), explicit_tagged_na = TRUE)
     x <- to_character(unclass(x), explicit_tagged_na = TRUE)
-    if (any(is.na(new_labels))) { # regular NA with a label
+    if (anyNA(new_labels)) { # regular NA with a label
       x[is.na(x)] <- "NA"
       new_labels[is.na(new_labels)] <- "NA"
     }

R/to_labelled.R

@@ -206,8 +206,8 @@ memisc_to_labelled <- function(x) {
 #'   codes
 #' @details
 #' If you convert a labelled vector into a factor with prefix, i.e. by using
-#' [to_factor(levels = "prefixed")][to_factor()], `to_labelled.factor()` is able
-#' to reconvert it to a labelled vector with same values and labels.
+#' [`to_factor(levels = "prefixed")`][to_factor()], `to_labelled.factor()` is
+#' able to reconvert it to a labelled vector with same values and labels.
 #' @export
 #' @examples
 #' # Converting factors to labelled vectors
@@ -242,12 +242,12 @@ to_labelled.factor <- function(x, labels = NULL, .quiet = FALSE, ...) {
   if (is.null(labels)) {
     # check if levels are formatted as "[code] label"
     l <- .get_prefixes.factor(x)
-    if (any(is.na(l$code)) || any(is.na(l$code)) || any(duplicated(l$code))) {
+    if (anyNA(l$code) || anyNA(l$code) || any(duplicated(l$code))) {
       if (
         !.quiet &&
           any(duplicated(l$code)) &&
-          all(!is.na(l$code)) &&
-          all(!is.na(l$code))
+          !anyNA(l$code) &&
+          !anyNA(l$code)
       ) {
         cli::cli_warn("{.arg x} looks prefixed, but duplicated codes found.")
       }
@@ -258,10 +258,10 @@ to_labelled.factor <- function(x, labels = NULL, .quiet = FALSE, ...) {
     } else {
       # "[code] label" case
       num_l <- suppressWarnings(as.numeric(l$code))
-      if (!.quiet && all(!is.na(num_l)) && any(duplicated(num_l))) {
+      if (!.quiet && !anyNA(num_l) && any(duplicated(num_l))) {
         cli::cli_warn("All codes seem numeric but some duplicates found.")
       }
-      if (all(!is.na(num_l)) && !any(duplicated(num_l))) {
+      if (!anyNA(num_l) && !any(duplicated(num_l))) {
         l$code <- as.numeric(l$code)
       }
       r <- l$levels

R/val_labels.R

@@ -248,11 +248,7 @@ val_label.data.frame <- function(x, v, prefixed = FALSE) {
   if (length(v) != 1) {
     cli::cli_abort("{.arg v} (length: {length(v)}) should be a single value.")
   }
-  check_character(value, allow_null = TRUE)
-  if (length(value) > 1)
-    cli::cli_abort(
-      "{.arg value} (length: {length(value)}) should be a single value."
-    )
+  check_string(value, allow_null = TRUE)
   names(value) <- v
   val_labels(x, null_action = null_action) <- value
   x
@@ -267,11 +263,7 @@ val_label.data.frame <- function(x, v, prefixed = FALSE) {
   if (length(v) != 1) {
     cli::cli_abort("{.arg v} (length: {length(v)}) should be a single value.")
   }
-  check_character(value, allow_null = TRUE)
-  if (length(value) > 1)
-    cli::cli_abort(
-      "{.arg value} (length: {length(value)}) should be a single value."
-    )
+  check_string(value, allow_null = TRUE)
 
   labels <- val_labels(x)
 

R/var_label.R

@@ -113,7 +113,7 @@ var_label.data.frame <- function(x,
     r <- lapply(
       r,
       function(x) {
-        if (is.null(x)) as.character(NA) else x
+        if (is.null(x)) NA_character_ else x
       }
     )
   }
@@ -178,7 +178,7 @@ var_label.data.frame <- function(x,
     missing_names <- setdiff(names(value), names(x))
 
     cli::cli_abort(c(
-      "Can't find variables {.var {missing_names}}  in {.arg x}."
+      "Can't find variables {.var {missing_names}} in {.arg x}."
     ))
   }
 

_pkgdown.yml

@@ -24,7 +24,7 @@ reference:
 - title: Manipulating value labels
   desc:  Functions to set, manipulate and remove value labels
   contents:
-  - labelled
+  - haven::labelled
   - val_label
   - remove_var_label
   - sort_val_labels
@@ -33,20 +33,20 @@ reference:
   - drop_unused_value_labels
   - copy_labels
   - update_variable_labels_with
-- title: Data dictionnary
-  desc:  Functions to look for keywords variable names / labels and create a data dictionary
+- title: Data dictionary
+  desc:  Functions to look for keywords variable names / labels and create a data dictionary.
   contents:
   - look_for
 - title: Manipulating SPSS style missing values
   desc:  Functions to set, manipulate and remove SPSS style missing values
   contents:
-  - labelled_spss
+  - haven::labelled_spss
   - na_values
   - copy_labels
   - remove_user_na
 - title: Tagged missing values
   contents:
-  - tagged_na
+  - haven::tagged_na
   - unique_tagged_na
   - tagged_na_to_user_na
 - title: Converting
@@ -64,3 +64,6 @@ reference:
 - title: Internal datasets for testing
   contents:
   - spss_file
+
+redirects:
+- ["articles/intro_labelled.html", "articles/labelled.html"]

inst/WORDLIST

@@ -10,7 +10,6 @@ Stata
 briatte
 cheatsheet
 df
-dictionnary
 dplyr
 gmail
 joseph

tests/testthat/test-labelled.r

@@ -510,7 +510,7 @@ test_that("remove_user_na works properly", {
   xhs <- haven::labelled_spss(
     c(1, 2, NA, 98, 99),
     c(t1 = 1, t2 = 2, Missing = 99),
-    na_value = 99,
+    na_values = 99,
     na_range = c(99, Inf),
     label = "A test variable"
   )
@@ -584,7 +584,7 @@ test_that("to_factor boolean parameters", {
   x1 <- haven::labelled_spss(
     c(1, 2, 3, 5, 4, NA, 99),
     c(t1 = 1, t2 = 2, t5 = 5, Missing = 99),
-    na_value = 99
+    na_values = 99
   )
 
   tfx <- to_factor(x1, user_na_to_na = TRUE)
@@ -607,7 +607,7 @@ test_that("to_factor parameters : sort_levels + levels", {
   x1 <- haven::labelled_spss(
     c(1, 2, 3, 5, 4, NA, 99),
     c(t1 = 1, t2 = 2, t5 = 5, Missing = 99),
-    na_value = 99
+    na_values = 99
   )
 
   tfx <- to_factor(x1, sort_levels = "auto")

tests/testthat/test-na_values.R

@@ -4,7 +4,7 @@ test_that("na_values works with data.frame", {
   xhs <- haven::labelled_spss(
     c(1, 2, 3, NA, 99),
     c(t1 = 1, t2 = 2, Missing = 99),
-    na_value = 99,
+    na_values = 99,
     label = "variable label"
   )
   y <- c(1:4, NA)
@@ -19,7 +19,7 @@ test_that("na_range works with data.frame", {
   xhs <- haven::labelled_spss(
     c(1, 2, 3, NA, 99),
     c(t1 = 1, t2 = 2, Missing = 99),
-    na_value = 99,
+    na_values = 99,
     na_range = c(99, Inf),
     label = "variable label"
   )
@@ -35,7 +35,7 @@ test_that("user_na_to_na works with data.frame", {
   xhs <- haven::labelled_spss(
     c(c(1, 2, 3), NA, 99),
     c(t1 = 1, t2 = 2, Missing = 99),
-    na_value = 99,
+    na_values = 99,
     na_range = c(99, Inf),
     label = "variable label"
   )
@@ -44,8 +44,8 @@ test_that("user_na_to_na works with data.frame", {
 
   una_df <- user_na_to_na(df)
   expect_equal(df$y, y)
-  expect_null(na_values(una_df$x))
-  expect_null(na_range(una_df$x))
+  expect_null(na_values(una_df$xhs))
+  expect_null(na_range(una_df$xhs))
 })
 
 # set_na_values ----------------------------------------------------------------