From 211c01fa9d8d3c1927b0c8a93d8afb697885f9be Mon Sep 17 00:00:00 2001 From: Chris Hartgerink Date: Wed, 9 Oct 2024 11:27:37 +0200 Subject: [PATCH] Replace `tags` with `labels` The `labels()` is reexported from `datatagr`. Reexport is done because the labels function is valuable to the end user of linelist as well. --- R/has_tag.R | 2 +- R/labels.R | 3 +++ R/linelist-package.R | 6 ++--- R/make_linelist.R | 4 +-- R/names.R | 6 ++--- R/print.linelist.R | 2 +- R/prune_tags.R | 2 +- R/select_tags.R | 4 +-- R/set_tags.R | 12 ++++----- R/square_bracket.R | 8 +++--- R/tags.R | 40 ----------------------------- R/validate_tags.R | 4 +-- tests/testthat/test-compat-dplyr.R | 22 ++++++++-------- tests/testthat/test-make_linelist.R | 12 ++++----- tests/testthat/test-names.R | 2 +- tests/testthat/test-prune_tags.R | 2 +- tests/testthat/test-restore_tags.R | 8 +++--- tests/testthat/test-set_tags.R | 4 +-- tests/testthat/test-tags.R | 10 -------- vignettes/linelist.Rmd | 6 ++--- 20 files changed, 56 insertions(+), 103 deletions(-) create mode 100644 R/labels.R delete mode 100644 R/tags.R delete mode 100644 tests/testthat/test-tags.R diff --git a/R/has_tag.R b/R/has_tag.R index 33b2868f..9c0b39bb 100644 --- a/R/has_tag.R +++ b/R/has_tag.R @@ -33,7 +33,7 @@ has_tag <- function( ) { dat <- tidyselect::peek_data(fn = "has_tag") - dat_tags <- tags(dat) + dat_tags <- labels(dat) cols_to_extract <- dat_tags[names(dat_tags) %in% tags] diff --git a/R/labels.R b/R/labels.R new file mode 100644 index 00000000..fd58320e --- /dev/null +++ b/R/labels.R @@ -0,0 +1,3 @@ +#' @importFrom datatagr labels +#' @export +datatagr::labels diff --git a/R/linelist-package.R b/R/linelist-package.R index 35e08732..f0e08f82 100644 --- a/R/linelist-package.R +++ b/R/linelist-package.R @@ -17,7 +17,7 @@ #' #' * [set_tags()]: to change or add tagged variables in a `linelist` #' -#' * [tags()]: to get the list of tags of a `linelist` +#' * [labels()]: to get the list of tags of a `linelist` #' #' * [labels_df()]: to get a `data.frame` of all tagged variables #' @@ -62,7 +62,7 @@ #' x #' #' ## check tagged variables -#' tags(x) +#' labels(x) #' #' ## robust renaming #' names(x)[1] <- "identifier" @@ -108,7 +108,7 @@ #' select(has_tag(c("gender", "age"))) #' #' x %>% -#' tags() +#' labels() #' #' x %>% #' select(starts_with("date")) diff --git a/R/make_linelist.R b/R/make_linelist.R index af91a9a3..65c658d4 100644 --- a/R/make_linelist.R +++ b/R/make_linelist.R @@ -26,7 +26,7 @@ #' * An overview of the [linelist] package #' * [tags_names()]: for a list of known tag names #' * [tags_types()]: for the associated accepted types/classes -#' * [tags()]: for a list of tagged variables in a `linelist` +#' * [labels()]: for a list of tagged variables in a `linelist` #' * [set_tags()]: for modifying tags #' * [labels_df()]: for selecting variables by tags #' @@ -94,7 +94,7 @@ #' head(x) #' #' ## check tags -#' tags(x) +#' labels(x) #' #' ## Tags can also be passed as a list with the splice operator (!!!) #' my_tags <- list( diff --git a/R/names.R b/R/names.R index 69d880ee..92797b57 100644 --- a/R/names.R +++ b/R/names.R @@ -31,7 +31,7 @@ #' #' ## see results: tags have been updated #' head(x) -#' tags(x) +#' labels(x) #' #' # This also works with using `dplyr::rename()` because it uses names<-() #' # under hood @@ -39,7 +39,7 @@ #' x <- x %>% #' rename(case_id= case_label) #' head(x) -#' tags(x) +#' labels(x) #' } #' } `names<-.linelist` <- function(x, value) { @@ -66,7 +66,7 @@ } # Step 2 - out_tags <- tags(x, TRUE) + out_tags <- labels(x, TRUE) for (i in seq_along(out_tags)) { if (!is.null(out_tags[[i]])) { idx <- match(out_tags[[i]], old_names) diff --git a/R/print.linelist.R b/R/print.linelist.R index 629d9e0a..8882f8e2 100644 --- a/R/print.linelist.R +++ b/R/print.linelist.R @@ -42,7 +42,7 @@ print.linelist <- function(x, ...) { cat("\n// linelist object\n") print(datatagr::drop_datatagr(x, remove_labels = TRUE)) - tags_txt <- paste(names(tags(x)), unlist(tags(x)), sep = ":", collapse = ", ") + tags_txt <- paste(names(labels(x)), unlist(labels(x)), sep = ":", collapse = ", ") if (tags_txt == "") { tags_txt <- "[no tagged variable]" } diff --git a/R/prune_tags.R b/R/prune_tags.R index 3ca9493a..0d7ac92c 100644 --- a/R/prune_tags.R +++ b/R/prune_tags.R @@ -21,7 +21,7 @@ prune_tags <- function(x, lost_action = c("error", "warning", "none")) { lost_action <- match.arg(lost_action) # do stuff - old_tags <- tags(x, show_null = TRUE) + old_tags <- labels(x, show_null = TRUE) has_lost_column <- vapply( old_tags, diff --git a/R/select_tags.R b/R/select_tags.R index 2e7dc33e..e4539073 100644 --- a/R/select_tags.R +++ b/R/select_tags.R @@ -20,7 +20,7 @@ #' @export #' #' @seealso -#' * [tags()] for existing tags in a `linelist` +#' * [labels()] for existing tags in a `linelist` #' * [labels_df()] to get a `data.frame` of all tags #' #' @examples @@ -39,7 +39,7 @@ #' head(x) #' #' ## check tagged variables -#' tags(x) +#' labels(x) #' #' # DEPRECATED! #' select_tags(x, "gender", "age") diff --git a/R/set_tags.R b/R/set_tags.R index 68f1dd89..0876fef6 100644 --- a/R/set_tags.R +++ b/R/set_tags.R @@ -17,7 +17,7 @@ #' if (require(outbreaks)) { #' ## create a linelist #' x <- make_linelist(measles_hagelloch_1861, date_onset = "date_of_rash") -#' tags(x) +#' labels(x) #' #' ## add new tags and fix an existing one #' x <- set_tags(x, @@ -25,20 +25,20 @@ #' gender = "gender", #' date_onset = "date_of_prodrome" #' ) -#' tags(x) +#' labels(x) #' #' ## add non-default tags using allow_extra #' x <- set_tags(x, severe = "complications", allow_extra = TRUE) -#' tags(x) +#' labels(x) #' #' ## remove tags by setting them to NULL -#' old_tags <- tags(x) +#' old_tags <- labels(x) #' x <- set_tags(x, age = NULL, gender = NULL) -#' tags(x) +#' labels(x) #' #' ## setting tags providing a list (used to restore old tags here) #' x <- set_tags(x, !!!old_tags) -#' tags(x) +#' labels(x) #' } #' set_tags <- function(x, ..., allow_extra = FALSE) { diff --git a/R/square_bracket.R b/R/square_bracket.R index 6d66208d..5fc1226a 100644 --- a/R/square_bracket.R +++ b/R/square_bracket.R @@ -94,7 +94,7 @@ } # Case 2 - old_tags <- tags(x, show_null = TRUE) + old_tags <- labels(x, show_null = TRUE) out <- restore_tags(out, old_tags, lost_action) out @@ -107,7 +107,7 @@ `[<-.linelist` <- function(x, i, j, value) { lost_action <- get_lost_tags_action() out <- NextMethod() - old_tags <- tags(x, show_null = TRUE) + old_tags <- labels(x, show_null = TRUE) out <- restore_tags(out, old_tags, lost_action) out } @@ -119,7 +119,7 @@ `[[<-.linelist` <- function(x, i, j, value) { lost_action <- get_lost_tags_action() out <- NextMethod() - old_tags <- tags(x, show_null = TRUE) + old_tags <- labels(x, show_null = TRUE) out <- restore_tags(out, old_tags, lost_action) out } @@ -130,7 +130,7 @@ `$<-.linelist` <- function(x, name, value) { lost_action <- get_lost_tags_action() out <- NextMethod() - old_tags <- tags(x, show_null = TRUE) + old_tags <- labels(x, show_null = TRUE) out <- restore_tags(out, old_tags, lost_action) out } diff --git a/R/tags.R b/R/tags.R deleted file mode 100644 index 76129339..00000000 --- a/R/tags.R +++ /dev/null @@ -1,40 +0,0 @@ -#' Get the list of tags in a linelist -#' -#' This function returns the list of tags identifying specific variable types in -#' a `linelist`. -#' -#' @param x a `linelist` object -#' -#' @param show_null a `logical` indicating if the complete list of tags, -#' including `NULL` ones, should be returned; if `FALSE`, only tags with a -#' non-NULL value are returned; defaults to `FALSE` -#' -#' @export -#' -#' @return The function returns a named `list` where names indicate generic -#' types of data, and values indicate which column they correspond to. -#' -#' @details Tags are stored as the `tags` attribute of the object. -#' -#' @examples -#' -#' if (require(outbreaks)) { -#' ## make a linelist -#' x <- make_linelist(measles_hagelloch_1861, date_onset = "date_of_prodrome") -#' -#' ## check non-null tags -#' tags(x) -#' -#' ## get a list of all tags, including NULL ones -#' tags(x, TRUE) -#' } -#' -tags <- function(x, show_null = FALSE) { - checkmate::assertClass(x, "linelist") - out <- attr(x, "tags") - if (!show_null) { - to_remove <- vapply(out, is.null, logical(1)) - out <- out[!to_remove] - } - out -} diff --git a/R/validate_tags.R b/R/validate_tags.R index 84d7d5f2..9b5d7568 100644 --- a/R/validate_tags.R +++ b/R/validate_tags.R @@ -41,7 +41,7 @@ #' } validate_tags <- function(x, allow_extra = FALSE) { checkmate::assert_class(x, "linelist") - x_tags <- tags(x, show_null = TRUE) + x_tags <- labels(x, show_null = TRUE) stopifnot( "`x` has no tags attribute" = !is.null(x_tags) @@ -76,7 +76,7 @@ validate_tags <- function(x, allow_extra = FALSE) { } # check that tagged variables exist - x_tags_vec <- unlist(tags(x)) + x_tags_vec <- unlist(labels(x)) var_exists <- x_tags_vec %in% names(x) if (!all(var_exists)) { missing_var <- x_tags_vec[!var_exists] diff --git a/tests/testthat/test-compat-dplyr.R b/tests/testthat/test-compat-dplyr.R index 1751d04e..4e9a6b55 100644 --- a/tests/testthat/test-compat-dplyr.R +++ b/tests/testthat/test-compat-dplyr.R @@ -35,8 +35,8 @@ test_that("Compatibility with dplyr::filter()", { # nolint end: expect_named_linter expect_identical( - tags(dplyr::filter(x, dist > mean(dist))), - tags(x) + labels(dplyr::filter(x, dist > mean(dist))), + labels(x) ) }) @@ -75,8 +75,8 @@ test_that("Compatibility with dplyr::mutate(.keep)", { x %>% dplyr::mutate(speed = as.integer(speed)) %>% expect_s3_class("linelist") %>% - tags() %>% - expect_identical(tags(x)) + labels() %>% + expect_identical(labels(x)) }) @@ -105,7 +105,7 @@ test_that("Compatibility with dplyr::relocate()", { test_that("Compatibility with dplyr::rename()", { expect_identical( - tags(dplyr::rename(x, toto = dist)), + labels(dplyr::rename(x, toto = dist)), list(date_onset = "toto", date_outcome = "speed") ) @@ -124,8 +124,8 @@ test_that("Compatibility with dplyr::rename()", { test_that("Compatibility with dplyr::rename_with()", { expect_identical( - tags(dplyr::rename_with(x, toupper)), - lapply(tags(x), toupper) + labels(dplyr::rename_with(x, toupper)), + lapply(labels(x), toupper) ) # Identity @@ -145,7 +145,7 @@ test_that("Compatibility with dplyr::select()", { x %>% dplyr::select("dist") %>% expect_s3_class("linelist") %>% - tags() %>% + labels() %>% expect_identical(list(date_onset = "dist")) %>% expect_snapshot_warning() @@ -153,7 +153,7 @@ test_that("Compatibility with dplyr::select()", { x %>% dplyr::select(dist, vitesse = speed) %>% expect_s3_class("linelist") %>% - tags() %>% + labels() %>% expect_identical(list(date_onset = "dist", date_outcome = "vitesse")) }) @@ -165,8 +165,8 @@ test_that("Compatibility with dplyr::bind_rows()", { rbound_x <- dplyr::bind_rows(x, x) expect_identical( - tags(x), - tags(rbound_x) + labels(x), + labels(rbound_x) ) expect_s3_class( diff --git a/tests/testthat/test-make_linelist.R b/tests/testthat/test-make_linelist.R index 23bd13ad..960f0b24 100644 --- a/tests/testthat/test-make_linelist.R +++ b/tests/testthat/test-make_linelist.R @@ -23,17 +23,17 @@ test_that("tests for make_linelist", { ) # test functionalities - expect_identical(tags_defaults(), tags(make_linelist(cars), TRUE)) + expect_identical(tags_defaults(), labels(make_linelist(cars), TRUE)) x <- make_linelist(cars, date_onset = "dist", date_outcome = "speed") - expect_identical(tags(x)$date_onset, "dist") - expect_identical(tags(x)$date_outcome, "speed") - expect_null(tags(x)$outcome) - expect_null(tags(x)$date_reporting) + expect_identical(labels(x)$date_onset, "dist") + expect_identical(labels(x)$date_outcome, "speed") + expect_null(labels(x)$outcome) + expect_null(labels(x)$date_reporting) x <- make_linelist(cars, foo = "speed", bar = "dist", allow_extra = TRUE) expect_identical( - tags(x, TRUE), + labels(x, TRUE), c(tags_defaults(), foo = "speed", bar = "dist") ) diff --git a/tests/testthat/test-names.R b/tests/testthat/test-names.R index 0a0783bc..30dc6655 100644 --- a/tests/testthat/test-names.R +++ b/tests/testthat/test-names.R @@ -15,7 +15,7 @@ test_that("tests for the names<- operator", { # functionalities names(x) <- c("titi", "toto") expect_named(x, c("titi", "toto")) - expect_identical(tags(x), list(id = "titi", age = "toto")) + expect_identical(labels(x), list(id = "titi", age = "toto")) expect_s3_class(x, old_class) names(x) <- old_names expect_identical(x, old_x) diff --git a/tests/testthat/test-prune_tags.R b/tests/testthat/test-prune_tags.R index db787686..c463ca94 100644 --- a/tests/testthat/test-prune_tags.R +++ b/tests/testthat/test-prune_tags.R @@ -16,7 +16,7 @@ test_that("tests for prune_tags", { # Check functionality y <- prune_tags(x, "none") - expect_identical(tags_defaults(), tags(y, TRUE)) + expect_identical(tags_defaults(), labels(y, TRUE)) expect_s3_class(y, "linelist") }) diff --git a/tests/testthat/test-restore_tags.R b/tests/testthat/test-restore_tags.R index bc71a885..9de337b3 100644 --- a/tests/testthat/test-restore_tags.R +++ b/tests/testthat/test-restore_tags.R @@ -10,10 +10,10 @@ test_that("tests for restore_tags", { " date_onset:dist, age:speed", sep = "\n" ) - expect_error(restore_tags(z, tags(x), "error"), msg) - expect_warning(restore_tags(z, tags(x), "warning"), msg) + expect_error(restore_tags(z, labels(x), "error"), msg) + expect_warning(restore_tags(z, labels(x), "warning"), msg) # Check functionality - expect_identical(x, restore_tags(x, tags(x))) - expect_identical(x, restore_tags(y, tags(x))) + expect_identical(x, restore_tags(x, labels(x))) + expect_identical(x, restore_tags(y, labels(x))) }) diff --git a/tests/testthat/test-set_tags.R b/tests/testthat/test-set_tags.R index 556e3c2c..261e59dd 100644 --- a/tests/testthat/test-set_tags.R +++ b/tests/testthat/test-set_tags.R @@ -15,8 +15,8 @@ test_that("tests for set_tags()", { # Check functionality expect_identical(x, set_tags(x)) x <- set_tags(x, date_reporting = "speed") - expect_identical(tags(x)$date_reporting, "speed") - expect_identical(tags(x)$date_onset, "dist") + expect_identical(labels(x)$date_reporting, "speed") + expect_identical(labels(x)$date_onset, "dist") x <- set_tags(x, id = "speed", date_outcome = "dist") y <- set_tags(x, !!!list(id = "speed", date_outcome = "dist")) diff --git a/tests/testthat/test-tags.R b/tests/testthat/test-tags.R deleted file mode 100644 index 00f03ed5..00000000 --- a/tests/testthat/test-tags.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("tests for tags", { - - # Check error messages - x <- make_linelist(cars, age = "speed") - - # Check functionality - expect_identical(tags(x), list(age = "speed")) - expect_identical(tags(x, TRUE), attr(x, "tags")) - expect_identical(tags(make_linelist(cars), TRUE), tags_defaults()) -}) diff --git a/vignettes/linelist.Rmd b/vignettes/linelist.Rmd index dfda0c19..f05f2244 100644 --- a/vignettes/linelist.Rmd +++ b/vignettes/linelist.Rmd @@ -134,7 +134,7 @@ existing tags and the corresponding variables. * `set_tags()`: to add, remove, or modify tags in a `linelist` -* `tags()`: to list variables which have been tagged in a `linelist` +* `labels()`: to list variables which have been tagged in a `linelist` * `tags_names()`: to list all recognized tag names; details on what the tags represent can be found at [`?make_linelist`](https://epiverse-trace.github.io/linelist/reference/make_linelist.html) @@ -219,7 +219,7 @@ The printing of the object confirms that the tags have been added. If we want to double-check which variables have been tagged: ```{r} -tags(x) +labels(x) ``` @@ -248,7 +248,7 @@ it to `NULL`: ```{r} x <- x %>% set_tags(outcome = NULL) -tags(x) +labels(x) ```