(v0.6.1.9044) first_isolate fix for species

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.

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:

R/first_isolate.R

@@ -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"
 

R/guess_ab_col.R

@@ -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)
   }

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.")
     }