diff --git a/DESCRIPTION b/DESCRIPTION index fb98d58..ab1cbb9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,6 @@ Suggests: dplyr, knitr, magrittr, - outbreaks, rmarkdown, spelling, testthat, diff --git a/R/datatagr-package.R b/R/datatagr-package.R index 86aeb9c..2b02ba5 100644 --- a/R/datatagr-package.R +++ b/R/datatagr-package.R @@ -43,73 +43,60 @@ #' #' @examples #' -#' if (require(outbreaks)) { -#' # using base R style +#' # using base R style +#' x <- make_datatagr(cars[1:50, ], +#' mph = "speed", +#' distance = "dist" +#' ) +#' x #' -#' ## dataset we'll create a datatagr from, only using the first 50 entries -#' measles_hagelloch_1861[1:50, ] +#' ## check tagged variables +#' tags(x) #' -#' ## create datatagr -#' x <- make_datatagr(measles_hagelloch_1861[1:50, ], -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) -#' x +#' ## robust renaming +#' names(x)[1] <- "identifier" +#' x #' -#' ## check tagged variables -#' tags(x) +#' ## example of dropping tags by mistake - default: warning +#' x[, 2] #' -#' ## robust renaming -#' names(x)[1] <- "identifier" -#' x +#' ## to silence warnings when taggs are dropped +#' lost_tags_action("none") +#' x[, 2] #' -#' ## example of dropping tags by mistake - default: warning -#' x[, 2:5] +#' ## to trigger errors when taggs are dropped +#' # lost_tags_action("error") +#' # x[, 2:5] #' -#' ## to silence warnings when taggs are dropped -#' lost_tags_action("none") -#' x[, 2:5] +#' ## reset default behaviour +#' lost_tags_action() #' -#' ## to trigger errors when taggs are dropped -#' # lost_tags_action("error") -#' # x[, 2:5] +#' # using tidyverse style #' -#' ## reset default behaviour -#' lost_tags_action() +#' ## example of creating a datatagr, adding a new variable, and adding a tag +#' ## for it #' +#' if (require(dplyr) && require(magrittr)) { +#' x <- cars %>% +#' tibble() %>% +#' make_datatagr( +#' mph = "speed", +#' distance = "dist" +#' ) %>% +#' mutate(result = if_else(speed > 50, "fast", "slow")) %>% +#' set_tags(ticket = "result") #' -#' # using tidyverse style +#' head(x) #' -#' ## example of creating a datatagr, adding a new variable, and adding a tag -#' ## for it +#' ## extract tagged variables +#' x %>% +#' select(has_tag(c("mph", "distance"))) #' -#' if (require(dplyr) && require(magrittr)) { -#' x <- measles_hagelloch_1861 %>% -#' tibble() %>% -#' make_datatagr( -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) %>% -#' mutate(result = if_else(is.na(date_of_death), "survived", "died")) %>% -#' set_tags(outcome = "result") %>% -#' rename(identifier = case_ID) +#' x %>% +#' tags() #' -#' head(x) -#' -#' ## extract tagged variables -#' x %>% -#' select(has_tag(c("gender", "age"))) -#' -#' x %>% -#' tags() -#' -#' x %>% -#' select(starts_with("date")) -#' } +#' x %>% +#' select(starts_with("dist")) #' } #' #' @keywords internal diff --git a/R/has_tag.R b/R/has_tag.R index 84ddac1..6ce2497 100644 --- a/R/has_tag.R +++ b/R/has_tag.R @@ -9,21 +9,16 @@ #' @export #' #' @examples -#' if (require(outbreaks) && require(dplyr)) { -#' ## dataset we'll create a datatagr from -#' measles_hagelloch_1861 -#' -#' ## create datatagr -#' x <- make_datatagr(measles_hagelloch_1861, -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) -#' head(x) +#' ## create datatagr +#' x <- make_datatagr(cars, +#' mph = "speed", +#' distance = "dist" +#' ) +#' head(x) #' +#' if (require(dplyr) && require(magrittr)) { #' x %>% -#' select(has_tag(c("id", "age"))) %>% +#' select(has_tag(c("mph", "distance"))) %>% #' head() #' } has_tag <- function( diff --git a/R/make_datatagr.R b/R/make_datatagr.R index c8e78c0..6ab8c41 100644 --- a/R/make_datatagr.R +++ b/R/make_datatagr.R @@ -33,7 +33,7 @@ #' @examples #' #' x <- make_datatagr(cars, -#' age = "speed", +#' mph = "speed", #' distance = "dist" #' ) #' @@ -45,7 +45,7 @@ #' #' ## Tags can also be passed as a list with the splice operator (!!!) #' my_tags <- list( -#' age = "speed", +#' mph = "speed", #' distance = "dist" #' ) #' new_x <- make_datatagr(cars, !!!my_tags) diff --git a/R/names.R b/R/names.R index 65aa187..0713977 100644 --- a/R/names.R +++ b/R/names.R @@ -12,34 +12,27 @@ #' @export #' #' @examples -#' if (require(outbreaks)) { -#' ## dataset to create a datatagr from -#' measles_hagelloch_1861 +#' ## create datatagr +#' x <- make_datatagr(cars, +#' mph = "speed", +#' distance = "dist" +#' ) +#' head(x) #' -#' ## create datatagr -#' x <- make_datatagr(measles_hagelloch_1861, -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) -#' head(x) +#' ## change names +#' names(x)[1] <- "speed in miles" #' -#' ## change names -#' names(x)[1] <- "case_label" +#' ## see results: tags have been updated +#' head(x) +#' tags(x) #' -#' ## see results: tags have been updated +#' # This also works with using `dplyr::rename()` because it uses names<-() +#' # under the hood +#' if (require(dplyr) && require(magrittr)) { +#' x <- x %>% +#' rename(speed = "speed in miles") #' head(x) #' tags(x) -#' -#' # This also works with using `dplyr::rename()` because it uses names<-() -#' # under hood -#' if (require(dplyr)) { -#' x <- x %>% -#' rename(case_id = case_label) -#' head(x) -#' tags(x) -#' } #' } `names<-.datatagr` <- function(x, value) { # Strategy for renaming diff --git a/R/print.datatagr.R b/R/print.datatagr.R index d3f3cbe..a85c61a 100644 --- a/R/print.datatagr.R +++ b/R/print.datatagr.R @@ -11,32 +11,23 @@ #' @export #' #' @examples -#' if (require(outbreaks)) { -#' ## dataset we'll create a datatagr from -#' measles_hagelloch_1861 -#' -#' ## create datatagr -#' x <- make_datatagr(measles_hagelloch_1861, -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) -#' -#' ## print object - using only the first few entries -#' head(x) -#' -#' # version with a tibble -#' if (require(tibble) && require(magrittr)) { -#' measles_hagelloch_1861 %>% -#' tibble() %>% -#' make_datatagr( -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) -#' } +#' ## create datatagr +#' x <- make_datatagr(cars, +#' mph = "speed", +#' distance = "dist" +#' ) +#' +#' ## print object - using only the first few entries +#' head(x) +#' +#' # version with a tibble +#' if (require(tibble) && require(magrittr)) { +#' cars %>% +#' tibble() %>% +#' make_datatagr( +#' mph = "speed", +#' distance = "dist" +#' ) #' } print.datatagr <- function(x, ...) { cat("\n// datatagr object\n") diff --git a/R/set_tags.R b/R/set_tags.R index f646891..446bf41 100644 --- a/R/set_tags.R +++ b/R/set_tags.R @@ -14,33 +14,22 @@ #' #' @examples #' -#' if (require(outbreaks)) { -#' ## create a datatagr -#' x <- make_datatagr(measles_hagelloch_1861, date_onset = "date_of_rash") -#' tags(x) -#' -#' ## add new tags and fix an existing one -#' x <- set_tags(x, -#' age = "age", -#' gender = "gender", -#' date_onset = "date_of_prodrome" -#' ) -#' tags(x) -#' -#' ## add non-default tags using allow_extra -#' x <- set_tags(x, severe = "complications", allow_extra = TRUE) -#' tags(x) -#' -#' ## remove tags by setting them to NULL -#' old_tags <- tags(x) -#' x <- set_tags(x, age = NULL, gender = NULL) -#' tags(x) -#' -#' ## setting tags providing a list (used to restore old tags here) -#' x <- set_tags(x, !!!old_tags) -#' tags(x) -#' } -#' +#' ## create a datatagr +#' x <- make_datatagr(cars, mph = "speed") +#' tags(x) +#' +#' ## add new tags and fix an existing one +#' x <- set_tags(x, distance = "dist") +#' tags(x) +#' +#' ## remove tags by setting them to NULL +#' old_tags <- tags(x) +#' x <- set_tags(x, mph = NULL, distance = NULL) +#' tags(x) +#' +#' ## setting tags providing a list (used to restore old tags here) +#' x <- set_tags(x, !!!old_tags) +#' tags(x) set_tags <- function(x, ..., tag_defaults = list(), allow_extra = TRUE) { # assert inputs checkmate::assertClass(x, "datatagr") diff --git a/R/square_bracket.R b/R/square_bracket.R index a9ccefb..eaec999 100644 --- a/R/square_bracket.R +++ b/R/square_bracket.R @@ -30,18 +30,15 @@ #' @aliases sub_datatagr #' #' @examples -#' if (require(outbreaks) && require(dplyr) && require(magrittr)) { +#' if (require(dplyr) && require(magrittr)) { #' ## create a datatagr -#' x <- measles_hagelloch_1861 %>% +#' x <- cars %>% #' make_datatagr( -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" +#' mph = "speed", +#' distance = "dist" #' ) %>% -#' mutate(result = if_else(is.na(date_of_death), "survived", "died")) %>% -#' set_tags(outcome = "result") %>% -#' rename(identifier = case_ID) +#' mutate(result = if_else(speed > 50, "fast", "slow")) %>% +#' set_tags(ticket = "result") #' x #' #' ## dangerous removal of a tagged column setting it to NULL issues a warning diff --git a/R/tags.R b/R/tags.R index e954616..5fef713 100644 --- a/R/tags.R +++ b/R/tags.R @@ -18,17 +18,14 @@ #' #' @examples #' -#' if (require(outbreaks)) { -#' ## make a datatagr -#' x <- make_datatagr(measles_hagelloch_1861, date_onset = "date_of_prodrome") +#' ## make a datatagr +#' x <- make_datatagr(cars, mph = "speed") #' -#' ## check non-null tags -#' tags(x) -#' -#' ## get a list of all tags, including NULL ones -#' tags(x, TRUE) -#' } +#' ## 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, "datatagr") out <- attr(x, "tags") diff --git a/R/tags_df.R b/R/tags_df.R index b4eaf73..662da4f 100644 --- a/R/tags_df.R +++ b/R/tags_df.R @@ -12,20 +12,13 @@ #' #' @examples #' -#' if (require(outbreaks) && require(magrittr)) { -#' ## create a tibble datatagr -#' x <- measles_hagelloch_1861 %>% -#' make_datatagr( -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" -#' ) -#' x +#' x <- make_datatagr(cars, +#' mph = "speed", +#' distance = "dist" +#' ) #' -#' ## get a data.frame of all tagged variables -#' tags_df(x) -#' } +#' ## get a data.frame of all tagged variables +#' tags_df(x) tags_df <- function(x) { checkmate::assertClass(x, "datatagr") tags <- unlist(tags(x)) diff --git a/R/validate_datatagr.R b/R/validate_datatagr.R index 39a6dcc..c57d128 100644 --- a/R/validate_datatagr.R +++ b/R/validate_datatagr.R @@ -31,37 +31,27 @@ #' #' @examples #' -#' if (require(outbreaks) && require(magrittr)) { +#' if (require(magrittr)) { #' ## create a valid datatagr -#' x <- measles_hagelloch_1861 %>% +#' x <- cars %>% #' make_datatagr( -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" +#' mph = "speed", +#' distance = "dist" #' ) #' x #' #' ## validation #' validate_datatagr(x, ref_types = tags_types( -#' id = c("integer", "factor"), -#' date_onset = "Date", -#' age = "numeric", -#' gender = c("factor", "character") +#' mph = c("numeric", "factor"), +#' distance = "numeric" #' )) #' -#' ## create an invalid datatagr - onset date is a factor -#' x <- measles_hagelloch_1861 %>% -#' make_datatagr( -#' id = "case_ID", -#' date_onset = "gender", -#' age = "age" -#' ) -#' x -#' #' ## the below issues an error #' ## note: tryCatch is only used to avoid a genuine error in the example -#' tryCatch(validate_datatagr(x), error = paste) +#' tryCatch(validate_datatagr(x, ref_types = tags_types( +#' mph = c("numeric", "factor"), +#' distance = "factor" +#' )), error = paste) #' } validate_datatagr <- function(x, ref_types = tags_types()) { diff --git a/R/validate_tags.R b/R/validate_tags.R index 46ad21a..956e751 100644 --- a/R/validate_tags.R +++ b/R/validate_tags.R @@ -15,31 +15,24 @@ #' the right classes #' #' @examples -#' if (require(outbreaks) && require(magrittr)) { +#' if (require(dplyr) && require(magrittr)) { #' ## create a valid datatagr -#' x <- measles_hagelloch_1861 %>% +#' x <- cars %>% #' make_datatagr( -#' id = "case_ID", -#' date_onset = "date_of_prodrome", -#' age = "age", -#' gender = "gender" +#' mph = "speed", +#' distance = "dist" #' ) #' x #' -#' ## validation +#' ## the below issues an error as datatagr doesn't know any defaults +#' ## note: tryCatch is only used to avoid a genuine error in the example +#' tryCatch(validate_datatagr(x), error = paste) +#' +#' ## validation requires you to specify the types directly #' validate_datatagr(x, ref_types = tags_types( -#' id = c("integer", "factor"), -#' date_onset = "Date", -#' age = "numeric", -#' gender = c("factor", "character") +#' mph = c("integer", "numeric"), +#' distance = "numeric" #' )) -#' -#' ## hack to create an invalid tags (missing defaults) -#' attr(x, "tags") <- list(id = "case_ID") -#' -#' ## the below issues an error -#' ## note: tryCatch is only used to avoid a genuine error in the example -#' tryCatch(validate_tags(x), error = paste) #' } validate_tags <- function(x) { checkmate::assert_class(x, "datatagr") diff --git a/R/validate_types.R b/R/validate_types.R index 0eca71d..e73f6d7 100644 --- a/R/validate_types.R +++ b/R/validate_types.R @@ -18,25 +18,22 @@ #' * [validate_datatagr()] to combine `validate_tags` and `validate_types` #' #' @examples -#' if (require(outbreaks) && require(magrittr)) { -#' ## create an invalid datatagr - gender is a numeric -#' x <- measles_hagelloch_1861 %>% -#' make_datatagr( -#' id = "case_ID", -#' gender = "infector" -#' ) -#' x +#' x <- make_datatagr(cars, +#' mph = "speed", +#' distance = "dist" +#' ) +#' x #' -#' ## the below would issue an error -#' ## note: tryCatch is only used to avoid a genuine error in the example -#' tryCatch(validate_types(x), error = paste) +#' ## the below would issue an error +#' ## note: tryCatch is only used to avoid a genuine error in the example +#' tryCatch(validate_types(x), error = paste) +#' +#' ## to allow other types, e.g. gender to be integer, character or factor +#' validate_types(x, tags_types(mph = "numeric", distance = c( +#' "integer", +#' "character", "numeric" +#' ))) #' -#' ## to allow other types, e.g. gender to be integer, character or factor -#' validate_types(x, tags_types(id = "integer", gender = c( -#' "integer", -#' "character", "factor" -#' ))) -#' } validate_types <- function(x, ref_types = tags_types()) { checkmate::assert_class(x, "datatagr") diff --git a/man/datatagr-package.Rd b/man/datatagr-package.Rd index 49aba4c..7a24797 100644 --- a/man/datatagr-package.Rd +++ b/man/datatagr-package.Rd @@ -46,73 +46,60 @@ desired behaviour when tagged variables are lost \examples{ -if (require(outbreaks)) { - # using base R style +# using base R style +x <- make_datatagr(cars[1:50, ], + mph = "speed", + distance = "dist" +) +x - ## dataset we'll create a datatagr from, only using the first 50 entries - measles_hagelloch_1861[1:50, ] +## check tagged variables +tags(x) - ## create datatagr - x <- make_datatagr(measles_hagelloch_1861[1:50, ], - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) - x +## robust renaming +names(x)[1] <- "identifier" +x - ## check tagged variables - tags(x) +## example of dropping tags by mistake - default: warning +x[, 2] - ## robust renaming - names(x)[1] <- "identifier" - x +## to silence warnings when taggs are dropped +lost_tags_action("none") +x[, 2] - ## example of dropping tags by mistake - default: warning - x[, 2:5] +## to trigger errors when taggs are dropped +# lost_tags_action("error") +# x[, 2:5] - ## to silence warnings when taggs are dropped - lost_tags_action("none") - x[, 2:5] +## reset default behaviour +lost_tags_action() - ## to trigger errors when taggs are dropped - # lost_tags_action("error") - # x[, 2:5] +# using tidyverse style - ## reset default behaviour - lost_tags_action() +## example of creating a datatagr, adding a new variable, and adding a tag +## for it +if (require(dplyr) && require(magrittr)) { + x <- cars \%>\% + tibble() \%>\% + make_datatagr( + mph = "speed", + distance = "dist" + ) \%>\% + mutate(result = if_else(speed > 50, "fast", "slow")) \%>\% + set_tags(ticket = "result") - # using tidyverse style + head(x) - ## example of creating a datatagr, adding a new variable, and adding a tag - ## for it + ## extract tagged variables + x \%>\% + select(has_tag(c("mph", "distance"))) - if (require(dplyr) && require(magrittr)) { - x <- measles_hagelloch_1861 \%>\% - tibble() \%>\% - make_datatagr( - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) \%>\% - mutate(result = if_else(is.na(date_of_death), "survived", "died")) \%>\% - set_tags(outcome = "result") \%>\% - rename(identifier = case_ID) + x \%>\% + tags() - head(x) - - ## extract tagged variables - x \%>\% - select(has_tag(c("gender", "age"))) - - x \%>\% - tags() - - x \%>\% - select(starts_with("date")) - } + x \%>\% + select(starts_with("dist")) } } diff --git a/man/has_tag.Rd b/man/has_tag.Rd index f9637b7..ab528ee 100644 --- a/man/has_tag.Rd +++ b/man/has_tag.Rd @@ -18,21 +18,16 @@ requested tags A selector function to use in \pkg{tidyverse} functions } \examples{ -if (require(outbreaks) && require(dplyr)) { - ## dataset we'll create a datatagr from - measles_hagelloch_1861 - - ## create datatagr - x <- make_datatagr(measles_hagelloch_1861, - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) - head(x) +## create datatagr +x <- make_datatagr(cars, + mph = "speed", + distance = "dist" +) +head(x) +if (require(dplyr) && require(magrittr)) { x \%>\% - select(has_tag(c("id", "age"))) \%>\% + select(has_tag(c("mph", "distance"))) \%>\% head() } } diff --git a/man/make_datatagr.Rd b/man/make_datatagr.Rd index 5a82bca..fab9dbf 100644 --- a/man/make_datatagr.Rd +++ b/man/make_datatagr.Rd @@ -32,7 +32,7 @@ fields for further data cleaning and analysis. \examples{ x <- make_datatagr(cars, - age = "speed", + mph = "speed", distance = "dist" ) @@ -44,7 +44,7 @@ tags(x) ## Tags can also be passed as a list with the splice operator (!!!) my_tags <- list( - age = "speed", + mph = "speed", distance = "dist" ) new_x <- make_datatagr(cars, !!!my_tags) diff --git a/man/names-set-.datatagr.Rd b/man/names-set-.datatagr.Rd index ec9b985..fd877dc 100644 --- a/man/names-set-.datatagr.Rd +++ b/man/names-set-.datatagr.Rd @@ -19,33 +19,26 @@ This function can be used to rename the columns a \code{datatagr}, adjusting tag as needed. } \examples{ -if (require(outbreaks)) { - ## dataset to create a datatagr from - measles_hagelloch_1861 +## create datatagr +x <- make_datatagr(cars, + mph = "speed", + distance = "dist" +) +head(x) - ## create datatagr - x <- make_datatagr(measles_hagelloch_1861, - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) - head(x) +## change names +names(x)[1] <- "speed in miles" - ## change names - names(x)[1] <- "case_label" +## see results: tags have been updated +head(x) +tags(x) - ## see results: tags have been updated +# This also works with using `dplyr::rename()` because it uses names<-() +# under the hood +if (require(dplyr) && require(magrittr)) { + x <- x \%>\% + rename(speed = "speed in miles") head(x) tags(x) - - # This also works with using `dplyr::rename()` because it uses names<-() - # under hood - if (require(dplyr)) { - x <- x \%>\% - rename(case_id = case_label) - head(x) - tags(x) - } } } diff --git a/man/print.datatagr.Rd b/man/print.datatagr.Rd index 74b77b0..a0bb217 100644 --- a/man/print.datatagr.Rd +++ b/man/print.datatagr.Rd @@ -18,31 +18,22 @@ Invisibly returns the object. This function prints datatagr objects. } \examples{ -if (require(outbreaks)) { - ## dataset we'll create a datatagr from - measles_hagelloch_1861 +## create datatagr +x <- make_datatagr(cars, + mph = "speed", + distance = "dist" +) - ## create datatagr - x <- make_datatagr(measles_hagelloch_1861, - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) +## print object - using only the first few entries +head(x) - ## print object - using only the first few entries - head(x) - - # version with a tibble - if (require(tibble) && require(magrittr)) { - measles_hagelloch_1861 \%>\% - tibble() \%>\% - make_datatagr( - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) - } +# version with a tibble +if (require(tibble) && require(magrittr)) { + cars \%>\% + tibble() \%>\% + make_datatagr( + mph = "speed", + distance = "dist" + ) } } diff --git a/man/set_tags.Rd b/man/set_tags.Rd index 535d270..d426462 100644 --- a/man/set_tags.Rd +++ b/man/set_tags.Rd @@ -30,33 +30,22 @@ missing, they will be added to the final object. } \examples{ -if (require(outbreaks)) { - ## create a datatagr - x <- make_datatagr(measles_hagelloch_1861, date_onset = "date_of_rash") - tags(x) - - ## add new tags and fix an existing one - x <- set_tags(x, - age = "age", - gender = "gender", - date_onset = "date_of_prodrome" - ) - tags(x) - - ## add non-default tags using allow_extra - x <- set_tags(x, severe = "complications", allow_extra = TRUE) - tags(x) - - ## remove tags by setting them to NULL - old_tags <- tags(x) - x <- set_tags(x, age = NULL, gender = NULL) - tags(x) - - ## setting tags providing a list (used to restore old tags here) - x <- set_tags(x, !!!old_tags) - tags(x) -} - +## create a datatagr +x <- make_datatagr(cars, mph = "speed") +tags(x) + +## add new tags and fix an existing one +x <- set_tags(x, distance = "dist") +tags(x) + +## remove tags by setting them to NULL +old_tags <- tags(x) +x <- set_tags(x, mph = NULL, distance = NULL) +tags(x) + +## setting tags providing a list (used to restore old tags here) +x <- set_tags(x, !!!old_tags) +tags(x) } \seealso{ \code{\link[=make_datatagr]{make_datatagr()}} to create a \code{datatagr} object diff --git a/man/sub_datatagr.Rd b/man/sub_datatagr.Rd index 2341065..3858642 100644 --- a/man/sub_datatagr.Rd +++ b/man/sub_datatagr.Rd @@ -48,18 +48,15 @@ takes the appropriate action if this is the case (warning, error, or ignore, depending on the general option set via \code{\link[=lost_tags_action]{lost_tags_action()}}) . } \examples{ -if (require(outbreaks) && require(dplyr) && require(magrittr)) { +if (require(dplyr) && require(magrittr)) { ## create a datatagr - x <- measles_hagelloch_1861 \%>\% + x <- cars \%>\% make_datatagr( - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" + mph = "speed", + distance = "dist" ) \%>\% - mutate(result = if_else(is.na(date_of_death), "survived", "died")) \%>\% - set_tags(outcome = "result") \%>\% - rename(identifier = case_ID) + mutate(result = if_else(speed > 50, "fast", "slow")) \%>\% + set_tags(ticket = "result") x ## dangerous removal of a tagged column setting it to NULL issues a warning diff --git a/man/tags.Rd b/man/tags.Rd index 2b46803..e359724 100644 --- a/man/tags.Rd +++ b/man/tags.Rd @@ -26,15 +26,12 @@ Tags are stored as the \code{tags} attribute of the object. } \examples{ -if (require(outbreaks)) { - ## make a datatagr - x <- make_datatagr(measles_hagelloch_1861, date_onset = "date_of_prodrome") +## make a datatagr +x <- make_datatagr(cars, mph = "speed") - ## check non-null tags - tags(x) - - ## get a list of all tags, including NULL ones - tags(x, TRUE) -} +## check non-null tags +tags(x) +## get a list of all tags, including NULL ones +tags(x, TRUE) } diff --git a/man/tags_df.Rd b/man/tags_df.Rd index 24c1410..f9ab6f7 100644 --- a/man/tags_df.Rd +++ b/man/tags_df.Rd @@ -19,18 +19,11 @@ This function returns a \code{data.frame} of all the tagged variables stored in } \examples{ -if (require(outbreaks) && require(magrittr)) { - ## create a tibble datatagr - x <- measles_hagelloch_1861 \%>\% - make_datatagr( - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" - ) - x +x <- make_datatagr(cars, + mph = "speed", + distance = "dist" +) - ## get a data.frame of all tagged variables - tags_df(x) -} +## get a data.frame of all tagged variables +tags_df(x) } diff --git a/man/validate_datatagr.Rd b/man/validate_datatagr.Rd index cd37e78..3ff6f15 100644 --- a/man/validate_datatagr.Rd +++ b/man/validate_datatagr.Rd @@ -34,37 +34,27 @@ The following checks are performed: } \examples{ -if (require(outbreaks) && require(magrittr)) { +if (require(magrittr)) { ## create a valid datatagr - x <- measles_hagelloch_1861 \%>\% + x <- cars \%>\% make_datatagr( - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" + mph = "speed", + distance = "dist" ) x ## validation validate_datatagr(x, ref_types = tags_types( - id = c("integer", "factor"), - date_onset = "Date", - age = "numeric", - gender = c("factor", "character") + mph = c("numeric", "factor"), + distance = "numeric" )) - ## create an invalid datatagr - onset date is a factor - x <- measles_hagelloch_1861 \%>\% - make_datatagr( - id = "case_ID", - date_onset = "gender", - age = "age" - ) - x - ## the below issues an error ## note: tryCatch is only used to avoid a genuine error in the example - tryCatch(validate_datatagr(x), error = paste) + tryCatch(validate_datatagr(x, ref_types = tags_types( + mph = c("numeric", "factor"), + distance = "factor" + )), error = paste) } } \seealso{ diff --git a/man/validate_tags.Rd b/man/validate_tags.Rd index a68ba4e..0c737a1 100644 --- a/man/validate_tags.Rd +++ b/man/validate_tags.Rd @@ -19,31 +19,24 @@ that all default tags are present iv) tagged variables exist v) that no extra tag exists (if \code{allow_extra} is \code{FALSE}). } \examples{ -if (require(outbreaks) && require(magrittr)) { +if (require(dplyr) && require(magrittr)) { ## create a valid datatagr - x <- measles_hagelloch_1861 \%>\% + x <- cars \%>\% make_datatagr( - id = "case_ID", - date_onset = "date_of_prodrome", - age = "age", - gender = "gender" + mph = "speed", + distance = "dist" ) x - ## validation + ## the below issues an error as datatagr doesn't know any defaults + ## note: tryCatch is only used to avoid a genuine error in the example + tryCatch(validate_datatagr(x), error = paste) + + ## validation requires you to specify the types directly validate_datatagr(x, ref_types = tags_types( - id = c("integer", "factor"), - date_onset = "Date", - age = "numeric", - gender = c("factor", "character") + mph = c("integer", "numeric"), + distance = "numeric" )) - - ## hack to create an invalid tags (missing defaults) - attr(x, "tags") <- list(id = "case_ID") - - ## the below issues an error - ## note: tryCatch is only used to avoid a genuine error in the example - tryCatch(validate_tags(x), error = paste) } } \seealso{ diff --git a/man/validate_types.Rd b/man/validate_types.Rd index 8eed4ae..75679d0 100644 --- a/man/validate_types.Rd +++ b/man/validate_types.Rd @@ -20,25 +20,22 @@ This function checks the class of each tagged variable in a \code{datatagr} against pre-defined accepted classes in \code{\link[=tags_types]{tags_types()}}. } \examples{ -if (require(outbreaks) && require(magrittr)) { - ## create an invalid datatagr - gender is a numeric - x <- measles_hagelloch_1861 \%>\% - make_datatagr( - id = "case_ID", - gender = "infector" - ) - x +x <- make_datatagr(cars, + mph = "speed", + distance = "dist" +) +x - ## the below would issue an error - ## note: tryCatch is only used to avoid a genuine error in the example - tryCatch(validate_types(x), error = paste) +## the below would issue an error +## note: tryCatch is only used to avoid a genuine error in the example +tryCatch(validate_types(x), error = paste) + +## to allow other types, e.g. gender to be integer, character or factor +validate_types(x, tags_types(mph = "numeric", distance = c( + "integer", + "character", "numeric" +))) - ## to allow other types, e.g. gender to be integer, character or factor - validate_types(x, tags_types(id = "integer", gender = c( - "integer", - "character", "factor" - ))) -} } \seealso{ \itemize{ diff --git a/tests/testthat/_snaps/validate_types.md b/tests/testthat/_snaps/validate_types.md index 2603f7c..d5932b1 100644 --- a/tests/testthat/_snaps/validate_types.md +++ b/tests/testthat/_snaps/validate_types.md @@ -1,7 +1,7 @@ # validate_types() validates types Some tags have the wrong class: - - age: Must inherit from class 'factor', but has class 'numeric' - - gender: Must inherit from class 'character', but has class 'numeric' + - mph: Must inherit from class 'factor', but has class 'numeric' + - distance: Must inherit from class 'character', but has class 'numeric' diff --git a/tests/testthat/test-drop_datatagr.R b/tests/testthat/test-drop_datatagr.R index e7b17d5..a908472 100644 --- a/tests/testthat/test-drop_datatagr.R +++ b/tests/testthat/test-drop_datatagr.R @@ -1,5 +1,5 @@ test_that("tests for drop_datatagr", { - x <- make_datatagr(cars, age = "speed") + x <- make_datatagr(cars, mph = "speed") expect_identical(cars, drop_datatagr(x, TRUE)) y <- drop_datatagr(x, FALSE) expect_identical(tags(x, TRUE), attr(y, "tags")) diff --git a/tests/testthat/test-prune_tags.R b/tests/testthat/test-prune_tags.R index 87c2401..307bdf6 100644 --- a/tests/testthat/test-prune_tags.R +++ b/tests/testthat/test-prune_tags.R @@ -1,5 +1,5 @@ test_that("tests for prune_tags", { - x <- make_datatagr(cars, age = "speed", date_onset = "dist") + x <- make_datatagr(cars, mph = "speed", distance = "dist") # Check error messages msg <- "Must inherit from class 'datatagr', but has class 'data.frame'." @@ -8,7 +8,7 @@ test_that("tests for prune_tags", { attr(x, "names") <- c("new1", "new2") # hack needed as names<- is now safe msg <- paste( "The following tags have lost their variable:", - " age:speed, date_onset:dist", + " mph:speed, distance:dist", sep = "\n" ) expect_error(prune_tags(x), msg, class = "datatagr_error") diff --git a/tests/testthat/test-restore_tags.R b/tests/testthat/test-restore_tags.R index 0f1ecc0..3341f3b 100644 --- a/tests/testthat/test-restore_tags.R +++ b/tests/testthat/test-restore_tags.R @@ -1,6 +1,6 @@ test_that("tests for restore_tags", { # These are now order dependent for the tests - x <- make_datatagr(cars, date_onset = "dist", age = "speed") + x <- make_datatagr(cars, distance = "dist", mph = "speed") y <- drop_datatagr(x) z <- y names(z) <- c("titi", "toto") @@ -8,7 +8,7 @@ test_that("tests for restore_tags", { # Check error messages msg <- paste( "The following tags have lost their variable:", - " date_onset:dist, age:speed", + " distance:dist, mph:speed", sep = "\n" ) expect_error(restore_tags(z, tags(x), "error"), msg) diff --git a/tests/testthat/test-tags.R b/tests/testthat/test-tags.R index fce24ed..212911b 100644 --- a/tests/testthat/test-tags.R +++ b/tests/testthat/test-tags.R @@ -1,9 +1,9 @@ test_that("tests for tags", { # Check error messages - x <- make_datatagr(cars, age = "speed") + x <- make_datatagr(cars, mph = "speed") # Check functionality - expect_identical(tags(x), list(age = "speed")) + expect_identical(tags(x), list(mph = "speed")) expect_identical(tags(x, TRUE), attr(x, "tags")) expect_identical(tags(make_datatagr(cars), TRUE), list()) }) diff --git a/tests/testthat/test-tags_df.R b/tests/testthat/test-tags_df.R index 9a437f0..afefdfc 100644 --- a/tests/testthat/test-tags_df.R +++ b/tests/testthat/test-tags_df.R @@ -1,8 +1,8 @@ test_that("tests for tags_df", { # These are now order dependent for the tests - x <- make_datatagr(cars, date_reporting = "dist", age = "speed") + x <- make_datatagr(cars, distance = "dist", mph = "speed") y <- cars[c("dist", "speed")] - names(y) <- c("date_reporting", "age") + names(y) <- c("distance", "mph") # errors msg <- "Must inherit from class 'datatagr', but has class 'data.frame'." diff --git a/tests/testthat/test-validate_types.R b/tests/testthat/test-validate_types.R index 4d5626b..87c3701 100644 --- a/tests/testthat/test-validate_types.R +++ b/tests/testthat/test-validate_types.R @@ -7,33 +7,33 @@ test_that("tests for validate_types() basic input checking", { test_that("validate_types() validates types", { # Successful validations - x <- make_datatagr(cars, age = "speed") + x <- make_datatagr(cars, mph = "speed") expect_silent( expect_identical( x, - validate_types(x, ref_types = tags_types(age = "numeric")) + validate_types(x, ref_types = tags_types(mph = "numeric")) ) ) # Failed validations - x <- make_datatagr(cars, age = "speed") + x <- make_datatagr(cars, mph = "speed") expect_error( - validate_types(x, ref_types = tags_types(age = "factor")), - "age: Must inherit from class 'factor', but has class 'numeric'" + validate_types(x, ref_types = tags_types(mph = "factor")), + "mph: Must inherit from class 'factor', but has class 'numeric'" ) - x <- make_datatagr(cars, age = "speed", gender = "dist") + x <- make_datatagr(cars, mph = "speed", distance = "dist") expect_snapshot_error( - validate_types(x, ref_types = tags_types(age = "factor", gender = "character")) + validate_types(x, ref_types = tags_types(mph = "factor", distance = "character")) ) }) test_that("missing ref_type in validate_types()", { # Single missing - x <- make_datatagr(cars, age = "speed", d = "dist", allow_extra = TRUE) + x <- make_datatagr(cars, mph = "speed", d = "dist", allow_extra = TRUE) expect_error( validate_types(x), - "Allowed types for tag `age`, `d` are not documented in `ref_types`." + "Allowed types for tag `mph`, `d` are not documented in `ref_types`." ) # Two missing