P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-11 06:21:56 +02:00
Code Releases Activity

(v1.4.0.9001) is_gram_positive(), is_gram_negative(), parameter hardening

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-10-19 17:09:19 +02:00
parent 833a1be36d
commit 4e9ccb4435
76 changed files with 969 additions and 491 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
R/like.R
View File

@ -68,6 +68,10 @@
#' }
#' }
like <- function(x, pattern, ignore.case = TRUE) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_class = "character")
meet_criteria(ignore.case, allow_class = "logical", has_length = 1)
# set to fixed if no regex found
fixed <- !any(is_possibly_regex(pattern))
if (ignore.case == TRUE) {
@ -79,6 +83,10 @@ like <- function(x, pattern, ignore.case = TRUE) {
if (length(pattern) > 1 & length(x) == 1) {
x <- rep(x, length(pattern))
}
if (all(is.na(x))) {
return(rep(FALSE, length(x)))
}
if (length(pattern) > 1) {
res <- vector(length = length(pattern))
@ -137,18 +145,24 @@ like <- function(x, pattern, ignore.case = TRUE) {
#' @rdname like
#' @export
"%like%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_class = "character")
like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%like_case%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_class = "character")
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)"
"%like_perl%" <- function(x, pattern) {
meet_criteria(x)
meet_criteria(pattern, allow_class = "character")
grepl(x = tolower(x),
pattern = tolower(pattern),
perl = TRUE,