#' Check Validity of Dates with Roman Numerial Month
#'
#' Check string is a valid date with Roman numerial month.
#' @param x A character string
#' @param sep Punctuation between day-month-year. Defaults to fullstop.
#' @param pad Whether days should be padded with leading 0s. Defaults to TRUE.
#' @return If the supplied string parses to Roman date, returns TRUE with the \code{"names"} attribute set to the date formatted with numerical month for later pocessing, if needed. If the the day is not correctly zero-padded, then FALSE is returned. If the date is invalid, then NA is returned.
#' @examples
#' isRomanDate("02.X.2018")
#' isRomanDate("3-V-2015", sep="-", pad=FALSE)
#' isRomanDate("21.IIII.2018") # invalid Roman number, FALSE returned
#' isRomanDate("31.II.2018") # invalid days in month, NA returned
#' @export
isRomanDate <- function(x, sep = '.', pad = TRUE)
{
	if (length(x) > 1L)
		message("argument 'x' has length > 1 and only the first element will be used")
	x <- x[[1]]
	day.pad <- sprintf("%02s", 1:9)
	month.num <- sprintf("%02s", 1:12)
	month.roman <- as.character(as.roman(month.num))
	month.pattern <- paste(month.roman, collapse = '|')
	date.pattern <- sprintf('[[:digit:]]{1,2}[%s](%s)[%s][[:digit:]]{4}', sep, month.pattern, sep)
	result <- grepl(date.pattern, x, perl=TRUE)
	if (result) {
		dmy <- unlist(strsplit(x, sep, fixed=TRUE))
		if (pad && as.numeric(dmy[1]) < 10 && !(dmy[1] %in% day.pad))
			return(FALSE)
		dmy[2] <- month.num[month.roman == dmy[2]]
		dmy <- paste(dmy[3:1], collapse='-')
		result <- as.character(as.Date(dmy, '%Y-%m-%d'))
		if (!is.na(result)) {
			n <- result
			result <- TRUE
			names(result) <- n
		}
	}
	return(result)
}
#' Check Vector of Possible Roman Dates
#'
#' Strings to be checked supplied as a character vector, or frequency vector with the \code{"names"} attribute.
#' @param x A character vertor, or numerical vector with character strings supplied in the \code{"names"} attribute.
#' @param sorted Whether to sort the returned list. Defaults to TRUE.
#' @param sep Punctuation between day-month-year. Defaults to fullstop.
#' @param pad Whether days should be padded with leading 0s. Defaults to TRUE.
#' @return The function returns the same vector type as supplied. If a named frequency vector is supplied, the numerical frequencies are not altered. The character vector returned, either directly or as a \code{"names"} attribute, contains the the original strings appened with either "(?)" or "(??)". The former indicates the date is correct but the zero-padding of the day does not conform. The latter indicates the date is not valid (e.g., 31 days in a month with only 30 days).
#'
#' If sorted = TRUE, then dates sorted in ascending chronological order included dates that are valid but not zero-padded as requested. Invalid dates are placed at then end of the list.
#' @examples
#' rD.test <- 1:3
#' names(rD.test) <- c('03.VX.2018', '05.VII.2018', '9.VIII.2018')
#' romanDates(rD.test)
#' @export
romanDates <- function(x, sorted = TRUE, sep = '.', pad = TRUE) {
	r <- list()
	if (length(x) == 0)
		return(list(x))
	r$names <- x
	if (is.numeric(x)) {
		r$count <- x
		r$names <- names(x)
	}
	r$date <- numeric()
	r$pad <- logical()
	r$order <- numeric()
	for (i in r$names) {
		r$date <- append(r$date, NA)
		r$pad <- append(r$pad, FALSE)
		ln = length(r$date)
		valid <- isRomanDate(i, sep = sep, pad = pad)
		if (is.na(valid))
			next()
		if (valid) {
			r$date[ln] <- names(valid)
			r$pad[ln] <- TRUE
			next()
		}
		valid <- isRomanDate(i, sep = sep, pad = !pad)	
		if (valid)
			r$date[ln] <- names(valid)
	}
	r$order <- order(r$date)
	r$names[!(is.na(r$date) | r$pad)] <- sprintf('%s (?)', r$names[!(is.na(r$date) | r$pad)])
	r$names[is.na(r$date)] <- sprintf('%s (??)', r$names[is.na(r$date)])
	if (is.numeric(x)) {
		result <- r$count
		names(result) <- r$names
	} else result <- r$names
	if (sorted)
		result <- result[r$order]
	return(result)
}
