Support Single Monthly Values in Scalar and Generic Classes

NAMESPACE

@@ -38,6 +38,10 @@ export(climdexGenericVector.csv)
 export(climdexGenericVector.raw)
 export(climdexInput.csv)
 export(climdexInput.raw)
+export(climdexSingleMonthlyScalar.csv)
+export(climdexSingleMonthlyScalar.raw)
+export(climdexSingleMonthlyVector.csv)
+export(climdexSingleMonthlyVector.raw)
 export(compute.gen.stat)
 export(compute.stat.scalar)
 export(compute.stat.vector)
@@ -69,6 +73,7 @@ import(methods)
 importFrom(circular,circular)
 importFrom(circular,mean.circular)
 importFrom(circular,sd.circular)
+importFrom(stats,na.omit)
 importFrom(stats,quantile)
 importFrom(utils,head)
 importFrom(utils,read.csv)

R/GenericVariable_utils.R

@@ -1,32 +1,74 @@
 # Utility function to validate arguments for scalar and vector data.
-check.generic.argument.validity <- function( data, dates, max.missing.days, calendar) {
+check.generic.argument.validity <- function(
+    data, 
+    dates, 
+    max.missing.days, 
+    calendar,
+    is.vector = FALSE,
+    secondary = NULL,
+    format = NULL
+) {
+  # Internal function to validate data and date arguments
+  validate_data_dates <- function(data, dates, name) {
+    if (missing(data) || is.null(data)) {
+      stop(paste(name, "argument is missing."))
+    }
+    if (missing(dates)) {
+      stop("Argument 'dates' is missing.")
+    }
+    if (length(data) == 0 || length(dates) == 0) {
+      stop(paste(name, "and dates must not be empty vectors."))
+    }
+    if (!is.numeric(data[!is.na(data)]) && (name != "Secondary data")) {
+      stop(paste(name, "must be numeric."))
+    }
+    if (length(data) != length(dates)) {
+      stop(paste(name, "and dates must have the same length."))
+    }
+    if (any(is.na(dates))) {
+      stop(paste("Argument 'dates' has NA values."))
+    }
+  }
 
+  # Check max.missing.days
   if (length(max.missing.days) != 3 || !all(c("annual", "monthly", "seasonal") %in% names(max.missing.days))) {
     stop("max.missing.days must be a named vector with 'annual', 'monthly', and 'seasonal' elements.")
   }
 
+  # Validate primary data and dates
+  validate_data_dates(data, dates, "Primary data")
 
-  # Check that required arguments are provided
-  if (missing(data)) {
-    stop("Primary data argument is missing.")
-  }
-
-  if (missing(dates)) {
-    stop("Argument 'dates' is missing.")
+  # Check if dates are PCICt
+  if (!inherits(dates, "PCICt")) {
+    stop("Dates must be of class PCICt.")
   }
 
-
-  if (!is.numeric(data)) {
-    stop("Primary Data must be numeric.")
-  }
-
-  if (length(data) != length(dates)) {
-    stop("Primary data and dates must have the same length.")
+  # Vector-specific checks
+  if (is.vector) {
+
+    validate_data_dates(secondary, dates, "Secondary data")
+    # Check that 'format' is provided
+    if (missing(format) || is.null(format)) {
+      stop("Argument 'format' is missing.")
+    }
+
+    # Convert the format to lowercase to allow case-insensitive input
+    format <- tolower(format)
+
+    # Additional validation for format
+    if (format %in% c("polar", "cartesian")) {
+      if (!is.numeric(secondary)) {
+        stop("For 'polar' or 'cartesian' formats, 'secondary' must be numeric.")
+      }
+    } else if (format == "cardinal") {
+      if (!is.character(secondary)) {
+        stop("For 'cardinal' format, 'secondary' must be character.")
+      }
+    } else {
+      stop("Invalid 'format'. Use 'polar', 'cartesian', or 'cardinal'.")
+    }
   }
 
-  if(!is.null(dates) && !inherits(dates, "PCICt"))
-      stop(paste("Dates must be of class PCICt."))
-
   # Calendar check: verify it matches one of the recognized types
   valid_calendars <- c("360_day", "360", "365_day", "365", "noleap", "gregorian", "proleptic_gregorian")
   if (!calendar %in% valid_calendars) {
@@ -35,6 +77,25 @@ check.generic.argument.validity <- function( data, dates, max.missing.days, cale
   }
 }
 
+# For single-value-per-month data. Check one day per month and that the day is always the first.
+check.single.month.dates <- function(dates) {
+  valid_dates <- dates[!is.na(dates)]
+  # Check if there is exactly one value per month on the 1st day
+  unique_months <- unique(format(valid_dates, "%Y-%m"))
+  day_of_month <- as.integer(format(valid_dates, "%d"))
+
+  # Check that the length of unique months matches the number of dates, ensuring only one value per month
+  if (length(unique_months) != length(valid_dates)) {
+    stop("Data must have exactly one value per month.")
+  }
+
+  # Check that all dates correspond to the 1st day of each month
+  if (!all(day_of_month == 1)) {
+    stop("Data must be on the 1st day of each month.")
+  }
+}
+
+
 # Utility function to handle date ranges and generate date factors.
 date_info <- function(dates) {
   cal <- attr(dates, "cal")

R/climdexGenericScalar.R

@@ -47,16 +47,16 @@ climdexGenericScalar.raw <- function(
   filled.list <- generate_filled_list(data, dates, date.series)
   names(filled.list) <- "data"
   namasks <- generate_namasks(filled.list, date.factors, max.missing.days)
-  obj <- new("climdexGenericScalar",
+
+  return(new("climdexGenericScalar",
     data = filled.list[["data"]],
     dates = date.series,
     date.factors = date.factors,
     jdays = jdays,
     namasks = namasks,
     northern.hemisphere = northern.hemisphere,
-    max.missing.days = max.missing.days)
-
-  return(obj)
+    max.missing.days = max.missing.days
+  ))
 }
 
 #' @title climdexGenericScalar.csv
@@ -117,13 +117,107 @@ climdexGenericScalar.csv <- function(
 ) {
 
   GS.csv <- read_csv_data(file, data.column, date.columns, date.format,  na.strings, calendar)
-  obj <- climdexGenericScalar.raw(
-    data = GS.csv$data[[1]],
-    dates = GS.csv$dates,
-    northern.hemisphere = northern.hemisphere,
-    max.missing.days = max.missing.days,
-    calendar = calendar
-  )
 
-  return(obj)
+  return(climdexGenericScalar.raw(
+  data = GS.csv$data[[1]],
+  dates = GS.csv$dates,
+  northern.hemisphere = northern.hemisphere,
+  max.missing.days = max.missing.days,
+  calendar = calendar
+))
+}
+#' @title climdexSingleMonthlyScalar.raw
+#'
+#' @description
+#' Creates a `ClimdexGenericScalar` object from raw scalar climate data with a single value per month constraint.
+#'
+#' @details
+#' This function is a wrapper for creating `ClimdexGenericScalar` objects where temporal resolution is a single value per month.
+#' It automatically sets the `max.missing.days` to `+Inf`. To ensure consistency, each data point must correspond
+#' to the 1st day of each month. The function will raise an error if there is more than one value per month or if any date is not on the 1st.
+#'
+#' @param data A numeric vector containing the scalar climate data.
+#' @param dates A `PCICt` vector corresponding to the data dates. Each date must correspond to the 1st day of each month.
+#' @param northern.hemisphere Logical. Indicates whether this point is in the northern hemisphere.
+#' @param calendar A string representing the calendar type, e.g., "gregorian".
+#' @return A `ClimdexGenericScalar` object containing the processed data.
+#'
+#' @seealso [climdexGenericScalar.raw()], [climdexSingleMonthlyScalar.csv()]
+#'
+#' @examples
+#' \dontrun{
+#' data <- runif(12, 0, 20)
+#' dates <- as.PCICt(seq(as.Date("2020-01-01"), by = "month", length.out = 12), cal = "gregorian")
+#' scalar_obj <- climdexSingleMonthlyScalar.raw(data, dates)
+#' }
+#'
+#' @export
+
+climdexSingleMonthlyScalar.raw <- function(
+    data,
+    dates,
+    northern.hemisphere = TRUE,
+    calendar = "gregorian") {
+  max.missing.days <- c(annual = +Inf, monthly = +Inf, seasonal = +Inf)
+
+  check.single.month.dates(dates)
+
+  return(climdexGenericScalar.raw(
+  data = data,
+  dates = dates,
+  max.missing.days = max.missing.days,
+  northern.hemisphere = northern.hemisphere,
+  calendar = calendar
+))
+}
+
+#' @title climdexSingleMonthlyScalar.csv
+#'
+#' @description
+#' Reads scalar climate data with a single value per month constraint from a CSV file and creates a `ClimdexGenericScalar` object.
+#'
+#' @details
+#' This function reads scalar climate data and validates that there is a single value per month. It automatically sets the `max.missing.days`
+#' to `+Inf` and builds a `ClimdexGenericScalar` object. Each date must correspond to the 1st day of each month.
+#'
+#' @param file The file path to the CSV containing the scalar climate data.
+#' @param data.column The name of the column containing the scalar data in the CSV file.
+#' @param date.columns A vector of column names corresponding to the date fields in the CSV file.
+#' @param date.format A string representing the format of the date fields.
+#' @param na.strings A character vector of strings to interpret as `NA`.
+#' @param northern.hemisphere Logical. Indicates whether this point is in the northern hemisphere.
+#' @param calendar A string representing the calendar type (e.g., "gregorian").
+#'
+#' @return A `ClimdexGenericScalar` object containing the processed scalar climate data.
+#'
+#' @seealso [climdexSingleMonthlyScalar.raw()]
+#'
+#' @examples
+#' \dontrun{
+#' csv_file <- "path/to/scalar_data.csv"
+#' scalar_obj <- climdexSingleMonthlyScalar.csv(
+#'   file = csv_file, data.column = "data",
+#'   date.columns = "date", date.format = "%Y-%m-%d"
+#' )
+#' }
+#'
+#' @export
+
+climdexSingleMonthlyScalar.csv <- function(
+    file,
+    data.column,
+    date.columns,
+    date.format,
+    na.strings = NULL,
+    northern.hemisphere = TRUE,
+    calendar = "gregorian") {
+  GS.csv <- read_csv_data(file, data.columns = data.column, date.columns, date.format, na.strings, calendar)
+
+
+  return(climdexSingleMonthlyScalar.raw(
+  data = GS.csv$data[[1]],
+  dates = GS.csv$dates,
+  northern.hemisphere = northern.hemisphere,
+  calendar = calendar
+))
 }