Simplify condition + remove workaround + require R 3.2 (#168)

* Rename logo to logo.png to be shown on all pages + set primary color + call pkgdown::build_favicons()

* fix partial matching

* lints + improve docs for creating a get started page

* use anyNA and require R 3.2

* final cleanups

* memisc is installed on the coverage action (only missing for the check action)

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

@@ -178,7 +178,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 +195,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 +267,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 +351,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 +407,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/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

@@ -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

@@ -33,7 +33,7 @@ reference:
   - drop_unused_value_labels
   - copy_labels
   - update_variable_labels_with
-- title: Data dictionnary
+- title: Data dictionary
   desc:  Functions to look for keywords variable names / labels and create a data dictionary
   contents:
   - look_for
@@ -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

@@ -509,7 +509,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"
   )
@@ -583,7 +583,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)
@@ -606,7 +606,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 ----------------------------------------------------------------

vignettes/intro_labelled.Rmd → vignettes/labelled.Rmd

@@ -541,12 +541,12 @@ glimpse(women %>% unlabelled())
 ```
 
 
-Alternatively, you can use functions as `dplyr::mutate_if()` or `dplyr::mutate_at()`. See the example below.
+Alternatively, you can use functions as `dplyr::mutate()` +  `dplyr::across()`. See the example below.
 
 ```{r}
 glimpse(to_factor(women))
-glimpse(women %>% mutate_if(is.labelled, to_factor))
-glimpse(women %>% mutate_at(vars(employed:religion), to_factor))
+glimpse(women %>% mutate(across(where(is.labelled), to_factor)))
+glimpse(women %>% mutate(across(employed:religion, to_factor)))
 ```
 
 

vignettes/look_for.Rmd

@@ -1,9 +1,9 @@
 ---
 author: "Joseph Larmarange"
-title: "Generate a data dictionnary and search for variables with `look_for()`"
+title: "Generate a data dictionary and search for variables with `look_for()`"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{Generate a data dictionnary and search for variables with `look_for()`}
+  %\VignetteIndexEntry{Generate a data dictionary and search for variables with `look_for()`}
   %\VignetteEngine{knitr::rmarkdown}
   \usepackage[utf8]{inputenc}
 ---