2021-10-21 17:25:44 +02:00
|
|
|
# Cache the value of an expression on the file system.
|
|
|
|
|
#
|
|
|
|
|
# The expression will be evaluated if there is no matching cache file found.
|
|
|
|
|
# The cache files will be located in a directory "cache" located in the current
|
|
|
|
|
# working directory.
|
|
|
|
|
#
|
|
|
|
|
# @param name Human readable part of the cache file name.
|
|
|
|
|
# @param objects A vector of objects that this expression depends on. The hash
|
|
|
|
|
# of those objects will be used for identifying the cache file.
|
|
|
|
|
cached <- function(name, objects, expr) {
|
2022-05-26 12:42:19 +02:00
|
|
|
if (!dir.exists("cache")) {
|
|
|
|
|
dir.create("cache")
|
|
|
|
|
}
|
2021-10-21 17:25:44 +02:00
|
|
|
|
2022-05-26 12:42:19 +02:00
|
|
|
id <- rlang::hash(objects)
|
|
|
|
|
cache_file <- sprintf("cache/%s_%s.rda", name, id)
|
2021-10-21 17:25:44 +02:00
|
|
|
|
2022-05-26 12:42:19 +02:00
|
|
|
if (file.exists(cache_file)) {
|
|
|
|
|
# If the cache file exists, we restore the data from it.
|
|
|
|
|
load(cache_file)
|
|
|
|
|
} else {
|
|
|
|
|
# If the cache file doesn't exist, we have to do the computation.
|
|
|
|
|
data <- expr
|
2021-10-21 17:25:44 +02:00
|
|
|
|
2022-05-26 12:42:19 +02:00
|
|
|
# The results are cached for the next run.
|
|
|
|
|
save(data, file = cache_file, compress = "xz")
|
|
|
|
|
}
|
2021-10-21 17:25:44 +02:00
|
|
|
|
2022-05-26 12:42:19 +02:00
|
|
|
data
|
2021-10-21 17:25:44 +02:00
|
|
|
}
|
|
|
|
|
|
2022-06-03 17:41:45 +02:00
|
|
|
#' Format and round a numeric value.
|
|
|
|
|
#'
|
|
|
|
|
#' @param number The number to use.
|
|
|
|
|
#' @param digits Number of decimal places.
|
|
|
|
|
#'
|
|
|
|
|
#' @return A character value.
|
|
|
|
|
#' @noRd
|
|
|
|
|
num <- function(number, digits) {
|
|
|
|
|
format(round(number, digits = digits), nsmall = digits)
|
|
|
|
|
}
|
|
|
|
|
|
2022-08-14 17:50:59 +02:00
|
|
|
#' Find the densest value in the data.
|
|
|
|
|
#'
|
|
|
|
|
#' This function assumes that data represents a continuous variable and finds
|
|
|
|
|
#' a single value with the highest estimated density. This can be used to
|
|
|
|
|
#' estimate the mode of the data. If there is only one value that value is
|
|
|
|
|
#' returned. If multiple density maxima with the same density exist, their mean
|
|
|
|
|
#' is returned.
|
|
|
|
|
#'
|
|
|
|
|
#' @param data The input data.
|
|
|
|
|
#'
|
|
|
|
|
#' @return The densest value of data.
|
|
|
|
|
#'
|
|
|
|
|
#' @export
|
|
|
|
|
densest <- function(data) {
|
|
|
|
|
as.numeric(if (length(data) <= 0) {
|
|
|
|
|
NULL
|
|
|
|
|
} else if (length(data) == 1) {
|
|
|
|
|
data
|
|
|
|
|
} else {
|
|
|
|
|
density <- stats::density(data)
|
|
|
|
|
mean(density$x[density$y == max(density$y)])
|
|
|
|
|
})
|
|
|
|
|
}
|
|
|
|
|
|
2021-10-19 13:39:55 +02:00
|
|
|
# This is needed to make data.table's symbols available within the package.
|
|
|
|
|
#' @import data.table
|
|
|
|
|
NULL
|