1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 01:02:41 +02:00

(v0.6.1.9044) first_isolate fix for species

This commit is contained in:
2019-05-31 14:25:11 +02:00
parent 1f8ee3ec3e
commit 493ae2ba0c
121 changed files with 586 additions and 521 deletions

33
R/age.R
View File

@ -24,15 +24,22 @@
#' Calculates age in years based on a reference date, which is the sytem date at default.
#' @param x date(s), will be coerced with \code{\link{as.POSIXlt}}
#' @param reference reference date(s) (defaults to today), will be coerced with \code{\link{as.POSIXlt}} and cannot be lower than \code{x}
#' @return Integer (no decimals)
#' @param exact a logical to indicate whether age calculation should be exact, i.e. with decimals
#' @return An integer (no decimals) if \code{exact = FALSE}, a double (with decimals) otherwise
#' @seealso \code{\link{age_groups}} to split age into age groups
#' @importFrom dplyr if_else
#' @inheritSection AMR Read more on our website!
#' @export
#' @examples
#' df <- data.frame(birth_date = Sys.Date() - runif(100) * 25000)
#' # 10 random birth dates
#' df <- data.frame(birth_date = Sys.Date() - runif(10) * 25000)
#' # add ages
#' df$age <- age(df$birth_date)
age <- function(x, reference = Sys.Date()) {
#' # add exact ages
#' df$age_exact <- age(df$birth_date, exact = TRUE)
#'
#' df
age <- function(x, reference = Sys.Date(), exact = FALSE) {
if (length(x) != length(reference)) {
if (length(reference) == 1) {
reference <- rep(reference, length(x))
@ -49,17 +56,33 @@ age <- function(x, reference = Sys.Date()) {
as.integer(years_gap - 1),
as.integer(years_gap))
# add decimals
if (exact == TRUE) {
# get dates of `x` when `x` would have the year of `reference`
x_in_reference_year <- base::as.POSIXlt(paste0(format(reference, "%Y"), format(x, "-%m-%d")))
# get differences in days
n_days_x_rest <- base::as.double(base::difftime(reference, x_in_reference_year, units = "days"))
# get numbers of days the years of `reference` has for a reliable denominator
n_days_reference_year <- base::as.POSIXlt(paste0(format(reference, "%Y"), "-12-31"))$yday + 1
# add decimal parts of year
ages <- ages + (n_days_x_rest / n_days_reference_year)
}
if (any(ages < 0, na.rm = TRUE)) {
ages[ages < 0] <- NA_integer_
ages[ages < 0] <- NA
warning("NAs introduced for ages below 0.")
}
if (any(ages > 120, na.rm = TRUE)) {
warning("Some ages are > 120.")
warning("Some ages are above 120.")
}
ages
}
age_to_toDate <- function(age) {
}
#' Split ages into age groups
#'
#' Split ages into age groups defined by the \code{split} parameter. This allows for easier demographic (antimicrobial resistance) analysis.

View File

@ -29,16 +29,17 @@
#'
#' This package can be used for:
#' \itemize{
#' \item{Reference for microorganisms, since it contains almost all 60,000 microbial (sub)species from the Catalogue of Life}
#' \item{Reference for microorganisms, since it contains all microbial (sub)species from the Catalogue of Life}
#' \item{Interpreting raw MIC and disk diffusion values, based on the latest CLSI or EUCAST guidelines}
#' \item{Calculating antimicrobial resistance}
#' \item{Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO)}
#' \item{Calculating empirical susceptibility of both mono therapy and combination therapy}
#' \item{Predicting future antimicrobial resistance using regression models}
#' \item{Getting properties for any microorganism (like Gram stain, species, genus or family)}
#' \item{Getting properties for any antibiotic (like name, ATC code, defined daily dose or trade name)}
#' \item{Plotting antimicrobial resistance}
#' \item{Determining first isolates to be used for AMR analysis}
#' \item{Applying EUCAST expert rules (not the translation from MIC to RSI values)}
#' \item{Determining multi-drug resistant organisms (MDRO)}
#' \item{Applying EUCAST expert rules}
#' \item{Descriptive statistics: frequency tables, kurtosis and skewness}
#' }
#' @section Authors:
@ -48,7 +49,7 @@
#' [2] Certe Medical Diagnostics & Advice, Groningen, the Netherlands - \url{certe.nl}
#' @section Read more on our website!:
#' On our website \url{https://msberends.gitlab.io/AMR} you can find \href{https://msberends.gitlab.io/AMR/articles/AMR.html}{a comprehensive tutorial} about how to conduct AMR analysis, the \href{https://msberends.gitlab.io/AMR/reference}{complete documentation of all functions} (which reads a lot easier than here in R) and \href{https://msberends.gitlab.io/AMR/articles/WHONET.html}{an example analysis using WHONET data}.
#' On our website \url{https://msberends.gitlab.io/AMR} you can find \href{https://msberends.gitlab.io/AMR/articles/AMR.html}{a tutorial} about how to conduct AMR analysis, the \href{https://msberends.gitlab.io/AMR/reference}{complete documentation of all functions} (which reads a lot easier than here in R) and \href{https://msberends.gitlab.io/AMR/articles/WHONET.html}{an example analysis using WHONET data}.
#' @section Contact us:
#' For suggestions, comments or questions, please contact us at:

View File

@ -233,7 +233,7 @@ first_isolate <- function(x,
}
# -- specimen
if (is.null(col_specimen)) {
if (is.null(col_specimen) & !is.null(specimen_group)) {
col_specimen <- search_type_in_df(x = x, type = "specimen")
}
if (isFALSE(col_specimen)) {
@ -263,7 +263,9 @@ first_isolate <- function(x,
# join to microorganisms data set
x <- x %>%
mutate_at(vars(col_mo), as.mo) %>%
left_join_microorganisms(by = col_mo)
left_join_microorganisms(by = col_mo) %>%
# empty species will lead to first = FALSE, so put in text there if genus is available
mutate(species = ifelse(!is.na(genus) & species == "", "species", species))
col_genus <- "genus"
col_species <- "species"

View File

@ -85,12 +85,14 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
if (length(ab_result) == 0) {
if (verbose == TRUE) {
message('No column found as input for `', search_string, '`.')
message(paste0("No column found as input for `", search_string,
"` (", ab_name(search_string, language = "en", tolower = TRUE), ")."))
}
return(NULL)
} else {
if (verbose == TRUE) {
message(blue(paste0("NOTE: Using column `", bold(ab_result), "` as input for `", search_string, "`.")))
message(blue(paste0("NOTE: Using column `", bold(ab_result), "` as input for `", search_string,
"` (", ab_name(search_string, language = "en", tolower = TRUE), ").")))
}
return(ab_result)
}

View File

@ -190,17 +190,17 @@ get_column_abx <- function(x,
if (verbose == TRUE) {
for (i in 1:length(x)) {
if (x[i] %in% duplies) {
message(red(paste0("NOTE: Using column `", bold(x[i]), "` as input for ", names(x)[i],
" (", ab_name(names(x)[i], language = "en", tolower = TRUE), ") [DUPLICATED USE].")))
message(red(paste0("NOTE: Using column `", bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], language = "en", tolower = TRUE), ") [DUPLICATED USE].")))
} else {
message(blue(paste0("NOTE: Using column `", bold(x[i]), "` as input for ", names(x)[i],
" (", ab_name(names(x)[i], language = "en", tolower = TRUE), ").")))
message(blue(paste0("NOTE: Using column `", bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], language = "en", tolower = TRUE), ").")))
}
}
}
if (n_distinct(x) != length(x)) {
msg_txt <- paste("Column(s)", paste0("'", duplies, "'", collapse = "'"), "used for more than one antibiotic.")
msg_txt <- paste("Column(s)", paste0("`", duplies, "`", collapse = " and "), "used for more than one antibiotic.")
if (verbose == FALSE) {
msg_txt <- paste(msg_txt, "Use verbose = TRUE to see which antibiotics are used by which columns.")
}