diff --git a/DESCRIPTION b/DESCRIPTION index 5fd8c44..951ae2b 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 8ffe1ca..fc95bbe 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 11ae55b..339ebe3 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 9665228..fd6f39e 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 d440c6c..af26906 100644 --- a/R/lookfor.R +++ b/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 = "; ")) ) ) diff --git a/R/recode.R b/R/recode.R index 14c9cf2..c71293c 100644 --- a/R/recode.R +++ b/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. diff --git a/R/tagged_na.R b/R/tagged_na.R index 7da8070..85650fd 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 b72a4e7..cf8472d 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 31486ed..fd6c921 100644 --- a/R/to_labelled.R +++ b/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 diff --git a/R/val_labels.R b/R/val_labels.R index 8cb0166..73dc568 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 4b4ab62..1b3717f 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 9d39d6e..18d5131 100644 --- a/_pkgdown.yml +++ b/_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"] diff --git a/inst/WORDLIST b/inst/WORDLIST index 6f107d3..4e519c5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -10,7 +10,6 @@ Stata briatte cheatsheet df -dictionnary dplyr gmail joseph diff --git a/man/look_for.Rd b/man/look_for.Rd index ef90c28..fb85400 100644 --- a/man/look_for.Rd +++ b/man/look_for.Rd @@ -175,6 +175,9 @@ d \%>\% lookfor_to_long_format() \%>\% convert_list_columns_to_character() } +\seealso{ +\code{vignette("look_for")} +} \author{ François Briatte \href{mailto:f.briatte@gmail.com}{f.briatte@gmail.com}, Joseph Larmarange \href{mailto:joseph@larmarange.net}{joseph@larmarange.net} diff --git a/man/recode.haven_labelled.Rd b/man/recode.haven_labelled.Rd index 2f0f794..8a0b772 100644 --- a/man/recode.haven_labelled.Rd +++ b/man/recode.haven_labelled.Rd @@ -41,10 +41,10 @@ are not compatible, unmatched values are replaced with \code{NA}. replaced by this value. Must be either length 1 or the same length as \code{.x}.} -\item{.keep_value_labels}{If TRUE, keep original value labels. -If FALSE, remove value labels.} +\item{.keep_value_labels}{If \code{TRUE}, keep original value labels. +If \code{FALSE}, remove value labels.} -\item{.combine_value_labels}{If TRUE, will combine original value labels +\item{.combine_value_labels}{If \code{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.} diff --git a/man/to_labelled.Rd b/man/to_labelled.Rd index 6182301..fbc8f8e 100644 --- a/man/to_labelled.Rd +++ b/man/to_labelled.Rd @@ -70,8 +70,8 @@ So far, missing values defined in \strong{Stata} are always imported as \code{NA \code{\link[foreign:read.dta]{foreign::read.dta()}} and could not be retrieved by \code{foreign_to_labelled()}. If you convert a labelled vector into a factor with prefix, i.e. by using -\link[=to_factor]{to_factor(levels = "prefixed")}, \code{to_labelled.factor()} is able -to reconvert it to a labelled vector with same values and labels. +\code{\link[=to_factor]{to_factor(levels = "prefixed")}}, \code{to_labelled.factor()} is +able to reconvert it to a labelled vector with same values and labels. } \examples{ \dontrun{ diff --git a/tests/testthat/test-labelled.r b/tests/testthat/test-labelled.r index d9b49b2..65dc790 100644 --- a/tests/testthat/test-labelled.r +++ b/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") diff --git a/tests/testthat/test-na_values.R b/tests/testthat/test-na_values.R index a6e1413..26b1004 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 4c11b56..1360a4a 100644 --- a/vignettes/intro_labelled.Rmd +++ b/vignettes/labelled.Rmd @@ -491,7 +491,7 @@ If you are using the `%>%` operator, you can use the functions `set_variable_lab ```{r} library(dplyr) -df <- data_frame(s1 = c("M", "M", "F"), s2 = c(1, 1, 2)) %>% +df <- tibble(s1 = c("M", "M", "F"), s2 = c(1, 1, 2)) %>% set_variable_labels(s1 = "Sex", s2 = "Question") %>% set_value_labels(s1 = c(Male = "M", Female = "F"), s2 = c(Yes = 1, No = 2)) df$s2 @@ -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 d239158..901ce46 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} ---