#' Generates a flattened 'phenor' data file
#'
#' Uses files generated by pr_fm_*()
#' Flattening the file format allows for substantial speed increases
#' in optimization however limits readability. Using the split functionality
#' between the pr_fm_*() functions and this function allows for easier
#' subsetting of datasets.
#'
#' @param data structure list generated by pr_fm_*() functions
#' @return returns a flat file format structure of the pr_fm_*() input
#' data, this to speed up processing
#' @keywords phenology, model, preprocessing
#' @export
pr_flatten <- function(data){
if (missing(data)){
stop('please provide a structured list as generated by pr_fm_*() functions!')
}
# check if the element is flat by default
if ("transition_dates" %in% names(data)){
return(data)
}
# find the doy ranges as stored in the doy slot
# of the first site
doy <- data[[1]]$doy
# bind / calculate the photoperiod (daylength)
# for all locations with do.call()
Li <- do.call("cbind",lapply(data,function(x)x$Li))
# concat sitenames into a vector using a do.call()
site <- as.character(do.call("c",lapply(data, function(x){
if(!is.null(x)){
rep(x$site, ncol(x$Ti))
}
})))
# concat locations data into a matrix with the first row
# being the latitude and the second longitude
location <- do.call("cbind",lapply(data,function(x){
if(!is.null(x)){
matrix(rep(x$location, ncol(x$Ti)), 2, ncol(x$Ti))
}
}))
# concat all temperature data in one big matrix
Ti <- do.call("cbind",lapply(data,function(x)x$Ti))
Tmini <- do.call("cbind",lapply(data,function(x)x$Tmini))
Tmaxi <- do.call("cbind",lapply(data,function(x)x$Tmaxi))
# concat all precip data in one big matrix
Pi <- do.call("cbind",lapply(data,function(x)x$Pi))
# concat all precip data in one big matrix
VPDi <- do.call("cbind",lapply(data,function(x)x$VPDi))
# concat all SM data in one big matrix
SM <- do.call("cbind",lapply(data,function(x)x$SM))
# long term mean
ltm <- matrix(NA,365,length(site))
for (i in 1:length(site)){
ltm[,i] <- data[[which(names(data) == site[i])]]$ltm
}
# concat all transition dates for validation into
# a long vector
transition_dates <- as.vector(do.call("c",lapply(data,function(x)x$transition_dates)))
# try to return prior dates (if available, i.e. phenocam for now)
transition_dates_prior <- try(as.vector(do.call("c",lapply(data,function(x)x$transition_dates_prior))))
if(inherits(transition_dates_prior,"try-error")){
transition_dates_prior <- NULL
}
# concat all years
year <- as.vector(do.call("c",lapply(data,function(x)x$year)))
# recreate the validation data structure (new format)
# but with concatted data
flat_data <- list("site" = site,
"location" = location,
"doy" = doy,
"transition_dates" = transition_dates,
"transition_dates_prior" = transition_dates_prior,
"year" = year,
"ltm" = ltm,
"Ti" = Ti,
"Tmini" = Tmini,
"Tmaxi" = Tmaxi,
"Li" = Li,
"Pi" = Pi,
"VPDi" = VPDi,
"SM" = SM,
"georeferencing" = NULL
)
# assign a class for post-processing
class(flat_data) <- class(data)
# return the formatted, faster data format
return(flat_data)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.