##' Create the correct data format for variable selection
##'
##' Check the climate data that is either supplied as a matrix, a
##' data.frame, or a list of data.frames. Reformat the data for
##' further usage into the internal format.
##' @param x the supplied climate data
##' @param varnames optionally supplied variable names
##' @return a data.frame with years in rows and monthly observations
##' in columns
##' @keywords manip internal
as_tcclimate <- function(x, varnames = NULL) {
msg1 <- "Format of climate data was not recognized. It is absolutely necessary that only complete years (months 1-12) are provided."
msg2 <- "Format of climate data was not recognized. It is absolutely necessary that only complete years (months 1-12) are provided, and months are ordered sequentially (from 1 to 12)."
## is it a list?
if (any(class(x) == "list")) {
## handle list case
n <- length(x)
minyrs <- maxyrs <- numeric(n)
## loop through list members, and get min and max years for later
## reformatting.
for (i in 1:n) {
## shortcut for current list member
y <- x[[i]]
## explanation see non-list case
if (dim(y)[2] == 13) {
perf_seq <- seq(y[1,1], y[dim(y)[1],1], 1)
if (length(y[,1]) != length(perf_seq)) {
stop(msg1)
}
if (!any(y[,1] == perf_seq)) {
stop(msg1)
} else {
minyrs[i] <- min(y[,1])
maxyrs[i] <- max(y[,1])
}
}
}
yrs <- max(minyrs):min(maxyrs)
nyrs <- length(yrs)
output_matrix <- matrix(NA, ncol = n + 2, nrow = nyrs*12)
output_matrix[,1] <- rep(yrs, each = 12)
output_matrix[,2] <- rep(1:12, nyrs)
## loop through list again, and put everything in place in the new output
## matrix
for (i in 1:n) {
y <- x[[i]]
for (j in 1:nyrs) {
if (any(y[,1] == yrs[j])) {
## write elements of specific line into i+2 th row of output_matrix
output_matrix[which(output_matrix[,1] == yrs[j]), 2+i] <-
unlist(y[which(y[,1] == yrs[j]), 2:13])
}
}
}
## handle non-list case
} else {
## should have 12 months columns and one year column
if (dim(x)[2] == 13) {
## check if the first column is perfect sequence of integer years. if
## expression evaluates to FALSE, then this is the case, if
## TRUE: stop.
perf_seq <- seq(x[1,1], x[dim(x)[1],1], 1)
if (length(x[,1]) != length(perf_seq)) {
stop(msg1)
}
if (!any(x[,1] == perf_seq)) {
stop(msg1)
} else {
## this is most probably a dendroclim-formatted set of climate data
yrs <- unique(x[,1])
nyrs <- length(yrs)
output_matrix <- matrix(NA, ncol = 3, nrow = nyrs*12)
output_matrix[,1] <- rep(yrs, each = 12)
output_matrix[,2] <- rep(1:12, nyrs)
for (i in 1:nyrs) {
## loop through years and write respective rows in respective columns
## in output_matrix
output_matrix[which(output_matrix[,1] == yrs[i]), 3] <-
unlist(x[which(x[,1] == yrs[i]), 2:13])
}
}
## could still be the originally intended format of data.
} else {
## check if the first column is a perfect sequence of integer years, each
## repeated 12 times. if expression evaluates to FALSE, then this is the
## case, else stop.
perf_seq <- rep(x[1,1]:x[dim(x)[1],1], each = 12)
if (length(x[,1]) != length(perf_seq)) {
stop(msg1)
}
if (!any(x[,1] == perf_seq)) {
stop(msg1)
} else {
## make sure, months and years are ordered perfectly (but still check
## sequence afterwards in case of missing individual months)
x <- x[order(x[,1], x[,2], decreasing = FALSE), ]
if (!(all(x[,2] == rep(1:12, length(unique(x[,1])))))) {
## check if the second column is a perfect sequence of 1:12 as often as
## there are individual years in column 1. if expression evaluates to
## FALSE, then this is the case, else stop.
stop(msg2)
} else {
## pass data on directly
output_matrix <- x
}
}
}
}
output <- data.frame(output_matrix)
## do we have names?
if (!is.null(varnames)) {
if (length(varnames) == dim(output[2])) {
colnames(output)[-c(1,2)] <- varnames
} else {
stop("`var_names` has to be of the same length as the number of parameters.")
}
}
if (is.null(varnames) & !is.null(names(x)) & (class(x) == "list")) {
colnames(output)[-c(1,2)] <- names(x)
}
class(output) <- c("tc_climate", "data.frame")
output
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.