mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 19:41:49 +02:00
New mo algorithm, prepare for 2.0
This commit is contained in:
committed by
GitHub
parent
63fe160322
commit
cd2acc4a29
@ -1,12 +1,16 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2022 Berends MS, Luz CF et al. #
|
||||
# CITE AS #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# doi:10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
@ -132,18 +136,6 @@ resistance_predict <- function(x,
|
||||
x.bak <- x
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- names(dots)
|
||||
if ("tbl" %in% dots.names) {
|
||||
x <- dots[which(dots.names == "tbl")]
|
||||
}
|
||||
if ("I_as_R" %in% dots.names) {
|
||||
warning_("in `resistance_predict()`: I_as_R is deprecated - use I_as_S instead.")
|
||||
}
|
||||
}
|
||||
|
||||
# -- date
|
||||
if (is.null(col_date)) {
|
||||
col_date <- search_type_in_df(x = x, type = "date")
|
||||
@ -167,10 +159,10 @@ resistance_predict <- function(x,
|
||||
df[, col_ab] <- droplevels(as.rsi(df[, col_ab, drop = TRUE]))
|
||||
if (I_as_S == TRUE) {
|
||||
# then I as S
|
||||
df[, col_ab] <- gsub("I", "S", df[, col_ab, drop = TRUE])
|
||||
df[, col_ab] <- gsub("I", "S", df[, col_ab, drop = TRUE], fixed = TRUE)
|
||||
} else {
|
||||
# then I as R
|
||||
df[, col_ab] <- gsub("I", "R", df[, col_ab, drop = TRUE])
|
||||
df[, col_ab] <- gsub("I", "R", df[, col_ab, drop = TRUE], fixed = TRUE)
|
||||
}
|
||||
df[, col_ab] <- ifelse(is.na(df[, col_ab, drop = TRUE]), 0, df[, col_ab, drop = TRUE])
|
||||
|
||||
@ -257,10 +249,10 @@ resistance_predict <- function(x,
|
||||
df_prediction$se_max <- as.integer(df_prediction$se_max)
|
||||
} else {
|
||||
# se_max not above 1
|
||||
df_prediction$se_max <- ifelse(df_prediction$se_max > 1, 1, df_prediction$se_max)
|
||||
df_prediction$se_max <- pmin(df_prediction$se_max, 1)
|
||||
}
|
||||
# se_min not below 0
|
||||
df_prediction$se_min <- ifelse(df_prediction$se_min < 0, 0, df_prediction$se_min)
|
||||
df_prediction$se_min <- pmax(df_prediction$se_min, 0)
|
||||
|
||||
df_observations <- data.frame(
|
||||
year = df$year,
|
||||
@ -279,7 +271,7 @@ resistance_predict <- function(x,
|
||||
df_prediction$se_max <- ifelse(!is.na(df_prediction$observed), NA, df_prediction$se_max)
|
||||
}
|
||||
|
||||
df_prediction$value <- ifelse(df_prediction$value > 1, 1, ifelse(df_prediction$value < 0, 0, df_prediction$value))
|
||||
df_prediction$value <- ifelse(df_prediction$value > 1, 1, pmax(df_prediction$value, 0))
|
||||
df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE]
|
||||
|
||||
out <- as_original_data_class(df_prediction, class(x.bak))
|
||||
|
Reference in New Issue
Block a user