P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 22:01:49 +02:00
Code Releases Activity

(v1.4.0.9041) updates based on review

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-12-17 16:22:25 +01:00
parent 1faa816090
commit 81af41da3a
74 changed files with 710 additions and 627 deletions
Download Patch File Download Diff File Expand all files Collapse all files

108
R/mo_source.R
View File

@ -30,16 +30,17 @@
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package.
#' @inheritSection lifecycle Stable lifecycle
#' @param path location of your reference file, see Details. Can be `""`, `NULL` or `FALSE` to delete the reference file.
#' @param destination destination of the compressed data file, default to the user's home directory.
#' @rdname mo_source
#' @name mo_source
#' @aliases set_mo_source get_mo_source
#' @details The reference file can be a text file separated with commas (CSV) or tabs or pipes, an Excel file (either 'xls' or 'xlsx' format) or an R object file (extension '.rds'). To use an Excel file, you will need to have the `readxl` package installed.
#'
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into R and will ask to export it to `"~/.mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created.
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` parameter and defaults to the user's home directory. It can also be set as an \R option, using `options(AMR_mo_source = "my/location/file.rds)`.
#'
#' The created compressed data file `"~/.mo_source.rds"` will be used at default for MO determination (function [as.mo()] and consequently all `mo_*` functions like [mo_genus()] and [mo_gramstain()]). The location of the original file will be saved as an R option with `options(mo_source = path)`. Its timestamp will be saved with `options(mo_source_datetime = ...)`.
#' The created compressed data file `"mo_source.rds"` will be used at default for MO determination (function [as.mo()] and consequently all `mo_*` functions like [mo_genus()] and [mo_gramstain()]). The location and timestamp of the original file will be saved as an attribute to the compressed data file.
#'
#' The function [get_mo_source()] will return the data set by reading `"~/.mo_source.rds"` with [readRDS()]. If the original file has changed (by checking the aforementioned options `mo_source` and `mo_source_datetime`), it will call [set_mo_source()] to update the data file automatically if used in an interactive session.
#' The function [get_mo_source()] will return the data set by reading `"mo_source.rds"` with [readRDS()]. If the original file has changed (by checking the location and timestamp of the original file), it will call [set_mo_source()] to update the data file automatically if used in an interactive session.
#'
#' Reading an Excel file (`.xlsx`) with only one row has a size of 8-9 kB. The compressed file created with [set_mo_source()] will then have a size of 0.1 kB and can be read by [get_mo_source()] in only a couple of microseconds (millionths of a second).
#'
@ -60,16 +61,18 @@
#'
#' ```
#' set_mo_source("home/me/ourcodes.xlsx")
#' #> NOTE: Created mo_source file '~/.mo_source.rds' from 'home/me/ourcodes.xlsx'
#' #> (columns "Organisation XYZ" and "mo")
#' #> NOTE: Created mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
#' #> "Organisation XYZ" and "mo"
#' ```
#'
#' It has now created a file `"~/.mo_source.rds"` with the contents of our Excel file. Only the first column with foreign values and the 'mo' column will be kept when creating the RDS file.
#' It has now created a file `"~/mo_source.rds"` with the contents of our Excel file. Only the first column with foreign values and the 'mo' column will be kept when creating the RDS file.
#'
#' And now we can use it in our functions:
#'
#' ```
#' as.mo("lab_mo_ecoli")
#' #> Class <mo>
#' #> [1] B_ESCHR_COLI
#'
#' mo_genus("lab_mo_kpneumoniae")
@ -77,6 +80,9 @@
#'
#' # other input values still work too
#' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
#' #> NOTE: Translation to one microorganism was guessed with uncertainty.
#' #> Use mo_uncertainties() to review it.
#' #> Class <mo>
#' #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
#' ```
#'
@ -96,8 +102,10 @@
#'
#' ```
#' as.mo("lab_mo_ecoli")
#' #> NOTE: Updated mo_source file '~/.mo_source.rds' from 'home/me/ourcodes.xlsx'
#' #> (columns "Organisation XYZ" and "mo")
#' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
#' #> "Organisation XYZ" and "mo"
#' #> Class <mo>
#' #> [1] B_ESCHR_COLI
#'
#' mo_genus("lab_Staph_aureus")
@ -108,25 +116,26 @@
#'
#' ```
#' set_mo_source(NULL)
#' # Removed mo_source file '~/.mo_source.rds'.
#' #> Removed mo_source file '/Users/me/mo_source.rds'
#' ```
#'
#' If the original Excel file is moved or deleted, the mo_source file will be removed upon the next use of [as.mo()]. If the mo_source file is manually deleted (i.e. without using [set_mo_source()]), the references to the mo_source file will be removed upon the next use of [as.mo()].
#' If the original Excel file is moved or deleted, the mo_source file will be removed upon the next use of [as.mo()].
#' @export
#' @inheritSection AMR Read more on our website!
set_mo_source <- function(path) {
meet_criteria(path, allow_class = "character", has_length = 1)
set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
meet_criteria(path, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(destination, allow_class = "character", has_length = 1)
stop_ifnot(destination %like% "[.]rds$", "the `destination` must be a file location with file extension .rds")
file_location <- path.expand("~/mo_source.rds")
mo_source_destination <- path.expand(destination)
stop_ifnot(interactive(), "This function can only be used in interactive mode, since it must ask for the user's permission to write a file to their home folder.")
if (is.null(path) || path %in% c(FALSE, "")) {
options(mo_source = NULL)
options(mo_source_timestamp = NULL)
if (file.exists(file_location)) {
unlink(file_location)
message_("Removed mo_source file '", font_bold(file_location), "'",
mo_env$mo_source <- NULL
if (file.exists(mo_source_destination)) {
unlink(mo_source_destination)
message_("Removed mo_source file '", font_bold(mo_source_destination), "'",
add_fn = font_red,
as_note = FALSE)
}
@ -178,16 +187,19 @@ set_mo_source <- function(path) {
}
df <- as.data.frame(df, stringAsFactors = FALSE)
df[, "mo"] <- set_clean_class(df[, "mo", drop = TRUE], c("mo", "character"))
# success
if (file.exists(file_location)) {
if (file.exists(mo_source_destination)) {
action <- "Updated"
} else {
action <- "Created"
# only ask when file is created, not when it is updated
txt <- paste0("This will write create the new file '",
file_location,
"', for which your permission is needed.\n\nDo you agree that this file will be created? ")
txt <- paste0(word_wrap(paste0("This will write create the new file '",
mo_source_destination,
"', for which your permission is needed.")),
"\n\n",
word_wrap("Do you agree that this file will be created?"))
if ("rsasdtudioapi" %in% rownames(utils::installed.packages())) {
showQuestion <- import_fn("showQuestion", "rstudioapi")
q_continue <- showQuestion("Create new file in home directory", txt)
@ -198,42 +210,38 @@ set_mo_source <- function(path) {
return(invisible())
}
}
saveRDS(df, file_location)
options(mo_source = path)
options(mo_source_timestamp = as.character(file.info(path)$mtime))
message_(action, " mo_source file '", font_bold(file_location), "'",
" from '", font_bold(path), "'",
'(columns "', colnames(df)[1], '" and "', colnames(df)[2], '")')
attr(df, "mo_source_location") <- path
attr(df, "mo_source_timestamp") <- file.mtime(path)
saveRDS(df, mo_source_destination)
mo_env$mo_source <- df
message_(action, " mo_source file '", font_bold(mo_source_destination),
"' (", formatted_filesize(mo_source_destination),
") from '", font_bold(path),
"' (", formatted_filesize(path),
'), columns "', colnames(df)[1], '" and "', colnames(df)[2], '"')
}
#' @rdname mo_source
#' @export
get_mo_source <- function() {
if (is.null(getOption("mo_source", NULL))) {
get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
if (!file.exists(path.expand(destination))) {
if (interactive()) {
# source file might have been deleted, update reference
set_mo_source("")
}
return(NULL)
}
if (!file.exists(path.expand("~/mo_source.rds"))) {
options(mo_source = NULL)
options(mo_source_timestamp = NULL)
message_("Removed references to deleted mo_source file (see ?mo_source)")
return(NULL)
if (is.null(mo_env$mo_source)) {
mo_env$mo_source <- readRDS(path.expand(destination))
}
old_time <- as.POSIXct(getOption("mo_source_timestamp"))
new_time <- as.POSIXct(as.character(file.info(getOption("mo_source", ""))$mtime))
if (is.na(new_time)) {
# source file was deleted, remove reference too
set_mo_source("")
return(NULL)
old_time <- attributes(mo_env$mo_source)$mo_source_timestamp
new_time <- file.mtime(attributes(mo_env$mo_source)$mo_source_location)
if (interactive() && !identical(old_time, new_time)) {
# source file was updated, also update reference
set_mo_source(attributes(mo_env$mo_source)$mo_source_location)
}
if (interactive() && new_time != old_time) {
# set updated source
set_mo_source(getOption("mo_source"))
}
file_location <- path.expand("~/mo_source.rds")
readRDS(file_location)
mo_env$mo_source
}
mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
@ -242,7 +250,7 @@ mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
return(TRUE)
}
if (identical(x, get_mo_source())) {
if (is.null(mo_env$mo_source) && (identical(x, get_mo_source()))) {
return(TRUE)
}
if (is.null(x)) {