Nothing
#' @title Get Object Size
#'
#' @description A function to get the size of an object
#'
#' @param object The target object.
#'
#' @return A named list object that contains information on the
#' size of an object and the size unit.
#'
#' @examples
#' res <- get_object_size(TRUE)
#' res$size
#' res$unit
#'
get_object_size <- function(object) {
check_size_res <- format(utils::object.size(object), units = "auto")
size_num <- as.numeric(stringr::str_extract(check_size_res, "[0-9.]+"))
size_unit <- (stringr::str_extract(check_size_res, "[aA-zZ]+"))
list(size = size_num, unit = size_unit)
}
#' @title Setup Random Test Data
#'
#' @description A function to generate test data for RBC for toy examples.
#'
#' @param num_people The number of person instances.
#' @param initial_date The start crossing date.
#' @param numJourneys The number of journeys for each person.
#' @param min The minimum duration between journeys.
#' @param max The maximum duration between journeys.
#' @return A data frame object
#'
#' @examples
#'
#' res <- setup_random_test_data(10,
#' initial_date = '2001-01-01',
#' numJourneys = 5,
#' min = 0,
#' max = 10)
#' head(res)
#'
#' @export
## NOT TEST
setup_random_test_data <- function(num_people = 10,
initial_date = "2001-01-01",
numJourneys = 5,
min = 0,
max = 10) {
res <- lapply(seq_len(num_people), function(index, numJourneys) {
pId <- index
dates <- get_random_dates(initial_date, numJourneys, min = min, max = max)
res <- lapply(seq_along(dates), function(c_date_inx) {
c_date <- as.character(dates[[c_date_inx]])
jid <- c_date_inx
c(journeyId = jid,
personId = pId,
is_arrival = jid %% 2,
date_crossing = c_date,
journey_sequence = jid,
res_status_before = 0,
res_status_after = 0,
journeyId_prev = 0)
})
res
}, numJourneys)
res <- unlist(res, recursive = FALSE)
res <- as.data.frame(do.call(rbind, res), stringsAsFactors = FALSE)
res
}
#' @title Get Random Dates
#'
#' @description An internal function to create test data
#'
#' This function is used to generate random dates
#' for \code{setup_random_test_data}
#'
#' @param start_date The start crossing date.
#' @param num_of_dates The number of journeys for each person.
#' @param min The minimum duration between journeys.
#' @param max The maximum duration between journeys.
#' @param seed A random seed to generate random dates.
#'
#' @return A list of boarder crossing dates
get_random_dates <- function(start_date,
num_of_dates = 1000,
min = 0,
max = 100,
seed = NULL) {
set.seed(seed)
init_date <- as.Date(start_date, "%Y-%m-%d")
days_elapse <- sort(round(stats::runif(n = (num_of_dates - 1),
min = min,
max = max)))
res <- list()
res[[length(res) + 1]] <- init_date
for (i in days_elapse) {
res[[length(res) + 1]] <- res[[length(res)]] + i
}
res
}
#' @title Initialize Futile Logger
#'
#' @description This function is used to initialize the futile.logger
#' so that the user can be notified with the current
#' status of running RBC.
#'
#' @param log_level a parameter representing a threshold, which
#' affects the visibility of a given logger. If the log level is at or
#' higher in priority than the logger threshold, a message will print.
#' Otherwise the command will silently return. The value of the log_level
#' is a number between 1 and 9. 9 or futile.logger::TRACE will show all
#' messages in details.
#' @param log_path A path for the output log files generated by the
#' logger. If NULL, all messages will be displayed in the calling
#' environment.
#'
#' @return it runs on side effects but also return a simple message.
#' @examples
#' ## futile.logger::FATAL: 1
#' ## futile.logger::ERROR: 2
#' ## futile.logger::WARN: 4
#' ## futile.logger::INFO: 6
#' ## futile.logger::DEBUG: 8
#' ## futile.logger::TRACE: 9
#'
#' ## to suppresse log messages to the console
#' migrbc::initialize_logger(log_level = 1)
#'
#' ## to display all messages to the console
#' migrbc::initialize_logger(log_level = 9)
#'
#' @export
## NOT TEST
initialize_logger <- function(log_level = 6, log_path = NULL) {
name_logger <- "migrbc"
if (is.na(log_level))
stop(gettextf("'%s' is missing", "log_level"))
if (!is.numeric(log_level))
stop(gettextf("'%s' is non-numeric", "log_level"))
if (!(log_level %in% 1:9))
stop(gettext("'%s' has invalid value [%s]", "log_level", log_level))
if (is.null(log_path)) {
appender <- futile.logger::appender.console()
} else {
appender <- futile.logger::appender.file(log_path)
}
futile.logger::flog.appender(appender, name = name_logger)
futile.logger::flog.threshold(log_level, name = name_logger)
layout <- futile.logger::layout.format("[~l] [~t] [~n.~f] ~m")
futile.logger::flog.layout(layout, name = "ROOT")
msg1 <- sprintf("logger '%s' has log_level=%d and writes to",
name_logger,
log_level)
if (is.null(log_path))
msg2 <- "the console" else msg2 <- sprintf("file '%s'", log_path)
cat(msg1, msg2, "\n")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.