Skip to content

Commit

Permalink
Run styler
Browse files Browse the repository at this point in the history
  • Loading branch information
@QSparks
QSparks committed Nov 8, 2024
1 parent 483cfa1 commit 2f55281
Show file tree
Hide file tree
Showing 29 changed files with 1,718 additions and 1,441 deletions.
85 changes: 42 additions & 43 deletions R/GenericVariable_utils.R
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,12 @@
# Utility function to validate arguments for scalar and vector data.
check.generic.argument.validity <- function(
data,
dates,
max.missing.days,
data,
dates,
max.missing.days,
calendar,
is.vector = FALSE,
secondary = NULL,
format = NULL
) {
format = NULL) {
# Internal function to validate data and date arguments
validate_data_dates <- function(data, dates, name) {
if (missing(data) || is.null(data)) {
Expand All @@ -29,32 +28,31 @@ check.generic.argument.validity <- function(
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 if dates are PCICt
if (!inherits(dates, "PCICt")) {
stop("Dates must be of class PCICt.")
}

# 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)) {
Expand All @@ -68,12 +66,14 @@ check.generic.argument.validity <- function(
stop("Invalid 'format'. Use 'polar', 'cartesian', or 'cardinal'.")
}
}

# 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) {
stop(paste("Invalid calendar type:", calendar,
". Accepted types are '360_day', '360', '365_day', '365', 'noleap', 'gregorian', 'proleptic_gregorian'."))
stop(paste(
"Invalid calendar type:", calendar,
". Accepted types are '360_day', '360', '365_day', '365', 'noleap', 'gregorian', 'proleptic_gregorian'."
))
}
}

Expand All @@ -83,12 +83,12 @@ check.single.month.dates <- function(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.")
Expand All @@ -99,22 +99,22 @@ check.single.month.dates <- function(dates) {
# Utility function to handle date ranges and generate date factors.
date_info <- function(dates) {
cal <- attr(dates, "cal")

last.day.of.year <- get.last.monthday.of.year(dates)

date.range <- as.PCICt(paste(as.numeric(format(range(dates), "%Y", tz = "GMT")), c("01-01", last.day.of.year), sep = "-"), cal = cal)
date.series <- seq(date.range[1], date.range[2], by = "day")

jdays <- get.jdays.replaced.feb29(get.jdays(date.series))

season_with_year <- classify_meteorological_season_with_year(date.series)

date.factors <- list(
annual = factor(format(date.series, format = "%Y", tz = "GMT")),
monthly = factor(format(date.series, format = "%Y-%m", tz = "GMT")),
seasonal = factor(season_with_year, levels = unique(season_with_year))
)

return(list(
cal = cal,
date.series = date.series,
Expand All @@ -128,17 +128,18 @@ generate_namasks <- function(filled.list, date.factors, max.missing.days) {
namasks <- list(
annual = lapply(filled.list, get.na.mask, date.factors$annual, max.missing.days["annual"]),
monthly = lapply(filled.list, get.na.mask, date.factors$monthly, max.missing.days["monthly"]),
seasonal = lapply(filled.list, get.na.mask, date.factors$seasonal, max.missing.days["seasonal"]))
# Vectors: Combine the masks for magnitude and direction
seasonal = lapply(filled.list, get.na.mask, date.factors$seasonal, max.missing.days["seasonal"])
)
# Vectors: Combine the masks for magnitude and direction
if ("primary" %in% names(filled.list) && "secondary" %in% names(filled.list)) {
# Synchronize annual masks
namasks$annual$primary <- namasks$annual$primary * namasks$annual$secondary
namasks$annual$secondary <- namasks$annual$primary

# Synchronize monthly masks
namasks$monthly$primary <- namasks$monthly$primary * namasks$monthly$secondary
namasks$monthly$secondary <- namasks$monthly$primary

# Synchronize seasonal masks
namasks$seasonal$primary <- namasks$seasonal$primary * namasks$seasonal$secondary
namasks$seasonal$secondary <- namasks$seasonal$primary
Expand All @@ -149,8 +150,8 @@ generate_namasks <- function(filled.list, date.factors, max.missing.days) {
d
})
names(namasks$annual) <- names(namasks$seasonal) <- names(namasks$monthly)


season_month_counts <- sapply(unique(date.factors$seasonal), function(season) {
length(unique(date.factors$monthly[date.factors$seasonal == season]))
})
Expand All @@ -162,22 +163,22 @@ generate_namasks <- function(filled.list, date.factors, max.missing.days) {
seasons_of_na_months <- unique(date.factors$seasonal[date.factors$monthly %in% na_months])
seasonal_namasks[unique(date.factors$seasonal) %in% seasons_of_na_months] <- NA
# Identify and set NA for seasons with less than 3 months
for (season in seq_along(season_month_counts) ) {
for (season in seq_along(season_month_counts)) {
if (!is.na(season_month_counts[season]) && season_month_counts[season] < 3) {
seasonal_namasks[season] <- NA
}
}
namasks$seasonal[[var]] <- seasonal_namasks
}
}
return(namasks)
}

generate_filled_list <- function(data, dates, date.series) {
if (is.vector(data)) {
return(list(create.filled.series(data, trunc(dates), date.series)))
} else {
filled.list <- sapply(data, function(x) {
return(create.filled.series(x, trunc(dates), date.series))
filled.list <- sapply(data, function(x) {
return(create.filled.series(x, trunc(dates), date.series))
}, simplify = FALSE)
return(filled.list)
}
Expand All @@ -191,39 +192,37 @@ read_csv_data <- function(
date.columns,
date.format,
na.strings,
calendar
) {

calendar) {
calling_func <- as.character(sys.call(-1)[[1]])

# Ensure that the number of data columns matches the type of the calling function
if (grepl("Scalar", calling_func, ignore.case = TRUE) && length(data.columns) != 1) {
stop("For scalar data, 'data.columns' should contain exactly 1 column.")
} else if (grepl("Vector", calling_func, ignore.case = TRUE) && length(data.columns) != 2) {
stop("For vector data, 'data.columns' should contain exactly 2 columns.")
}

# Read the CSV file
GV.csv <- read.csv(file, na.strings = na.strings)

# Check that data columns exist
for (col in data.columns) {
if (!(col %in% names(GV.csv))) {
stop(paste("Data column", col, "not found in data."))
}
}

# Check that date columns exist
if (!all(date.columns %in% names(GV.csv))) {
stop(paste("Date columns", paste(date.columns, collapse = ", "), "not found in data."))
}

# Extract data cols
data_values <- lapply(data.columns, function(col) GV.csv[[col]])

# Extract the date fields and create date strings
date_strings <- apply(GV.csv[date.columns], 1, function(row) paste(row, collapse = " "))

# Convert date strings to PCICt dates
dates <- as.PCICt(strptime(date_strings, format = date.format, tz = "UTC"), cal = calendar)

Expand Down
22 changes: 11 additions & 11 deletions R/climdex.pcic-package.R
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
#' climdex.pcic, an implementation of the ETCCDI climate change indices.
#'
#'
#' This package implements the ETCCDI's 27 core climate change indices
#' efficiently in R.
#'
#'
#' The calculation of climate extremes are important in many disciplines.
#' Annual maximum daily precipitation, annual maximum wind speed, and other
#' such extremes are used in many engineering applications. However, they are
#' not as useful when speaking about climate change.
#'
#'
#' The Expert Team on Climate Change Detection and Indicies (ETCCDI) has
#' created a set of 27 core indices with the intent of capturing the change in
#' the extremes of climate and in selected parameters deemed relevant to other
Expand All @@ -18,29 +18,29 @@
#' and dry spells. \item Counts of days where precipitation exceeds a
#' threshold. \item Total precipitation where precipitation exceeds the 95th
#' or 99th percentile of the baseline. }
#'
#'
#' The \code{climdex.pcic} package provides an implementation of the ETCCDI's
#' 27 core climate change indices. It aims to be reasonably high performance,
#' to handle non-Gregorian calendar types, to be as correct as possible given
#' the definitions of the indices, and to have sufficiently readable and
#' concise code as to facilitate easy verification by inspection.
#'
#'
#' @name climdex.pcic
#' @aliases climdex.pcic-package
#' @keywords internal
"_PACKAGE"
#' @seealso \code{\link{climdexInput.raw}}, \code{\link{climdexInput.csv}},
#' \code{\link{climdexInput-class}}.
#' @references \url{http://etccdi.pacificclimate.org/list_27_indices.shtml}
#'
#'
#' Karl, T.R., N. Nicholls, and A. Ghazi, 1999: CLIVAR/GCOS/WMO workshop on
#' indices and indicators for climate extremes: Workshop summary. Climatic
#' Change, 42, 3-7.
#'
#'
#' Peterson, T.C., and Coauthors: Report on the Activities of the Working Group
#' on Climate Change Detection and Related Rapporteurs 1998-2001. WMO, Rep.
#' WCDMP-47, WMO-TD 1071, Geneve, Switzerland, 143pp.
#'
#'
#' Zhang, X., 2005: Avoiding inhomogeneity in percentile-based indices of
#' temperature extremes. Journal of Climate 18.11 (2005):1641-.
#' @keywords climate ts
Expand All @@ -49,16 +49,16 @@
NULL

#' EC example data
#'
#'
#' This is the Environment Canada CDCD (Canadian Daily Climate Data)
#' precipitation, maximum temperature, and minimum temperature data for station
#' 1018935 - William Head, BC, Canada.
#'
#'
#' This is the Environment Canada CDCD (Canadian Daily Climate Data)
#' precipitation, daily maximum temperature, and daily minimum temperature data
#' for station 1018935 - William Head, BC, Canada. This is provided as example
#' data for running the Climdex package.
#'
#'
#' @name ec.1018935
#' @aliases ec.1018935.prec ec.1018935.tmin ec.1018935.tmax
#' @docType data
Expand Down
Loading

0 comments on commit 2f55281

Please sign in to comment.