From 236bb0b373c2ff900e0795022b88975c109201f0 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Mon, 6 Jan 2025 14:20:38 -0500 Subject: [PATCH] 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 | 6 +++--- NAMESPACE | 2 +- R/is_prefixed.R | 2 +- R/labelled-package.R | 6 +----- R/lookfor.R | 10 +++++----- R/tagged_na.R | 4 ++-- R/to_factor.R | 2 +- R/to_labelled.R | 10 +++++----- R/val_labels.R | 12 ++---------- R/var_label.R | 4 ++-- _pkgdown.yml | 5 ++++- inst/WORDLIST | 1 - tests/testthat/test-labelled.r | 6 +++--- tests/testthat/test-na_values.R | 10 +++++----- vignettes/{intro_labelled.Rmd => labelled.Rmd} | 6 +++--- vignettes/look_for.Rmd | 4 ++-- 16 files changed, 40 insertions(+), 50 deletions(-) rename vignettes/{intro_labelled.Rmd => labelled.Rmd} (98%) diff --git a/DESCRIPTION b/DESCRIPTION index 5fd8c44d..951ae2b7 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index 8ffe1ca7..fc95bbe0 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/is_prefixed.R b/R/is_prefixed.R index 11ae55b0..339ebe30 100644 --- a/R/is_prefixed.R +++ b/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)) } diff --git a/R/labelled-package.R b/R/labelled-package.R index 96652287..fd6f39e0 100644 --- a/R/labelled-package.R +++ b/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") diff --git a/R/lookfor.R b/R/lookfor.R index d440c6c7..81ba64e8 100644 --- a/R/lookfor.R +++ b/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 = "; ")) ) ) diff --git a/R/tagged_na.R b/R/tagged_na.R index 7da80706..85650fde 100644 --- a/R/tagged_na.R +++ b/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)) { diff --git a/R/to_factor.R b/R/to_factor.R index b72a4e7b..cf8472d1 100644 --- a/R/to_factor.R +++ b/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" } diff --git a/R/to_labelled.R b/R/to_labelled.R index 31486ed3..4f2d59bb 100644 --- a/R/to_labelled.R +++ b/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 diff --git a/R/val_labels.R b/R/val_labels.R index 8cb01666..73dc5682 100644 --- a/R/val_labels.R +++ b/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) diff --git a/R/var_label.R b/R/var_label.R index bdc9939e..1cda175e 100644 --- a/R/var_label.R +++ b/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}." )) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 9d39d6ef..27e073cc 100644 --- a/_pkgdown.yml +++ b/_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"] diff --git a/inst/WORDLIST b/inst/WORDLIST index 6f107d34..4e519c57 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -10,7 +10,6 @@ Stata briatte cheatsheet df -dictionnary dplyr gmail joseph diff --git a/tests/testthat/test-labelled.r b/tests/testthat/test-labelled.r index 04243c8f..572ac91a 100644 --- a/tests/testthat/test-labelled.r +++ b/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") diff --git a/tests/testthat/test-na_values.R b/tests/testthat/test-na_values.R index a6e14136..26b10047 100644 --- a/tests/testthat/test-na_values.R +++ b/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 ---------------------------------------------------------------- diff --git a/vignettes/intro_labelled.Rmd b/vignettes/labelled.Rmd similarity index 98% rename from vignettes/intro_labelled.Rmd rename to vignettes/labelled.Rmd index 4c11b560..6ae4f9f0 100644 --- a/vignettes/intro_labelled.Rmd +++ b/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))) ``` diff --git a/vignettes/look_for.Rmd b/vignettes/look_for.Rmd index d2391581..901ce464 100644 --- a/vignettes/look_for.Rmd +++ b/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} ---