#' Validate arguments of EMLassemblyline functions
#'
#' @description
#' Validate input arguments to EMLassemblyline functions.
#'
#' @param fun.name
#' (character) Name calling function.
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{argument_issues}{Any issues found in the validation process and returned as a list of character strings to the users environment. This object can be saved for later use and viewed in a human readable form with \code{issues()}}.
#'
#' @note Some arise where an arguments value is set to NULL
#'
#' @details
#' \code{fun.name} defines which checks to call.
#'
#' \code{fun.args} values are modified when critical issues are found and are reassigned to the calling environment so the calling function may proceed without error.
#'
#' @keywords internal
#'
validate_arguments <- function(fun.name, fun.args){
# Parameterize --------------------------------------------------------------
use_i <- sapply(fun.args, function(X) identical(X, quote(expr=)))
fun.args[use_i] <- list(NULL)
# Call from annotate_eml() --------------------------------------------------
if (fun.name == 'annotate_eml'){
# annotations
if (is.null(fun.args$annotations)) {
stop('Input argument "annotations" is missing.', call. = FALSE)
}
if (is.character(fun.args$annotations)) {
if (!file.exists(fun.args$annotations)) {
stop(
paste0(
"The file specified by the input argument 'annotations' doesn't ",
"exist."
),
call. = FALSE
)
}
} else if (!is.data.frame(fun.args$annotations)) {
stop(
"Input argument 'annotations' is not one of the two supported types.",
call. = FALSE
)
}
# eml.in
if (is.null(fun.args$eml.in)) {
stop('Input argument "eml.in" is missing.', call. = FALSE)
}
if (is.character(fun.args$eml.in)) {
if (!file.exists(fun.args$eml.in)) {
stop(
paste0(
"The file specified by the input argument 'eml.in' doesn't ",
"exist."
),
call. = FALSE
)
} else {
# FIXME: emld::eml_validate() has a new set of constraints causing
# validate_eml_content() to stop here. Some initial testing suggests
# deep inconsistency in emld's validation methods so loosening
# this constraint for the time being in favor of more productive ends.
# eml <- EML::read_eml(fun.args$eml.in)
# if (!emld::eml_validate(eml)) {
# stop(
# "Input argument 'eml.in' is not a valid EML record.",
# call. = FALSE
# )
# }
}
} else if (!any(class(fun.args$eml.in) %in% c("emld", "list"))) {
stop(
"Input argument 'eml.in' is not one of the two supported types.",
call. = FALSE
)
}
# eml.out
if (is.character(fun.args$eml.in) & is.null(fun.args$eml.out)) {
stop(
"Input argument 'eml.out' is missing.",
call. = FALSE
)
}
if (!is.null(fun.args$eml.out) & is.character(fun.args$eml.out)) {
if (!dir.exists(dirname(fun.args$eml.out))) {
stop(
"Input argument 'eml.out' is a non-existant path.",
call. = FALSE
)
}
}
}
# Call from eml2eal() -------------------------------------------------------
if (fun.name == "eml2eal"){
if (!isTRUE(fun.args$empty)){
# eml
if (!file.exists(fun.args$eml)) {
stop("Input argument 'eml' is to a non-existant object.", call. = F)
}
# file.type
if (!(fun.args$file.type %in% c(".docx", ".txt", ".md"))) {
stop("Input argument 'file.type' must be '.docx', '.txt', or '.md'.",
call. = F)
}
# path
if (is.null(fun.args$path)) {
stop("Input argument 'path' is missing.", call. = FALSE)
}
}
}
# Call from define_catvars() ------------------------------------------------
if (fun.name == 'define_catvars'){
# If not using x ...
if (is.null(fun.args$x)){
# Get attribute file names and data file names
files <- list.files(fun.args$path)
use_i <- stringr::str_detect(string = files,
pattern = "^attributes")
if (sum(use_i) == 0){
stop('There are no attributes.txt files in your dataset working directory. Please fix this.')
}
attribute_files <- files[use_i]
table_names_base <- stringr::str_sub(string = attribute_files,
start = 12,
end = nchar(attribute_files)-4)
data_files <- list.files(fun.args$data.path)
use_i <- stringr::str_detect(string = data_files,
pattern = stringr::str_c("^", table_names_base, collapse = "|"))
table_names <- data_files[use_i]
data_files <- table_names
# Send warning if data table name is repeated more than once
if (length(unique(tools::file_path_sans_ext(data_files))) != length(data_files)){
stop('Duplicate data file names exist in this directory. Please remove duplicates, even if they are a different file type.')
}
# If using x ...
} else if (!is.null(fun.args$x)){
# Get attribute file names and data file names
files <- names(fun.args$x$template)
use_i <- stringr::str_detect(string = files,
pattern = "^attributes")
if (sum(use_i) == 0){
stop('There are no attributes.txt files in your dataset working directory. Please fix this.')
}
attribute_files <- files[use_i]
table_names_base <- stringr::str_sub(string = attribute_files,
start = 12,
end = nchar(attribute_files)-4)
data_files <- names(fun.args$x$data.table)
use_i <- stringr::str_detect(string = data_files,
pattern = stringr::str_c("^", table_names_base, collapse = "|"))
table_names <- data_files[use_i]
data_files <- table_names
# Send warning if data table name is repeated more than once
if (length(unique(tools::file_path_sans_ext(data_files))) != length(data_files)){
stop('Duplicate data file names exist in this directory. Please remove duplicates, even if they are a different file type.')
}
}
}
# Call from extract_geocoverage() -------------------------------------------
if (fun.name == 'extract_geocoverage'){
# Handle deprecated arguments
if (!is.null(fun.args$data.file)){
fun.args$data.table <- fun.args$data.file
}
# data.table
if (is.null(fun.args$data.table)){
stop('Input argument "data.table" is missing! Specify the data file containing the geographic coordinates.')
}
# lat.col
if (is.null(fun.args$lat.col)){
stop('Input argument "lat.col" is missing! Specify latitude column name.')
}
# lon.col
if (is.null(fun.args$lon.col)){
stop('Input argument "lon.col" is missing! Specify longitude column name.')
}
# site.col
if (is.null(fun.args$site.col)){
stop('Input argument "site.col" is missing! Specify site column name.')
}
}
# Call from import_templates() ----------------------------------------------
if (fun.name == 'import_templates'){
# Handle deprecated arguments
if (!is.null(fun.args$data.files)){
fun.args$data.table <- fun.args$data.files
}
# license
if (is.null(fun.args$license)){
stop('Input argument "license" is missing')
}
license.low <- tolower(fun.args$license)
if (!stringr::str_detect(license.low, "^cc0$|^ccby$")){
stop('Invalid value entered for the "license" argument. Please choose "CC0" or "CCBY".')
}
# data.table
if (!is.null(fun.args$data.table)){
# Validate table names
data_files <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$data.table
)
)
}
}
# Call from make_eml() ------------------------------------------------------
if (fun.name == 'make_eml'){
# argument_issues object should be removed from the global environment each
# time this function is called otherwise issues that have been fixed may
# appear outstanding
if (exists("argument_issues", where = ".GlobalEnv")) {
rm(argument_issues, envir = as.environment(".GlobalEnv"))
}
# Initialize object for collecting issue messages
issues <- c()
# Handle deprecated arguments
if (!is.null(fun.args$affiliation)){
fun.args$user.domain <- fun.args$affiliation
}
if (!is.null(fun.args$data.files)){
fun.args$data.table <- fun.args$data.files
}
if (!is.null(fun.args$data.files.description)){
fun.args$data.table.description <- fun.args$data.files.description
}
if (!is.null(fun.args$data.files.quote.character)){
fun.args$data.table.quote.character <- fun.args$data.files.quote.character
}
if (!is.null(fun.args$data.files.url)){
fun.args$data.url <- fun.args$data.files.url
}
if (!is.null(fun.args$zip.dir)){
fun.args$other.entity <- fun.args$zip.dir
}
if (!is.null(fun.args$zip.dir.description)){
fun.args$other.entity.description <- fun.args$zip.dir.description
}
# path
if (is.null(fun.args$x)) {
validate_path(fun.args$path)
}
# data.path
validate_path(fun.args$data.path)
# eml.path
if (isTRUE(fun.args$write.file)){
validate_path(fun.args$eml.path)
}
# dataset.title
issues <- c(issues, validate_title(fun.args))
# data.table
if (!is.null(fun.args$data.table)) {
table_names <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$data.table))
}
# data.table.description
r <- validate_table_description(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# data.table.name
r <- validate_table_name(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# data.table.quote.character
r <- validate_table_quote_character(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# data.table.url
r <- validate_table_url(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# geographic.coordinates and geographic.description
r <- validate_geographic_coord_desc(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# maintenance.description
r <- validate_maintenance_description(fun.args)
issues <- c(issues, r$issues)
# other.entity
if (!is.null(fun.args$other.entity)) {
other_entity_names <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$other.entity))
}
# other.entity.name
r <- validate_other_entity_name(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# other.entity.description
r <- validate_other_entity_description(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# other.entity.url
r <- validate_other_entity_url(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# temporal.coverage
r <- validate_temporal_coverage(fun.args)
issues <- c(issues, r$issues)
fun.args <- r$fun.args
# Return
if (!is.null(issues)) {
list2env(
list(argument_issues = issues),
# if(is.null(options("eal.env"))) {
.GlobalEnv
# } else {
# options("eal.env")[[1]]
# }
)
warning(
"Argument issues found. Use issues() to see them.",
call. = FALSE)
}
for (i in seq_along(fun.args)) {
assign(
x = names(fun.args[i]),
value = fun.args[[i]],
envir = parent.frame())
}
}
# Call from template_annotations() ------------------------------------------
if (fun.name == 'template_annotations'){
# path
if (is.null(fun.args$path)) {
stop('Input argument "path" is missing.', call. = FALSE)
}
if (!is.null(fun.args$path)) {
validate_path(fun.args$path)
}
if (file.exists(paste0(fun.args$path, "/annotations.txt"))) {
stop(
paste0(
"annotations.txt already exists. To create a new annotations ",
"template, remove this one from 'path'."
),
call. = FALSE
)
}
# data.path
if (!is.null(fun.args$data.path)) {
validate_path(fun.args$data.path)
}
# data.table
if (!is.null(fun.args$data.table)){
table_names <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$data.table
)
)
}
# other.entity
if (!is.null(fun.args$other.entity)){
table_names <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$other.entity
)
)
}
# default.annotations
if (!is.null(fun.args$default.annotations)){
if (!is.data.frame(fun.args$default.annotations)) {
stop(
"Input argument 'default.annotations' is not a data frame.",
call. = FALSE
)
}
if (!all(c("element", "predicate_label", "predicate_uri", "object_label",
"object_uri") %in% colnames(fun.args$default.annotations))) {
stop(
paste0(
"The 'default.annotations' data frame is missing one or more of ",
"these columns: 'element', 'predicate_label', 'predicate_uri', ",
"'object_label', 'object_uri'"
),
call. = FALSE
)
}
}
# eml
if (!is.null(fun.args$eml)) {
if (!file.exists(paste0(fun.args$eml.path, "/", fun.args$eml))) {
stop(
paste0("The file ", fun.args$eml, " cannot be found at 'path'."),
call. = FALSE
)
}
}
}
# Call from template_arguments() ------------------------------------------------
if (fun.name == 'template_arguments') {
# path
if (!is.null(fun.args$path)) {
validate_path(fun.args$path)
attr_tmp <- read_template_attributes()
path_files <- list.files(fun.args$path)
if (!length(path_files) == 0) {
is_template <- rep(FALSE, length(path_files))
for (i in 1:length(path_files)){
is_template[i] <- any(
stringr::str_detect(path_files[i], attr_tmp$regexpr))
}
if (!any(is_template)) {
stop("No metadata templates found at 'path'.", call. = F)
}
} else {
stop("No metadata templates found at 'path'.", call. = F)
}
check_duplicate_templates(fun.args$path)
}
# data.path
if (!is.null(fun.args$data.path)){
validate_path(fun.args$data.path)
}
# data.table
if (!is.null(fun.args$data.table)){
output <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$data.table
)
)
}
# other.entity
if (!is.null(fun.args$other.entity)){
output <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$other.entity
)
)
}
}
# Call from template_categorical_variables() -------------------------------------
if (fun.name == 'template_categorical_variables'){
if (is.null(fun.args$path)) {
stop("Input argument 'path' is missing", call. = FALSE)
}
# Get attribute file names and data file names
files <- list.files(fun.args$path)
use_i <- stringr::str_detect(string = files,
pattern = "^attributes")
if (sum(use_i) == 0){
stop('There are no attributes.txt files in your dataset working directory. Please fix this.', call. = F)
}
attribute_files <- files[use_i]
table_names_base <- stringr::str_sub(string = attribute_files,
start = 12,
end = nchar(attribute_files)-4)
data_files <- list.files(fun.args$data.path)
use_i <- stringr::str_detect(string = data_files,
pattern = stringr::str_c("^", table_names_base, collapse = "|"))
table_names <- data_files[use_i]
data_files <- table_names
# Send warning if data table name is repeated more than once
if (length(unique(tools::file_path_sans_ext(data_files))) != length(data_files)){
stop('Duplicate data file names exist in this directory. Please remove duplicates, even if they are a different file type.', call. = F)
}
}
# Call from template_core_metadata() ----------------------------------------
if (fun.name == 'template_core_metadata'){
# license
if (is.null(fun.args$license)){
stop('Input argument "license" is missing', call. = F)
}
license.low <- tolower(fun.args$license)
if (!stringr::str_detect(license.low, "^cc0$|^ccby$")){
stop('Invalid value entered for the "license" argument. Please choose "CC0" or "CCBY".', call. = F)
}
# file.type
if ((fun.args$file.type != '.txt') & (fun.args$file.type != '.docx') &
(fun.args$file.type != '.md')){
stop(paste0('"', fun.args$file.type, '" is not a valid entry to the "file.type" argument.'), call. = F)
}
}
# Call from template_geographic_coverage() -------------------------------------
if (fun.name == 'template_geographic_coverage'){
if (!isTRUE(fun.args$empty)){
# data.table
if (is.null(fun.args$data.table)){
stop('Input argument "data.table" is missing! Specify the data file containing the geographic coordinates.', call. = F)
}
# lat.col
if (is.null(fun.args$lat.col)){
stop('Input argument "lat.col" is missing! Specify latitude column name.', call. = F)
}
# lon.col
if (is.null(fun.args$lon.col)){
stop('Input argument "lon.col" is missing! Specify longitude column name.', call. = F)
}
# site.col
if (is.null(fun.args$site.col)){
stop('Input argument "site.col" is missing! Specify site column name.', call. = F)
}
if (is.null(fun.args$x)){
# Validate file name
data_file <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$data.table
)
)
# Read data table
x <- template_arguments(
data.path = fun.args$data.path,
data.table = data_file
)
x <- x$x
data_read_2_x <- NA_character_
}
df_table <- fun.args$x$data.table[[fun.args$data.table]]$content
# Validate column names
columns <- colnames(df_table)
columns_in <- c(fun.args$lat.col, fun.args$lon.col, fun.args$site.col)
use_i <- stringr::str_detect(string = columns,
pattern = stringr::str_c("^", columns_in, "$", collapse = "|"))
if (sum(use_i) > 0){
use_i2 <- columns[use_i]
use_i3 <- columns_in %in% use_i2
if (sum(use_i) != 3){
stop(paste("Invalid column names entered: ", paste(columns_in[!use_i3], collapse = ", "), sep = ""), call. = F)
}
}
}
}
# Call from template_provenance() -------------------------------------------
if (fun.name == 'template_provenance'){
# path
if (!is.null(fun.args$path)) {
validate_path(fun.args$path)
}
}
# Call from template_table_attributes() -------------------------------------
if (fun.name == 'template_table_attributes'){
# data.table
if (!is.null(fun.args$data.table)){
# Validate table names
data_files <- suppressWarnings(
validate_file_names(
path = fun.args$data.path,
data.files = fun.args$data.table))
# attributeName - Names follow best practices
r <- lapply(
fun.args$data.table,
function(k) {
x <- template_arguments(
data.path = fun.args$data.path,
data.table = k)$x
use_i <- stringr::str_detect(
colnames(x$data.table[[k]]$content), "(%|[:blank:]|([:punct:]^_))")
if (any(use_i)) {
paste0(
k, " has column names that are not composed of strictly ",
"alphanumeric characters and underscores (recommended). This ",
"best practice ensures the data may be read by most software ",
"applications. Consider revising these columns: ",
paste(
colnames(x$data.table[[k]]$content)[use_i], collapse = ", "))
}
})
if (!is.null(unlist(r))) {
warning(paste(unlist(r), collapse = "\n"), call. = FALSE)
}
}
}
# Call from template_taxonomic_coverage() -------------------------------------
if (fun.name == 'template_taxonomic_coverage'){
# When not returning an empty template, several arguments are required
if (!isTRUE(fun.args$empty)) {
# path
if (isTRUE(fun.args$write.file)) {
validate_path(fun.args$path)
}
# data.path
validate_path(fun.args$data.path)
# taxa.table
if (is.null(fun.args$taxa.table)) {
stop('Input argument "taxa.table" is missing.', call. = F)
}
fun.args$x <- template_arguments(
data.path = fun.args$data.path,
data.table = fun.args$taxa.table)$x
if (!any(fun.args$taxa.table %in% names(fun.args$x$data.table))) {
stop('Input argument "taxa.table" is invalid.', call. = F)
}
# taxa.col
if (is.null(fun.args$taxa.col)){
stop('Input argument "taxa.col" is missing.')
}
if (length(fun.args$taxa.col) != length(fun.args$taxa.table)){
stop('Each "taxa.table" requires a corresponding "taxa.col".', call. = F)
}
for (i in seq_along(fun.args$taxa.table)){
if (!isTRUE(fun.args$taxa.col[i] %in% colnames(fun.args$x$data.table[[i]]$content))) {
stop('Input argument "taxa.col" can not be found in "taxa.table".', call. = F)
}
}
# taxa.name.type
if (is.null(fun.args$taxa.name.type)){
stop('Input argument "taxa.name.type" is missing.', call. = F)
} else {
if (!any(tolower(fun.args$taxa.name.type) %in% c('scientific', 'common', 'both'))){
stop('Input argument "taxa.name.type" must be "scientific", "common", or "both".', call. = F)
}
}
# taxa.authority
if (is.null(fun.args$taxa.authority)){
stop('Input argument "taxa.authority" is missing.', call. = F)
}
authorities <- taxonomyCleanr::view_taxa_authorities()
authorities <- authorities[authorities$resolve_sci_taxa == 'supported', ]
use_i <- as.character(fun.args$taxa.authority) %in% as.character(authorities$id)
if (sum(use_i) != length(use_i)){
stop('Input argument "taxa.authority" contains unsupported authority IDs.', call. = F)
}
}
# When returning an empty template, not much is required
if (isTRUE(fun.args$empty)) {
# path
if (isTRUE(fun.args$write.file)) {
validate_path(fun.args$path)
}
}
}
}
#' Validate dataset title
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{character}{Description of issues}
#' \item{NULL}{If no issues were found}
#'
#' @keywords internal
#'
validate_title <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# Is present
r <- validate_title_presence(fun.args)
required_issues <- c(required_issues, r)
# Is of adequate length
r <- validate_title_length(fun.args)
optional_issues <- c(optional_issues, r)
# A compiled report of issues helps the user fix them
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Dataset title (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Dataset title (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(issues)
}
#' Check for title presence
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{character}{Description of issues}
#' \item{NULL}{If no issues were found}
#'
#' @keywords internal
#'
validate_title_presence <- function(fun.args) {
if (is.null(fun.args$dataset.title)) {
return("The dataset title is missing.")
}
}
#' Check title length
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{character}{Description of issues}
#' \item{NULL}{If no issues were found}
#'
#' @keywords internal
#'
validate_title_length <- function(fun.args) {
title <- fun.args$dataset.title
if (!is.null(title)) {
if (length(stringr::str_split(title, " ")[[1]]) < 5) {
return("The dataset title should be at least 5 words.")
}
}
}
#' Validate data table description
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_table_description <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# Each table has a description, otherwise the description defaults to the
# file name
for (i in seq_along(fun.args$data.table)) {
tbl <- fun.args$data.table[i]
des <- fun.args$data.table.description[i]
if (is.na(des) || is.null(des)) {
optional_issues <- c(
optional_issues,
paste0("Missing description for ", tbl, ". Short descriptions of the ",
"file contents help future users understand the data. ",
"Defaulting to file name."))
fun.args$data.table.description[i] <- tbl
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Table descriptions (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Table descriptions (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate data table names
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_table_name <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# Each table has a name, otherwise the name defaults to the file name
for (i in seq_along(fun.args$data.table)) {
tbl <- fun.args$data.table[i]
name <- fun.args$data.table.name[i]
if (is.na(name) || is.null(name)) {
optional_issues <- c(
optional_issues,
paste0("Missing name for ", tbl, ". Short descriptive names of the ",
"files help users understand the data. Defaulting to file ",
"name."))
fun.args$data.table.name[i] <- tbl
} else if (tbl == name) {
optional_issues <- c(
optional_issues,
paste0("Missing name for ", tbl, ". Short descriptive names of the ",
"files help users understand the data. Defaulting to file ",
"name."))
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Table names (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Table names (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate data table quote characters
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_table_quote_character <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# If quote characters are used, then each table has one otherwise a
# default " is added
for (i in seq_along(fun.args$data.table)) {
tbl <- fun.args$data.table[i]
quo <- fun.args$data.table.quote.character[i]
if (!is.null(quo)) {
if (is.na(quo)) {
required_issues <- c(
required_issues,
paste0("Missing quote character for ", tbl, ". A quote character ",
"should be specified for each table. Use '' if no quote ",
"character is used. Defaulting to '\"'"))
fun.args$data.table.quote.character[i] <- '"'
}
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Table quote character (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Table quote character (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate data table url
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_table_url <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# If urls are used, then each table has one otherwise a default "" is added
for (i in seq_along(fun.args$data.table)) {
tbl <- fun.args$data.table[i]
url <- fun.args$data.table.url[i]
if (!is.null(url)) {
if (is.na(url)) {
required_issues <- c(
required_issues,
paste0("Missing URL for ", tbl, ". A URL should be specified for ",
'each table. Use "" if no URL is used. Defaulting to "".'))
fun.args$data.table.url[i] <- ""
}
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Table URL (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Table URL (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate geographic coordinate and description pair
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_geographic_coord_desc <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# geographic.description is missing
if (!is.null(fun.args$geographic.coordinates) &
is.null(fun.args$geographic.description)) {
required_issues <- c(
required_issues,
"Geographic description is missing.")
fun.args$geographic.coordinates <- NULL
}
# geographic.coordinates are missing
if (is.null(fun.args$geographic.coordinates) &
!is.null(fun.args$geographic.description)){
required_issues <- c(
required_issues,
"Geographic coordinates are missing.")
fun.args$geographic.description <- NULL
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Geographic coverage (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Geographic coverage (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate maintenance description
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_maintenance_description <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
if (is.null(fun.args$maintenance.description)) {
optional_issues <- c(
optional_issues,
paste0(
'A maintenance description is recommended. Describe the collection ',
'status of this dataset (e.g. "Ongoing collection with quarterly ',
'updates", or "Completed collection, updates to these data are not ',
'expected.")'))
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Maintenance description (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Maintenance description (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate other entity names
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_other_entity_name <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# Each table has a name, otherwise the name defaults to the file name
for (i in seq_along(fun.args$other.entity)) {
othent <- fun.args$other.entity[i]
name <- fun.args$other.entity.name[i]
if (is.na(name) || is.null(name)) {
optional_issues <- c(
optional_issues,
paste0("Missing name for ", othent, ". Short descriptive names of the ",
"files help users understand the data. Defaulting to file ",
"name."))
fun.args$other.entity.name[i] <- othent
} else if (othent == name) {
optional_issues <- c(
optional_issues,
paste0("Missing name for ", othent, ". Short descriptive names of the ",
"files help users understand the data. Defaulting to file ",
"name."))
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Other entity names (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Other entity names (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate other entity description
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_other_entity_description <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# Each table has a description, otherwise the description defaults to the
# file name
for (i in seq_along(fun.args$other.entity)) {
othent <- fun.args$other.entity[i]
othent <- fun.args$other.entity.description[i]
if (is.na(othent) || is.null(othent)) {
optional_issues <- c(
optional_issues,
paste0("Missing description for ", othent, ". Short descriptions of the ",
"file contents help future users understand the data. ",
"Defaulting to file name."))
fun.args$other.entity.description[i] <- othent
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Other entity descriptions (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Other entity descriptions (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate other entity url
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_other_entity_url <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# If urls are used, then each table has one otherwise a default "" is added
for (i in seq_along(fun.args$other.entity)) {
othent <- fun.args$other.entity[i]
url <- fun.args$other.entity.url[i]
if (!is.null(url)) {
if (is.na(url)) {
required_issues <- c(
required_issues,
paste0("Missing URL for ", othent, ". A URL should be specified for ",
'each other entity. Use "" if no URL is used. Defaulting to "".'))
fun.args$other.entity.url[i] <- ""
}
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Other entity URL (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Other entity (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
#' Validate temporal coverage
#'
#' @param fun.args
#' (named list) Function arguments and their values.
#'
#' @return
#' \item{issues}{Description of issues}
#' \item{fun.args}{Updated list of function arguments}
#'
#' @keywords internal
#'
validate_temporal_coverage <- function(fun.args) {
# Each issue is logged as "required" or "optional"
required_issues <- c()
optional_issues <- c()
# temporal.coverage is missing
if (is.null(fun.args$temporal.coverage)) {
optional_issues <- c(
optional_issues,
"Temporal coverage is missing.")
}
# temporal.coverage is incomplete
if (!is.null(fun.args$temporal.coverage)) {
if (length(fun.args$temporal.coverage) != 2){
required_issues <- c(
required_issues,
"Temporal coverage requires a begin and end date.")
fun.args$temporal.coverage <- NULL
}
}
# Compile report
if (!is.null(required_issues)) {
required_issues <- paste0(
"\n",
"Temporal coverage (Required):\n",
paste(
paste0(seq_along(required_issues), ". "),
required_issues,
collapse = "\n"),
"\n")
}
if (!is.null(optional_issues)) {
optional_issues <- paste0(
"\n",
"Temporal coverage (Optional):\n",
paste(
paste0(seq_along(optional_issues), ". "),
optional_issues,
collapse = "\n"),
"\n")
}
issues <- c(required_issues, optional_issues)
return(list(issues = issues, fun.args = fun.args))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.