P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 19:26:13 +01:00
Code Releases Activity

(v1.5.0.9036) quick test

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2021-03-07 22:45:05 +01:00
parent 2f0fc3cab7
commit 68163e3089
3 changed files with 10 additions and 23 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.5.0.9035 Version: 1.5.0.9036
Date: 2021-03-07 Date: 2021-03-07
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Authors@R: c( Authors@R: c(

29
R/rsi.R
View File

@ -774,11 +774,6 @@ exec_as.rsi <- function(method,
for (i in seq_len(length(x))) { for (i in seq_len(length(x))) {
is_intrinsic_r <- paste(mo[i], ab) %in% INTRINSIC_R is_intrinsic_r <- paste(mo[i], ab) %in% INTRINSIC_R
if (is_intrinsic_r == TRUE) {
print("====")
print(paste(mo[i], ab))
print("====")
}
any_is_intrinsic_resistant <- any_is_intrinsic_resistant | is_intrinsic_r any_is_intrinsic_resistant <- any_is_intrinsic_resistant | is_intrinsic_r
if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) { if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {
@ -813,34 +808,26 @@ exec_as.rsi <- function(method,
pm_filter(uti == FALSE) %pm>% # 'uti' is a column in rsi_translation pm_filter(uti == FALSE) %pm>% # 'uti' is a column in rsi_translation
pm_arrange(pm_desc(nchar(mo))) pm_arrange(pm_desc(nchar(mo)))
} }
get_record <- get_record[1L, , drop = FALSE]
if (NROW(get_record) > 0) { if (NROW(get_record) > 0) {
get_record <- get_record[1L, , drop = FALSE]
if (is.na(x[i])) { if (is.na(x[i])) {
new_rsi[i] <- NA_character_ new_rsi[i] <- NA_character_
} else if (method == "mic") { } else if (method == "mic") {
print("----") new_rsi[i] <- quick_case_when(is.na(get_record$breakpoint_S) & is.na(get_record$breakpoint_R) ~ NA_character_,
print(str(get_record)) isTRUE(conserve_capped_values) & x[i] %like% "^<[0-9]" ~ "S",
print(x[i])
print(x[i] <= get_record$breakpoint_S)
print(x[i] > get_record$breakpoint_R)
print(x[i] >= get_record$breakpoint_R)
print(guideline_coerced %like% "EUCAST" & x[i] > get_record$breakpoint_R)
print(guideline_coerced %like% "EUCAST" && x[i] > get_record$breakpoint_R)
print(guideline_coerced %like% "EUCAST" & (x[i] > get_record$breakpoint_R))
print("----")
new_rsi[i] <- quick_case_when(isTRUE(conserve_capped_values) & x[i] %like% "^<[0-9]" ~ "S",
isTRUE(conserve_capped_values) & x[i] %like% "^>[0-9]" ~ "R", isTRUE(conserve_capped_values) & x[i] %like% "^>[0-9]" ~ "R",
# start interpreting: EUCAST uses <= S and > R, CLSI uses <=S and >= R # start interpreting: EUCAST uses <= S and > R, CLSI uses <=S and >= R
x[i] <= get_record$breakpoint_S ~ "S", as.double(x[i]) <= get_record$breakpoint_S ~ "S",
guideline_coerced %like% "EUCAST" & x[i] > get_record$breakpoint_R ~ "R", guideline_coerced %like% "EUCAST" & as.double(x[i]) > get_record$breakpoint_R ~ "R",
guideline_coerced %like% "CLSI" & x[i] >= get_record$breakpoint_R ~ "R", guideline_coerced %like% "CLSI" & as.double(x[i]) >= get_record$breakpoint_R ~ "R",
# return "I" when not match the bottom or top # return "I" when not match the bottom or top
!is.na(get_record$breakpoint_S) & !is.na(get_record$breakpoint_R) ~ "I", !is.na(get_record$breakpoint_S) & !is.na(get_record$breakpoint_R) ~ "I",
# and NA otherwise # and NA otherwise
TRUE ~ NA_character_) TRUE ~ NA_character_)
} else if (method == "disk") { } else if (method == "disk") {
new_rsi[i] <- quick_case_when(isTRUE(as.double(x[i]) >= as.double(get_record$breakpoint_S)) ~ "S", new_rsi[i] <- quick_case_when(is.na(get_record$breakpoint_S) & is.na(get_record$breakpoint_R) ~ NA_character_,
isTRUE(as.double(x[i]) >= as.double(get_record$breakpoint_S)) ~ "S",
# start interpreting: EUCAST uses >= S and < R, CLSI uses >=S and <= R # start interpreting: EUCAST uses >= S and < R, CLSI uses >=S and <= R
guideline_coerced %like% "EUCAST" & guideline_coerced %like% "EUCAST" &
isTRUE(as.double(x[i]) < as.double(get_record$breakpoint_R)) ~ "R", isTRUE(as.double(x[i]) < as.double(get_record$breakpoint_R)) ~ "R",

2
tests/testthat/test-rsi.R
View File

@ -106,7 +106,7 @@ test_that("mic2rsi works", {
# cutoffs at MIC = 8 # cutoffs at MIC = 8
expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"), expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("S")) as.rsi("S"), info = paste0(as.mo("E. coli"), as.ab("ampicillin")))
expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"), expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R")) as.rsi("R"))