P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-10 07:41:57 +02:00
Code Releases Activity

(v1.4.0.9007) bugfix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-10-21 15:28:48 +02:00
parent 8f868388ce
commit f720c9ba0b
13 changed files with 38 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
R/first_isolate.R
View File

@ -144,8 +144,14 @@ first_isolate <- function(x,
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_testcode, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
if (isFALSE(col_specimen)) {
col_specimen <- NULL
}
meet_criteria(col_specimen, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_icu, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
if (isFALSE(col_keyantibiotics)) {
col_keyantibiotics <- NULL
}
meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1)
meet_criteria(testcodes_exclude, allow_class = "character", allow_NULL = TRUE)
@ -206,17 +212,11 @@ first_isolate <- function(x,
if (is.null(col_keyantibiotics)) {
col_keyantibiotics <- search_type_in_df(x = x, type = "keyantibiotics")
}
if (isFALSE(col_keyantibiotics)) {
col_keyantibiotics <- NULL
}
# -- specimen
if (is.null(col_specimen) & !is.null(specimen_group)) {
col_specimen <- search_type_in_df(x = x, type = "specimen")
}
if (isFALSE(col_specimen)) {
col_specimen <- NULL
}
# check if columns exist
check_columns_existance <- function(column, tblname = x) {

18
R/like.R
View File

@ -42,6 +42,8 @@
#' * Tries again with `perl = TRUE` if regex fails
#'
#' Using RStudio? This function can also be inserted from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
#'
#' The `"%not_like%"` and `"%like_perl%"` functions are wrappers around `"%like%"`.
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/master/R/like.R)
#' @seealso [grep()]
#' @inheritSection AMR Read more on our website!
@ -146,10 +148,18 @@ like <- function(x, pattern, ignore.case = TRUE) {
#' @export
"%like%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_class = "character")
meet_criteria(pattern, allow_NA = FALSE)
like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%not_like%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
!like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%like_case%" <- function(x, pattern) {
@ -158,11 +168,13 @@ like <- function(x, pattern, ignore.case = TRUE) {
like(x, pattern, ignore.case = FALSE)
}
# don't export his one, it's just for convenience in eucast_rules()
# match all Klebsiella and Raoultella, but not K. aerogenes: fullname %like_perl% "^(Klebsiella(?! aerogenes)|Raoultella)"
#' @rdname like
#' @export
"%like_perl%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
# convenient for e.g. matching all Klebsiella and Raoultella, but not
# K. aerogenes: fullname %like_perl% "^(Klebsiella(?! aerogenes)|Raoultella)"
grepl(x = tolower(x),
pattern = tolower(pattern),
perl = TRUE,