support for dplyr 1.1.0

This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-02-15 17:02:10 +01:00
parent fe41fc2e35
commit 6016547f1f
7 changed files with 33 additions and 28 deletions

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 1.8.2.9126 Version: 1.8.2.9127
Date: 2023-02-14 Date: 2023-02-15
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9126 # 1.8.2.9127
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)* *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*

View File

@ -889,34 +889,36 @@ get_current_data <- function(arg_name, call) {
valid_df <- function(x) { valid_df <- function(x) {
!is.null(x) && is.data.frame(x) !is.null(x) && is.data.frame(x)
} }
# try dplyr::cur_data_all() first to support dplyr groups
# only useful for e.g. dplyr::filter(), dplyr::mutate() and dplyr::summarise()
# not useful (throws error) with e.g. dplyr::select(), dplyr::across(), or dplyr::vars(),
# but that will be caught later on in this function
cur_data_all <- import_fn("cur_data_all", "dplyr", error_on_fail = FALSE)
if (!is.null(cur_data_all)) {
out <- tryCatch(cur_data_all(), error = function(e) NULL)
if (valid_df(out)) {
return(out)
}
}
# try a manual (base R) method, by going over all underlying environments with sys.frames() # try a manual (base R) method, by going over all underlying environments with sys.frames()
for (env in sys.frames()) { for (env in sys.frames()) {
if (!is.null(env$`.Generic`)) {
# dplyr support ----
if (!is.null(env$mask) && is.function(env$mask$current_rows) && (valid_df(env$data) || valid_df(env$`.data`))) {
# an element `.data` or `data` (containing all data) and `mask` (containing functions) will be in the environment when using dplyr verbs
# we use their mask$current_rows() to get the group rows, since dplyr::cur_data_all() is deprecated and will be removed in the future
# e.g. for `example_isolates %>% group_by(ward) %>% mutate(first = first_isolate(.))`
if (valid_df(env$data)) {
# support for dplyr 1.1.x
return(env$data[env$mask$current_rows(), , drop = FALSE])
} else {
# support for dplyr 1.0.x
return(env$`.data`[env$mask$current_rows(), , drop = FALSE])
}
# base R support ----
} else if (!is.null(env$`.Generic`)) {
# don't check `".Generic" %in% names(env)`, because in R < 3.2, `names(env)` is always NULL # don't check `".Generic" %in% names(env)`, because in R < 3.2, `names(env)` is always NULL
if (valid_df(env$`.data`)) { if (valid_df(env$xx)) {
# an element `.data` will be in the environment when using `dplyr::select()` # an element `xx` will be in the environment for rows + cols in base R, e.g. `example_isolates[c(1:3), carbapenems()]`
# (but not when using `dplyr::filter()`, `dplyr::mutate()` or `dplyr::summarise()`)
return(env$`.data`)
} else if (valid_df(env$xx)) {
# an element `xx` will be in the environment for rows + cols, e.g. `example_isolates[c(1:3), carbapenems()]`
return(env$xx) return(env$xx)
} else if (valid_df(env$x)) { } else if (valid_df(env$x)) {
# an element `x` will be in the environment for only cols, e.g. `example_isolates[, carbapenems()]` # an element `x` will be in the environment for only cols in base R, e.g. `example_isolates[, carbapenems()]`
return(env$x) return(env$x)
} }
# scoped dplyr support ----
} else if (!is.null(names(env)) && all(c(".tbl", ".vars", ".cols") %in% names(env), na.rm = TRUE) && valid_df(env$`.tbl`)) { } else if (!is.null(names(env)) && all(c(".tbl", ".vars", ".cols") %in% names(env), na.rm = TRUE) && valid_df(env$`.tbl`)) {
# an element `.tbl` will be in the environment when using scoped dplyr variants, with or without `dplyr::vars()` # an element `.tbl` will be in the environment when using scoped dplyr variants, with or without `dplyr::vars()`
# (e.g. `dplyr::summarise_at()` or `dplyr::mutate_at()`) # (e.g. `dplyr::summarise_at()` or `dplyr::mutate_at()`)

View File

@ -177,7 +177,7 @@ first_isolate <- function(x = NULL,
include_untested_sir = TRUE, include_untested_sir = TRUE,
...) { ...) {
if (is_null_or_grouped_tbl(x)) { if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
# is also fix for using a grouped df as input (a dot as first argument) # is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
} }
@ -634,7 +634,7 @@ filter_first_isolate <- function(x = NULL,
method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"), method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"),
...) { ...) {
if (is_null_or_grouped_tbl(x)) { if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
# is also fix for using a grouped df as input (a dot as first argument) # is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
} }

View File

@ -138,7 +138,7 @@ key_antimicrobials <- function(x = NULL,
only_sir_columns = FALSE, only_sir_columns = FALSE,
...) { ...) {
if (is_null_or_grouped_tbl(x)) { if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
# is also fix for using a grouped df as input (a dot as first argument) # is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
} }
@ -250,7 +250,7 @@ all_antimicrobials <- function(x = NULL,
only_sir_columns = FALSE, only_sir_columns = FALSE,
...) { ...) {
if (is_null_or_grouped_tbl(x)) { if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
# is also fix for using a grouped df as input (a dot as first argument) # is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
} }

View File

@ -178,7 +178,7 @@ mdro <- function(x = NULL,
only_sir_columns = FALSE, only_sir_columns = FALSE,
...) { ...) {
if (is_null_or_grouped_tbl(x)) { if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
# is also a fix for using a grouped df as input (i.e., a dot as first argument) # is also a fix for using a grouped df as input (i.e., a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
} }

View File

@ -54,10 +54,13 @@ mark, .mark {
background: rgba(17, 143, 118, 0.25) !important; background: rgba(17, 143, 118, 0.25) !important;
} }
/* smaller tables */
.table {
font-size: 0.9em !important;
}
/* SYNTAX */ /* SYNTAX */
/* These are simple changes for the syntax highlighting */ /* These are simple changes for the syntax highlighting */
pre { pre {
font-size: 0.8em !important; font-size: 0.8em !important;
} }