AMR/R/mo_history.R

118 lines
5.0 KiB
R
Raw Normal View History

2019-03-15 13:57:25 +01:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# #
# This R package was created for academic research and was publicly #
# released in the hope that it will be useful, but it comes WITHOUT #
# ANY WARRANTY OR LIABILITY. #
# Visit our website for more info: https://msberends.gitab.io/AMR. #
# ==================================================================== #
# print successful as.mo coercions to file, not uncertain ones
2019-03-18 14:29:41 +01:00
#' @importFrom dplyr %>% distinct filter
2019-03-26 14:24:03 +01:00
set_mo_history <- function(x, mo, uncertainty_level, force = FALSE) {
2019-03-15 13:57:25 +01:00
file_location <- base::path.expand('~/.Rhistory_mo')
2019-03-15 17:36:42 +01:00
if (base::interactive() | force == TRUE) {
2019-03-26 14:24:03 +01:00
mo_hist <- read_mo_history(uncertainty_level = uncertainty_level, force = force)
2019-03-18 14:29:41 +01:00
df <- data.frame(x, mo, stringsAsFactors = FALSE) %>%
distinct(x, .keep_all = TRUE) %>%
filter(!is.na(x) & !is.na(mo))
if (nrow(df) == 0) {
return(base::invisible())
}
x <- toupper(df$x)
2019-03-15 17:36:42 +01:00
mo <- df$mo
for (i in 1:length(x)) {
2019-03-18 14:29:41 +01:00
# save package version too, as both the as.mo() algorithm and the reference data set may change
2019-03-26 14:24:03 +01:00
if (NROW(mo_hist[base::which(mo_hist$x == x[i] &
mo_hist$uncertainty_level >= uncertainty_level &
mo_hist$package_version == utils::packageVersion("AMR")),]) == 0) {
base::write(x = c(x[i], mo[i], uncertainty_level, base::as.character(utils::packageVersion("AMR"))),
2019-03-15 17:36:42 +01:00
file = file_location,
2019-03-26 14:24:03 +01:00
ncolumns = 4,
2019-03-15 17:36:42 +01:00
append = TRUE,
sep = "\t")
}
2019-03-15 13:57:25 +01:00
}
}
return(base::invisible())
}
2019-03-26 14:24:03 +01:00
get_mo_history <- function(x, uncertainty_level, force = FALSE) {
file_read <- read_mo_history(uncertainty_level = uncertainty_level, force = force)
2019-03-15 13:57:25 +01:00
if (base::is.null(file_read)) {
NA
} else {
2019-03-18 14:29:41 +01:00
data.frame(x = toupper(x), stringsAsFactors = FALSE) %>%
2019-03-15 13:57:25 +01:00
left_join(file_read, by = "x") %>%
pull(mo)
}
}
2019-03-15 17:36:42 +01:00
#' @importFrom dplyr %>% filter distinct
2019-03-26 14:24:03 +01:00
read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = FALSE) {
2019-03-15 13:57:25 +01:00
file_location <- base::path.expand('~/.Rhistory_mo')
if (!base::file.exists(file_location) | (!base::interactive() & force == FALSE)) {
return(NULL)
}
2019-03-26 14:24:03 +01:00
uncertainty_level_param <- uncertainty_level
2019-03-15 13:57:25 +01:00
file_read <- utils::read.table(file = file_location,
header = FALSE,
sep = "\t",
2019-03-26 14:24:03 +01:00
col.names = c("x", "mo", "uncertainty_level", "package_version"),
2019-03-15 13:57:25 +01:00
stringsAsFactors = FALSE)
# Below: filter on current package version.
2019-03-15 17:36:42 +01:00
# Even current fullnames may be replaced by new taxonomic names, so new versions of
2019-03-15 13:57:25 +01:00
# the Catalogue of Life must not lead to data corruption.
2019-03-26 14:24:03 +01:00
if (unfiltered == FALSE) {
file_read <- file_read %>%
filter(package_version == utils::packageVersion("AMR"),
# only take unknowns if uncertainty_level_param is higher
((mo == "UNKNOWN" & uncertainty_level_param == uncertainty_level) |
(mo != "UNKNOWN" & uncertainty_level_param >= uncertainty_level))) %>%
arrange(desc(uncertainty_level)) %>%
distinct(x, mo, .keep_all = TRUE)
}
if (nrow(file_read) == 0) {
NULL
} else {
file_read
}
2019-03-15 13:57:25 +01:00
}
#' @rdname as.mo
2019-03-26 14:24:03 +01:00
#' @importFrom crayon red
#' @importFrom utils menu
2019-03-15 13:57:25 +01:00
#' @export
2019-03-26 14:24:03 +01:00
clean_mo_history <- function(...) {
2019-03-15 13:57:25 +01:00
file_location <- base::path.expand('~/.Rhistory_mo')
2019-03-26 14:24:03 +01:00
if (file.exists(file_location)) {
if (interactive() & !isTRUE(list(...)$force)) {
q <- menu(title = paste("This will remove all",
format(nrow(read_mo_history(999, unfiltered = TRUE)), big.mark = ","),
"previously determined microbial IDs. Are you sure?"),
choices = c("Yes", "No"),
graphics = FALSE)
if (q != 1) {
return(invisible())
}
}
unlink(file_location)
cat(red("File", file_location, "removed."))
2019-03-15 13:57:25 +01:00
}
}