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:
33
R/age.R
33
R/age.R
@ -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.
|
||||
|
9
R/amr.R
9
R/amr.R
@ -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:
|
||||
|
@ -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"
|
||||
|
||||
|
@ -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)
|
||||
}
|
||||
|
10
R/misc.R
10
R/misc.R
@ -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.")
|
||||
}
|
||||
|
Reference in New Issue
Block a user