1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 10:21:49 +02:00

new tibble export

This commit is contained in:
2022-08-27 20:49:37 +02:00
parent 164886f50b
commit 303d61b473
115 changed files with 836 additions and 996 deletions

View File

@ -80,7 +80,7 @@
#' filter_first_isolate() %>%
#' filter(mo_genus(mo) == "Staphylococcus") %>%
#' resistance_predict("PEN", model = "binomial")
#' plot(x)
#' print(plot(x))
#'
#' # get the model from the object
#' mymodel <- attributes(x)$model
@ -88,7 +88,7 @@
#' }
#'
#' # create nice plots with ggplot2 yourself
#' if (require("dplyr") & require("ggplot2")) {
#' if (require("dplyr") && require("ggplot2")) {
#'
#' data <- example_isolates %>%
#' filter(mo == as.mo("E. coli")) %>%
@ -127,6 +127,9 @@ resistance_predict <- function(x,
stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")')
x.bak <- x
x <- as.data.frame(x, stringsAsFactors = FALSE)
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
@ -147,9 +150,6 @@ resistance_predict <- function(x,
stop_ifnot(col_date %in% colnames(x),
"column '", col_date, "' not found")
# no grouped tibbles
x <- as.data.frame(x, stringsAsFactors = FALSE)
year <- function(x) {
# don't depend on lubridate or so, would be overkill for only this function
if (all(grepl("^[0-9]{4}$", x))) {
@ -173,7 +173,7 @@ resistance_predict <- function(x,
# remove rows with NAs
df <- subset(df, !is.na(df[, col_ab, drop = TRUE]))
df$year <- year(df[, col_date, drop = TRUE])
df <- as.data.frame(rbind(table(df[, c("year", col_ab)])),
df <- as.data.frame(rbind(table(df[, c("year", col_ab), drop = FALSE])),
stringsAsFactors = FALSE)
df$year <- as.integer(rownames(df))
rownames(df) <- NULL
@ -275,15 +275,15 @@ resistance_predict <- function(x,
}
df_prediction$value <- ifelse(df_prediction$value > 1, 1, ifelse(df_prediction$value < 0, 0, df_prediction$value))
df_prediction <- df_prediction[order(df_prediction$year), ]
df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE]
structure(
.Data = df_prediction,
class = c("resistance_predict", "data.frame"),
I_as_S = I_as_S,
model_title = model,
model = model_lm,
ab = col_ab
out <- as_original_data_class(df_prediction, class(x.bak))
structure(out,
class = c("resistance_predict", class(out)),
I_as_S = I_as_S,
model_title = model,
model = model_lm,
ab = col_ab
)
}