diff --git a/DESCRIPTION b/DESCRIPTION index 559eeb0..90c3d9b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,9 +25,12 @@ Depends: Imports: terra, magrittr, + methods, + grDevices, dplyr, tidyr, fs, + sf, cowplot, ncmeta, here, diff --git a/NAMESPACE b/NAMESPACE index 5a80896..8db70b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,4 +17,9 @@ export(plot_map4) export(prepare_setup_sofun) export(read_nc_onefile) export(write_nc2) +import(dplyr) +import(ggplot2) +importFrom(grDevices,colorRampPalette) importFrom(magrittr,"%>%") +importFrom(methods,as) +importFrom(stats,setNames) diff --git a/R/align_events.R b/R/align_events.R index d75445d..8ffc713 100644 --- a/R/align_events.R +++ b/R/align_events.R @@ -12,14 +12,17 @@ #' @param after An integer specifying the number of days after the event onset to be retained in re-arranged data #' @param do_norm A logical specifying whether re-arranged data is to be normalised by the median value of the bin #' (number of bins given by argument \code{nbins}) before the event onset, given by argument \code{normbin}. Defaults to \code{FALSE}. -#' @param nbins An integer, specifying the number of bins used to determine median values before event onset. Only used when code{do_norm=TRUE}. Defaults to 6. -#' @param normbin An integer, specifying the bin number just before the event onset, used for normalisation. Only used when code{do_norm=TRUE}. Defaults to 2. +#' @param nbins An integer, specifying the number of bins used to determine median values before event onset. Only used when \code{do_norm=TRUE}. Defaults to 6. +#' @param normbin An integer, specifying the bin number just before the event onset, used for normalisation. Only used when \code{do_norm=TRUE}. Defaults to 2. #' #' @return A named list of data frames (\code{list( "df_idx_event", "df_idx_event_aggbyidx_event")}) containing data from all events and \code{before + after} #' dates (relative to event onset) with additional columns named \code{"inst"}, defining the event number (instance), and \code{"idx_event"}, defining #' the date relative to the respective event onset. The data frame \code{"df_idx_event"} contains rearranged, but otherwise unchanged data (unless #' \code{do_norm}=TRUE). The data frame \code{"df_idx_event_aggbyidx_event"} containes data aggregated across events with the mean and quantiles given for each #' \code{"idx_event"}. +#' @import dplyr +#' @import ggplot2 +#' @importFrom stats setNames #' @export #' align_events <- function( @@ -84,7 +87,7 @@ align_events <- function( tmp <- df_idx_event |> dplyr::filter(!is.na(inbin)) |> group_by( inbin ) |> - summarise_at( vars(one_of(dovars)), funs(median( ., na.rm=TRUE )) ) + summarise_at( vars(one_of(dovars)), funs(stats::median( ., na.rm=TRUE )) ) norm <- slice(tmp, normbin) @@ -104,11 +107,11 @@ align_events <- function( } q33 <- function( vec, ... ){ - quantile( vec, 0.33, ...) + stats::quantile( vec, 0.33, ...) } q66 <- function( vec, ... ){ - quantile( vec, 0.66, ...) + stats::quantile( vec, 0.66, ...) } diff --git a/R/collect_drivers_rsofun.R b/R/collect_drivers_rsofun.R index c24a799..dbda7d2 100644 --- a/R/collect_drivers_rsofun.R +++ b/R/collect_drivers_rsofun.R @@ -1,20 +1,20 @@ #' Collect all drivers #' -#' Collect all drivers for site-level simulations +#' Collect all drivers for site-level simulations #' into a nested data frame with one row for each site. #' -#' @param site_info A data frame containing site meta info (rows for sites). -#' Required columns are: \code{"sitename", "year_start", +#' @param site_info A data frame containing site meta info (rows for sites). +#' Required columns are: \code{"sitename", "year_start", #' "year_end", "lon", "lat", "elv"}. See \code{\link{prepare_setup_sofun}} for #' details. -#' @param params_siml A nested data frame with rows for each site containing +#' @param params_siml A nested data frame with rows for each site containing #' simulation parameters for SOFUN. See \code{\link{run_pmodel_f_bysite}} or #' \code{\link{run_biomee_f_bysite}}. #' @param meteo A nested data frame with rows for each site and meteorological #' forcing data time series nested inside a column named \code{"data"}. -#' @param fapar A nested data frame with rows for each site and fAPAR +#' @param fapar A nested data frame with rows for each site and fAPAR #' forcing data time series nested inside a column named \code{"data"}. -#' @param co2 A nested data frame with rows for each site and CO2 +#' @param co2 A nested data frame with rows for each site and CO2 #' forcing data time series nested inside a column named \code{"data"}. #' @param params_soil Soil texture data descriptor, a data frame with columns #' \code{"layer", "fsand", "fclay", "forg" } and \code{"fgravel"}. @@ -22,8 +22,8 @@ #' @return A \code{rsofun} input data frame (see \link{p_model_drivers} for a detailed #' description of its structure and contents). #' @export - -collect_drivers_sofun <- function( +#' +collect_drivers_sofun <- function( site_info, params_siml, meteo, @@ -31,7 +31,7 @@ collect_drivers_sofun <- function( co2, params_soil ){ - + # declare variable bindings for CRAN compliance # these are internal variables created in mutate # statements mostly which need to be defined or @@ -43,20 +43,20 @@ collect_drivers_sofun <- function( vpd <- vpd_doy <- ccov <- ccov_doy <- fapar_doy <- co2_doy <- tmin <- tmin_doy <- tmax <- tmax_doy <- doy <- forcing <- . <- NULL - + # complement the setup settings site_info <- prepare_setup_sofun( site_info = site_info, params_siml = params_siml) - + # check if all required variables are available if (!("snow" %in% names(meteo$data[[1]]))) { - warning("Variable 'snow' missing in meteo data frame. + warning("Variable 'snow' missing in meteo data frame. Assuming zero for all dates. \n") meteo <- meteo %>% mutate(data = purrr::map(data, ~dplyr::mutate(., snow = 0))) } - + if (!("rain" %in% names(meteo$data[[1]]))) { warning("Variable 'rain' missing in meteo data frame. Assuming equal to 'prec' for all dates. \n") @@ -64,7 +64,7 @@ collect_drivers_sofun <- function( dplyr::mutate(data = purrr::map(data, ~dplyr::mutate(., rain = prec))) } - + if (!("tmin" %in% names(meteo$data[[1]]))) { warning("Variable 'tmin' missing in meteo data frame. Assuming equal to 'temp' for all dates. @@ -75,79 +75,79 @@ collect_drivers_sofun <- function( data = purrr::map(data, ~dplyr::mutate(., tmax = temp))) } - + vars_req <- c("ppfd", "rain", "snow", "prec", "temp", "patm", "vpd", "ccov", "tmin", "tmax") - + vars_missing <- vars_req[ !(vars_req %in% names(meteo %>% tidyr::unnest(data))) ] - + if (length(vars_missing)) { stop(paste("Aborting. Variables missing in meteo data frame:", paste(vars_missing, collapse = ", "))) } - + # create mega-df containing all forcing data and parameters that # vary by site (not model parameters!) names_metainfo <- names(site_info)[-which(names(site_info) %in% c("sitename", "params_siml"))] - df_mega <- site_info %>% - tidyr::nest(site_info = names_metainfo) %>% + df_mega <- site_info %>% + tidyr::nest(site_info = names_metainfo) %>% dplyr::left_join( - meteo %>% + meteo %>% dplyr::rename(meteo = data), by = "sitename" - ) %>% + ) %>% dplyr::left_join( - fapar %>% + fapar %>% dplyr::rename(fapar = data), by = "sitename" - ) %>% + ) %>% dplyr::left_join( - co2 %>% + co2 %>% dplyr::rename(co2 = data), by = "sitename" - ) %>% + ) %>% dplyr::mutate( params_soil = purrr::map(as.list(seq(nrow(.))), ~return(params_soil))) - + # use only interpolated fapar and combine meteo data and fapar # into a single nested column 'forcing' - df_mega <- df_mega %>% - dplyr::mutate(fapar = purrr::map(fapar, ~dplyr::select(., date, fapar))) %>% - dplyr::mutate(co2 = purrr::map(co2 , ~dplyr::select(., date, co2))) %>% - dplyr::mutate(forcing = purrr::map2(meteo, fapar, ~dplyr::left_join( .x, .y, by = "date"))) %>% - dplyr::mutate(forcing = purrr::map2(forcing, co2, ~dplyr::left_join( .x, .y, by = "date"))) %>% + df_mega <- df_mega %>% + dplyr::mutate(fapar = purrr::map(fapar, ~dplyr::select(., date, fapar))) %>% + dplyr::mutate(co2 = purrr::map(co2 , ~dplyr::select(., date, co2))) %>% + dplyr::mutate(forcing = purrr::map2(meteo, fapar, ~dplyr::left_join( .x, .y, by = "date"))) %>% + dplyr::mutate(forcing = purrr::map2(forcing, co2, ~dplyr::left_join( .x, .y, by = "date"))) %>% dplyr::select(-meteo, -fapar, -co2) - + # drop sites for which forcing data is missing for all dates count_notna <- function(df) { - df %>% - dplyr::ungroup() %>% + df %>% + dplyr::ungroup() %>% dplyr::summarise(dplyr::across( c("ppfd", "rain", "snow", "prec", "temp", "patm", "vpd", "ccov", "fapar", "co2", - "tmin","tmax"), ~sum(!is.na(.)))) %>% + "tmin","tmax"), ~sum(!is.na(.)))) %>% tidyr::pivot_longer(cols = 1:12, names_to = "var", values_to = "n_not_missing") } - - df_missing <- df_mega %>% - dplyr::mutate(df_count = purrr::map(forcing, ~count_notna(.))) %>% - dplyr::select(sitename, df_count) %>% - tidyr::unnest(df_count) %>% + + df_missing <- df_mega %>% + dplyr::mutate(df_count = purrr::map(forcing, ~count_notna(.))) %>% + dplyr::select(sitename, df_count) %>% + tidyr::unnest(df_count) %>% dplyr::filter(n_not_missing < 365) - + if (nrow(df_missing) > 0) { warning("Missing values found in forcing data frame:") print(df_missing) warning("Respective sites are dropped from all drivers data frame.") - df_mega <- df_mega %>% + df_mega <- df_mega %>% dplyr::filter(!(sitename %in% pull(df_missing, sitename))) } - + ## interpolate to fill gaps in forcing time series myapprox <- function(vec){ if(all(is.na(vec))){ @@ -156,41 +156,41 @@ collect_drivers_sofun <- function( stats::approx(vec, xout = 1:length(vec))$y } } - + fill_na_forcing <- function(df) { - + # dummy variable for CRAN compliance ppdf_doy <- NULL - + vars <- names(df)[-which(names(df) == "date")] - df <- df %>% + df <- df %>% dplyr::mutate_at(vars, myapprox) - + ## fill remaining gaps with mean seasonal cycle add_doy <- function(string){paste0(string, "_doy")} - - df_meandoy <- df %>% - dplyr::mutate(doy = lubridate::yday(date)) %>% - dplyr::group_by(doy) %>% + + df_meandoy <- df %>% + dplyr::mutate(doy = lubridate::yday(date)) %>% + dplyr::group_by(doy) %>% dplyr::summarise( dplyr::across( tidyselect::vars_select_helpers$where(is.double), ~mean(.x, na.rm = TRUE) ) - ) %>% + ) %>% dplyr::rename_with(.fn = add_doy, .cols = dplyr::one_of( "ppfd", "rain", "snow", "prec", "temp", "patm", - "vpd", "ccov", "fapar", "co2", "tmin", "tmax")) %>% + "vpd", "ccov", "fapar", "co2", "tmin", "tmax")) %>% dplyr::select( - doy, + doy, dplyr::one_of( "ppfd_doy", "rain_doy", "snow_doy", "prec_doy", "temp_doy", "patm_doy", "vpd_doy", "ccov_doy", "fapar_doy", "co2_doy", "tmin_doy", "tmax_doy")) - - df <- df %>% - dplyr::mutate(doy = lubridate::yday(date)) %>% - dplyr::left_join(df_meandoy, by = "doy") %>% + + df <- df %>% + dplyr::mutate(doy = lubridate::yday(date)) %>% + dplyr::left_join(df_meandoy, by = "doy") %>% dplyr::mutate(ppfd = ifelse(is.na(ppfd), ppfd_doy, ppfd), rain = ifelse(is.na(rain), rain_doy, rain), snow = ifelse(is.na(snow), snow_doy, snow), @@ -202,14 +202,14 @@ collect_drivers_sofun <- function( fapar = ifelse(is.na(fapar), fapar_doy, fapar), co2 = ifelse(is.na(co2), co2_doy, co2), tmin = ifelse(is.na(tmin), tmin_doy, tmin), - tmax = ifelse(is.na(tmax), tmax_doy, tmax)) %>% + tmax = ifelse(is.na(tmax), tmax_doy, tmax)) %>% dplyr::select(-ends_with("_doy")) - + return(df) } - - df_mega <- df_mega %>% - mutate(forcing = purrr::map(forcing, ~fill_na_forcing(.))) %>% + + df_mega <- df_mega %>% + mutate(forcing = purrr::map(forcing, ~fill_na_forcing(.))) %>% dplyr::select(sitename, forcing, params_siml, site_info, params_soil) return(df_mega) diff --git a/R/gc_rsofun_driver_era5.R b/R/gc_rsofun_driver_era5.R index 27dd059..493a147 100644 --- a/R/gc_rsofun_driver_era5.R +++ b/R/gc_rsofun_driver_era5.R @@ -86,7 +86,7 @@ gc_rsofun_driver_era5 <- function( if(!inherits(files, "try-error")) { drivers <- lapply(files, function(file){ - df <- read.table(file, sep = ",", header = TRUE) + df <- utils::read.table(file, sep = ",", header = TRUE) df <- df[,c(1,5)] }) diff --git a/R/plot_map4.R b/R/plot_map4.R index b54584f..8286be1 100644 --- a/R/plot_map4.R +++ b/R/plot_map4.R @@ -240,7 +240,7 @@ plot_map4 <- function(obj, varnam = NA, maxval = NA, breaks = NA, lonmin = -180, ## convert to data frame for ggplot ##--------------------------------------------- tstep <- 1 - df <- as(rasta_reproj[[tstep]], "SpatialPixelsDataFrame") + df <- methods::as(rasta_reproj[[tstep]], "SpatialPixelsDataFrame") df <- as.data.frame(df) names(df) <- c("layer", "x", "y") @@ -397,7 +397,7 @@ plot_map4 <- function(obj, varnam = NA, maxval = NA, breaks = NA, lonmin = -180, "lipari", "roma")){ colorscale <- scico::scico(nbin, palette = colorscale, direction = invert) } else { - colorscale <- colorRampPalette( colorscale )( nbin ) + colorscale <- grDevices::colorRampPalette( colorscale )( nbin ) } } else if (class(colorscale)=="palette"){ diff --git a/man/align_events.Rd b/man/align_events.Rd index 0188127..78d8795 100644 --- a/man/align_events.Rd +++ b/man/align_events.Rd @@ -34,9 +34,9 @@ All events of length lower than \code{leng_threshold} are dropped.} \item{do_norm}{A logical specifying whether re-arranged data is to be normalised by the median value of the bin (number of bins given by argument \code{nbins}) before the event onset, given by argument \code{normbin}. Defaults to \code{FALSE}.} -\item{nbins}{An integer, specifying the number of bins used to determine median values before event onset. Only used when code{do_norm=TRUE}. Defaults to 6.} +\item{nbins}{An integer, specifying the number of bins used to determine median values before event onset. Only used when \code{do_norm=TRUE}. Defaults to 6.} -\item{normbin}{An integer, specifying the bin number just before the event onset, used for normalisation. Only used when code{do_norm=TRUE}. Defaults to 2.} +\item{normbin}{An integer, specifying the bin number just before the event onset, used for normalisation. Only used when \code{do_norm=TRUE}. Defaults to 2.} } \value{ A named list of data frames (\code{list( "df_idx_event", "df_idx_event_aggbyidx_event")}) containing data from all events and \code{before + after}