P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

fix for using `dplyr::select()`

This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-02-15 19:48:34 +01:00
parent a82552dd88
commit db2830124f
3 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 1.8.2.9130 Version: 1.8.2.9131
Date: 2023-02-15 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)

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9130 # AMR 1.8.2.9131
*(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!)*

30
R/aa_helper_functions.R
View File

@ -890,11 +890,12 @@ get_current_data <- function(arg_name, call) {
!is.null(x) && is.data.frame(x) !is.null(x) && is.data.frame(x)
} }
# try a manual (base R) method, by going over all underlying environments with sys.frames() frms <- sys.frames()
for (env in sys.frames()) {
# dplyr support ---- # check dplyr environments to support dplyr groups
if (!is.null(env$mask) && is.function(env$mask$current_rows) && (valid_df(env$data) || valid_df(env$`.data`))) { with_mask <- vapply(FUN.VALUE = logical(1), frms, function(e) !is.null(e$mask))
for (env in frms[which(with_mask)]) {
if (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 # 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 # 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(.))` # e.g. for `example_isolates %>% group_by(ward) %>% mutate(first = first_isolate(.))`
@ -907,21 +908,28 @@ get_current_data <- function(arg_name, call) {
} }
rows <- tryCatch(env$mask$current_rows(), error = function(e) seq_len(NROW(df))) rows <- tryCatch(env$mask$current_rows(), error = function(e) seq_len(NROW(df)))
return(df[rows, , drop = FALSE]) return(df[rows, , drop = FALSE])
}
}
# base R support ---- # now go over all underlying environments looking for other dplyr and base R selection environments
} else if (!is.null(env$`.Generic`)) { with_generic <- vapply(FUN.VALUE = logical(1), frms, function(e) !is.null(e$`.Generic`))
# don't check `".Generic" %in% names(env)`, because in R < 3.2, `names(env)` is always NULL for (env in frms[which(with_generic)]) {
if (valid_df(env$`.data`)) {
if (valid_df(env$xx)) { # an element `.data` will be in the environment when using dplyr::select()
return(env$`.data`)
} else if (valid_df(env$xx)) {
# an element `xx` will be in the environment for rows + cols in base R, e.g. `example_isolates[c(1:3), carbapenems()]` # an element `xx` will be in the environment for rows + cols in base R, 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 in base R, 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 ---- # now a special case for dplyr's 'scoped' variants
} else if (!is.null(names(env)) && all(c(".tbl", ".vars", ".cols") %in% names(env), na.rm = TRUE) && valid_df(env$`.tbl`)) { with_tbl <- vapply(FUN.VALUE = logical(1), frms, function(e) valid_df(e$`.tbl`))
for (env in frms[which(with_tbl)]) {
if (!is.null(names(env)) && all(c(".tbl", ".vars", ".cols") %in% names(env), na.rm = TRUE)) {
# 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()`)
return(env$`.tbl`) return(env$`.tbl`)