#' Verifying validity of financial years
#'
#' @description Many functions expect financial years.
#' Determining that they are validly entered is often quite
#' computationally costly, relative to the core calculations.
#' These internal functions provide mechanisms to check validity
#' quickly, while still providing clear, accurate error messages.
#'
#' @aliases valid-fys
#'
#' @param to_verify A user-provided value, purporting to be
#' character vector of financial years.
#' @param permitted_fys A character vector of valid financial years.
#' @param min.yr,max.yr Integers specifying the range of \code{to_verify}.
#' If \code{NULL}, no restriction on the upper or lower bound of the range.
#'
#' @param deparsed A string indicating the argument that the user provided.
#' Should generally be provided explicitly as the default is unlikely
#' to be user-friendly.
#' @param allow.projection If \code{FALSE} emit a different error message.
#' @param earliest_permitted_financial_year,latest_permitted_financial_year Text
#' for earliest/latest permitted financial year when \code{min.yr}/\code{max.yr}
#' condition is violated.
#'
#' @param .retain_fmatches If \code{TRUE}, the function may retain an attribute
#' \code{fy_fmatches} an integer vector of the matches against the financial years
#' \code{"1900-01"} to \code{"2099-00"}. A trade-off between memory and runtime from
#' not recalculating matches.
#'
#' @details The preferred form is \code{"2012-13"}, and this function
#' returns all elements of \code{to_verify} in this form. That is, it does
#' not preserve the input form.
#'
#' Other forms that are recognized (and converted) are:
#' \itemize{
#' \item{"201213"}
#' \item{"2012 13"}
#' \item{"2012\code{\\u2011}13"}
#' \item{"2012\code{\\u2012}13"}
#' \item{"2012\code{\\u2013}13"}
#' \item{"2012\code{\\u2014}13"}
#' \item{"2012-2013"}
#' }
#'
#'
#'
#'
#' @return If \code{to_verify} contains valid financial years
#' they are returned all in the form \code{2013-14}. If they were
#' already in that form, they obtain the following attributes:
#' \describe{
#' \item{\code{fy_all_fy}}{\code{TRUE} if all the financial years are valid.}
#' \item{\code{fy_min_yr}}{An integer, the earliest year ending in \code{to_verify}.}
#' \item{\code{fy_max_yr}}{An integer, the latest year ending in \code{to_verify}.}
#' \item{\code{fy_fmatches}}{An integer vector, the matches with the prebuilt financial years.}
#' }
#'
#' @section Benchmarks:
#'
#' \preformatted{
#' x <- rep_len(yr2fy(2004L), 1e9)
#' bench::system_time(validate_fys_permitted(x))
#' #> process real
#' #> 3.578s 3.576s
#' x <- rep_len(yr2fy(1980:2016), 1e9)
#'
#' bench::system_time(validate_fys_permitted(x))
#' #> process real
#' #> 3.766s 3.753s
#' }
#'
#'
#' @export validate_fys_permitted
validate_fys_permitted <- function(to_verify,
permitted_fys = NULL,
min.yr = NULL, max.yr = NULL,
deparsed = deparse(substitute(to_verify)),
allow.projection = TRUE,
earliest_permitted_financial_year = "earliest permitted financial year",
latest_permitted_financial_year = "latest permitted financial year",
.retain_fmatches = FALSE) {
if (!is.character(to_verify)) {
stopn("`", deparsed, "` was type ", typeof(to_verify), ", ",
"but must be type character. ",
"Ensure `", deparsed, "` is a character vector of financial years",
if (!is.null(min.yr) || !is.null(max.yr)) " satisfying ",
if (!is.null(min.yr)) paste0("`", yr2fy(min.yr), " <= "),
if (!is.null(min.yr) || !is.null(max.yr)) deparsed,
if (!is.null(max.yr)) paste0(" <= ", yr2fy(max.yr), "`"),
".")
}
if (isTRUE(attr(to_verify, "fy_all_fy"))) {
# If min.yr and max.yr are fine, we're done
if (is.null(min.yr) && is.null(max.yr)) {
return(to_verify)
}
# Otherwise we just have to check the ranges: either the ranges
# are no good (in which case error), or return to_verify
# min
if (!is.null(min.yr)) {
# Unlikely (misspecified), but should assert
if (is.null(attr(to_verify, "fy_min_yr"))) {
min_to_verify_yr <- min_fy2yr(to_verify)
attr(to_verify, "fy_min_yr") <- min_to_verify_yr
}
if (min.yr > attr(to_verify, "fy_min_yr")) {
min.k <- min.yr - 1900L
stopn("`", deparsed,
if (length(to_verify) == 1L) " = " else "` contained ",
'"', fys1901[attr(to_verify, "fy_min_yr") - 1900L], '"',
if (length(to_verify) == 1L) "`",
" which ",
"is earlier than the ",
earliest_permitted_financial_year,
": ", '"', fys1901[min.k], '"', ".")
}
}
# max
if (!is.null(max.yr)) {
# Unlikely (misspecified), but should assert
if (is.null(attr(to_verify, "fy_max_yr"))) {
max_to_verify_yr <- max_fy2yr(to_verify)
attr(to_verify, "fy_max_yr") <- max_to_verify_yr
}
if (max.yr < attr(to_verify, "fy_max_yr")) {
max.k <- max.yr - 1900L
deparsed <- force(deparsed)
stopn(if (isFALSE(allow.projection)) "`allow.projection = FALSE`, yet ",
"`", deparsed,
if (length(to_verify) == 1L) " = " else "` contained ",
'"', fys1901[attr(to_verify, "fy_max_yr") - 1900L], '"',
if (length(to_verify) == 1L) "`",
" which ",
"is later than the ",
latest_permitted_financial_year,
": ", '"', fys1901[max.k], '"', ".")
}
}
return(to_verify)
}
if (is.null(permitted_fys)) {
# Use the anyNA virtue of hutils::coalesce
if (anyNA3i(fmatches <- fmatch(to_verify, fys1901))) {
# Not standard financial year like '2014-15'.
# Is it just a nonstandard but valid financial year
# or is it not a financial year at all?
fmatches <- coalesce3i(fmatches,
fmatch(to_verify, fys1901B),
fmatch(to_verify, fys1901C),
fmatch(to_verify, fys1901_2011),
fmatch(to_verify, fys1901_2012),
fmatch(to_verify, fys1901_2013),
fmatch(to_verify, fys1901_2014),
fmatch(to_verify, fys1901_9),
fmatch(to_verify, fys1901B_9),
fmatch(to_verify, fys1901C_9),
fmatch(to_verify, fys1901_2011_9),
fmatch(to_verify, fys1901_2012_9),
fmatch(to_verify, fys1901_2013_9),
fmatch(to_verify, fys1901_2014_9))
if (anyNA3i(fmatches)) {
first_bad <- which.max(is.na(fmatches))
stopn("`", deparsed,
if (length(to_verify) == 1L) " = " else "` contained ",
'"', to_verify[first_bad], '"',
if (length(to_verify) == 1L) "` was " else " which is ",
"not a valid financial year.")
}
# Standardize
to_verify <- fys1901[fmatches]
}
class(to_verify) <- "fy"
attr(to_verify, "fy_all_fy") <- TRUE
if (!is.null(min.yr)) {
min.k <- min.yr - 1900L
min_fmatches <- min(fmatches)
if (min_fmatches < min.k) {
first_bad <- which.min(fmatches)
stopn("`", deparsed,
if (length(to_verify) == 1L) " = " else "` contained ",
'"', to_verify[first_bad], '"',
if (length(to_verify) == 1L) "`",
" which ",
"is earlier than the ",
earliest_permitted_financial_year,
": ", '"', fys1901[min.k], '"', ".")
}
attr(to_verify, "fy_min_yr") <- min_fmatches + 1900L
}
if (!is.null(max.yr)) {
max.k <- max.yr - 1900L
max_fmatches <- max(fmatches)
if (max_fmatches > max.k) {
first_bad <- which.max(fmatches)
stopn(if (isFALSE(allow.projection)) "`allow.projection = FALSE`, yet ",
"`", deparsed,
if (length(to_verify) == 1L) " = " else "` contained ",
'"', to_verify[first_bad], '"',
if (length(to_verify) == 1L) "`",
" which ",
"is later than the ",
latest_permitted_financial_year,
": ", '"', fys1901[max.k], '"', ".")
}
attr(to_verify, "fy_max_yr") <- max_fmatches + 1900L
}
if (isTRUE(.retain_fmatches)) {
attr(to_verify, "fy_fmatches") <- fmatches
}
return(invisible(to_verify))
} else {
permitted_fys <- validate_fys_permitted(permitted_fys)
}
fy.year <- to_verify
if (!all(fy.year %chin% permitted_fys)) {
if (any(!is_fy(fy.year))) {
i <- which(!is_fy(fy.year))
i1 <- i[1]
if (length(i) > 1) {
stopn("`", deparsed, "` contained invalid FYs. ",
"There were ",
length(i), " invalid entries (",
round(100 * length(i) / length(fy.year)), "%).",
"\n\n",
"First invalid FY:\n\t", fy.year[i1], "\n",
"at position ", i)
} else {
if (length(fy.year) == 1L) {
stopn("`", deparsed, "` set to '", fy.year, "', was not a valid financial year. ",
"Select a valid fy.year between ",
permitted_fys[1], " and ", last(permitted_fys), ".")
} else {
stopn("`", deparsed, "` contained invalid entry ",
fy.year[i1], " at position ", i1, ".")
}
}
} else {
# all are valid
if (min.fy(fy.year) < min.fy(permitted_fys) ||
max.fy(fy.year) > max.fy(permitted_fys)) {
i <- which(fy.year %notin% permitted_fys)
i1 <- i[1]
if (length(i) == 1L) {
stopn("`", deparsed, " = ", fy.year[i1], "` was not within the allowed range: ",
permitted_fys[1], " <= fy.year <= ", last(permitted_fys))
} else {
stopn("`", deparsed, "` were not within the allowed range: ",
permitted_fys[1], " <= fy.year <= ", last(permitted_fys), "\n\n",
"First invalid FY:\n\t", fy.year[i1], "\n",
"at position ", i1)
}
}
}
}
class(to_verify) <- "fy"
return(to_verify)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.