##==========================================
## Name Convention in the rbms package
##
## FUNCTION: ts_snake_function()
## ARGUMENT: CamelNotation
## OBJECT: object_snake_name
## VARIABLE NAME: UPPER_CASE
##
## Date: 31.01.2021
##
## rbms_toolbox: useful functions for the rbms package
##
##==========================================
.onAttach <- function(libname, pkgname) {
packageStartupMessage(" Welcome to rbms, version 1.1.3 \n This package has been tested, but is still in active development and feedbacks are welcome\n https://github.com/RetoSchmucki/rbms/issues")
}
#' initiate_project
#' Build the folder structure for a generic research project
#' @param project_name Name of the project to be used for the parent folder
#' @param project_home Path where the project folder structure to be built, default is the current working directory
#' @author Reto Schmucki - \email{reto.schmucki@@mail.mcgill.ca}
#' @export initiate_project
#'
initiate_project <- function(project_name, project_home = NULL){
if(!is.character(project_name)){
stop("project_name must be defined as characters")
}
if(is.null(project_home)){
project_home <- getwd()
}
prj_path <- file.path(project_home, project_name)
if (dir.exists(prj_path)){
setwd(prj_path)
} else {
cat(paste0('Building project folder: ', prj_path, '\n'))
dir.create(prj_path, recursive = TRUE)
setwd(prj_path)
}
if (dir.exists(file.path(prj_path, 'data'))) {
cat(paste('Ready to work on', project_name,'\n'))
} else {
setwd(prj_path)
cat(paste0('Building the folder structure for ', project_name, '\n'))
dir.create("R")
dir.create("data")
dir.create("documentation")
dir.create("output")
dir.create("manuscript")
}
setwd(prj_path)
}
#' check_package
#' Internal function to check if a package is installed.
#' @param pkgName The package name to be verified.
#' @param message1 Inform the user about the package dependency.
#' @param message2 Inform the user what happen if the package is not installed.
#' @return If package is not found, the user is offered the option to install the missing package.
#' @author Reto Schmucki - \email{reto.schmucki@@mail.mcgill.ca}
#' @importFrom utils install.packages
#' @export check_package
#'
check_package <- function(pkgName = NULL, message1 = 'You need to install ', message2 = 'This version requires'){
if(!is.character(pkgName)){
stop("pkgName must be defined as characters")
}
if (!requireNamespace(pkgName)) {
print(paste(message1, pkgName))
x <- readline(paste("Do you want to install", pkgName, "? Y/N"))
if (toupper(x) == 'Y') {
install.packages(pkgName)
}
if (toupper(x) == 'N') {
print(paste(message2, pkgName))
}
}
}
#' check_names
#' Verify for the required column names in the data object.
#' @param x Data object in which the variables names are verified.
#' @param y Variable names to be verified.
#' @return Verifyies if column names listed in \code{y} are found in the data set \code{x}, if not, a message identifies the
#' missing column name and stops.
#' @details This function is not case sensitive, but it does not accept different names or spelling.
#' @author Reto Schmucki - \email{reto.schmucki@@mail.mcgill.ca}
#' @export check_names
#'
check_names <- function(x, y){
if(!is.character(y)){
stop("pkgName must be characters")
}
dt_names <- y %in% names(x)
if(sum(dt_names) != length(y)) {
stop(paste('You need a variable -', paste(y[!dt_names], collapse = ' & '), '- in table', deparse(substitute(x)), '\n'))
}
}
#' ts_date_seq
#' Generate a time-series with dates starting from January of the starting year to December of the ending years.
#' @param InitYear First year of the time-series, four digits format (e.g. 1987).
#' @param LastYear Last year of the time-series, if not provided, the current year is used.
#' @return Returns a POSIXct vector with the format 'YYYY-MM-DD HH:MM:SS'
#' @keywords time-series
#' @author Reto Schmucki - \email{reto.schmucki@@mail.mcgill.ca}
#' @export ts_date_seq
#'
ts_date_seq <- function(InitYear = 1970, LastYear = format(Sys.Date(), "%Y")) {
if(nchar(InitYear) != 4){stop("InitialYear must be provided in a four digits format (e.g. 1987)")}
init_date <- as.Date(paste((InitYear - 1), "01-01", sep = "-"))
last_date <- as.Date(paste((as.numeric(LastYear) + 1), "12-31", sep = "-"))
date_series <- as.POSIXct(seq(from = init_date, to = last_date, by = "day"), format = "%Y-%m-%d")
date_series <- date_series[!format(date_series, '%Y') %in% c((InitYear - 1), as.numeric(LastYear) + 1)]
return(date_series)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.