diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100755
index 0000000000000000000000000000000000000000..a3fec21952aeb97806315acd528355cee1b2630b
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,34 @@
+Package: biospheremetrics
+Type: Package
+Title: Biosphere integrity metrics for LPJmL
+Version: 0.3.0
+Author: Fabian Stenzel, Johanna Braun, Jannes Breier
+Maintainer: Fabian Stenzel <stenzel@pik-potsdam.de>
+Description: Functions to compute Biosphere integrity metrics BioCol and EcoRisk
+ based on output from LPJmL.
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 7.2.3
+Imports:
+ lpjmlkit,
+ rlang,
+ tidyr,
+ dplyr,
+ readr,
+ magrittr,
+ yaml,
+ stats,
+ zoo,
+ utils,
+ abind,
+ fields,
+ fBasics,
+ RColorBrewer,
+ raster,
+ circlize,
+ rgdal,
+ graphics,
+ grDevices,
+ sp,
+ maps
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100755
index 0000000000000000000000000000000000000000..63a321813bdfa9cc4e1715a5e96859c05befd383
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,36 @@
+# Generated by roxygen2: do not edit by hand
+
+export(average_nyear_window)
+export(calc_biocol)
+export(calc_delta_v)
+export(calc_ecorisk)
+export(calculate_within_biome_diffs)
+export(classify_biomes)
+export(disaggregate_into_biomes)
+export(ecorisk_cross_table)
+export(ecorisk_wrapper)
+export(get_biome_names)
+export(plot_biocol)
+export(plot_biocol_map)
+export(plot_biocol_ts)
+export(plot_biome_averages)
+export(plot_biome_averages_to_screen)
+export(plot_biome_internal_distribution)
+export(plot_biome_internal_distribution_to_screen)
+export(plot_biomes)
+export(plot_biomes_to_screen)
+export(plot_eco_riskmap_to_screen)
+export(plot_ecorisk_cross_table)
+export(plot_ecorisk_cross_table_to_screen)
+export(plot_ecorisk_map)
+export(plot_ecorisk_over_time_panel)
+export(plot_ecorisk_radial)
+export(plot_ecorisk_radial_panel)
+export(plot_ecorisk_radial_to_screen)
+export(plot_global)
+export(plot_global_to_screen)
+export(plot_overtime_to_screen)
+export(read_calc_biocol)
+export(read_ecorisk_data)
+export(replace_ref_data_with_average_ref_biome_cell)
+importFrom(magrittr,"%>%")
diff --git a/R/average_nyear_window.R b/R/average_nyear_window.R
new file mode 100755
index 0000000000000000000000000000000000000000..ac65f4e28e91d14485b499618e29adcf10ee3665
--- /dev/null
+++ b/R/average_nyear_window.R
@@ -0,0 +1,170 @@
+#' Calculate averages (mean) for defined window sizes
+#'
+#' Define window sizes (nyear_window) to be used to calculate averages (mean)
+#' for each window (`dim(x)[3] / nyear_window`). Instead of discrete windows,
+#' also moving averages can be computed as well as years inbetween interpolated.
+#'
+#' @param x LPJmL output array with `dim(x)=c(cell, month, year)`
+#'
+#' @param nyear_window integer, if supplied it defines the years for each window
+#' to be averaged over in `dim(x)[3]`. If `nyear_window == 1` values are used
+#' directly (instead of calculating an average). nyear_window has to be smaller
+#' than `dim(x)[3]` and `dim(x)[3]` is ideally a multipe of nyear_window.
+#' Defaults to `NULL`
+#'
+#' @param moving_average logical. If `TRUE` moving average is computed. start
+#' and end are interpolated using spline interpolation.
+#'
+#' @param interpolate logical. If `TRUE` and nyear_window is defined (with
+#' `moving_average == FALSE` years are interpolated (spline) to return array
+#' with same dimensions as `x` (mainly`dim(x)[3]` -> year).
+#'
+#' @param nyear_reference integer, if supplied (default NULL), it defines a
+#' time_span for ideally reference runs to be used as a baseline. E.g.
+#' `nyear_reference = 30` to be used for preindustrial climate reference.
+#'
+#' @return array with same amount of cells and months as x. 3rd dimension is
+#' defined by nyear_window, basically `dim(x)[3]/nyear_window` or equal to
+#' dim(x)[3] if `moving_average == TRUE` or `interpolate == TRUE`
+#'
+#' @md
+#' @importFrom magrittr %>%
+#' @export
+average_nyear_window <- function(x, # nolint
+ nyear_window = NULL,
+ moving_average = FALSE,
+ interpolate = FALSE,
+ nyear_reference = NULL) {
+
+ third_dim <- names(dim(x))[
+ !names(dim(x)) %in% c("cell", "year")
+ ] %>% {
+ if (rlang::is_empty(.)) NULL else .
+ }
+
+ if (length(third_dim) > 1) {
+ stop(paste0("x has to have dimensions \"cell\", \"year\" and can have ",
+ "one third dimension (e.g. \"month\", \"year\""))
+ }
+ # check validity of x dimensions
+ if (!all(names(dim(x)) %in% c("cell", third_dim, "year"))) {
+ stop(paste0("x has to have dimensions \"cell\"",
+ ifelse(is.null(third_dim),
+ "",
+ paste0(", \"", third_dim, "\"")),
+ " and \"year\"."))
+ }
+
+ # moving average function - spline interpolation to fill NAs at start/end
+ moving_average_fun <- function(x, n) {
+ stats::filter(x, rep(1 / n, n), sides = 2) %>%
+ zoo::na.spline()
+ }
+
+ # utility function to interpolate inbetween averaging windows via spline
+ interpolate_spline <- function(x, y, nyear_window) {
+ rep(NA, dim(y)["year"]) %>%
+ `[<-`(seq(round(nyear_window / 2), dim(y)["year"], nyear_window),
+ value = x) %>%
+ zoo::na.spline()
+ }
+
+ # if nyear_window is supplied not all years are used for averaging
+ if (!is.null(nyear_window)) {
+ if (!is.null(nyear_reference)) {
+ orig_x <- x
+ x <- lpjmlkit::asub(x, year = 1:nyear_reference)
+ }
+ # only valid for nyear_window < years of x (dim(x)[3])
+ if (nyear_window > 1 & nyear_window <= dim(x)["year"]) {
+ # check if multiple (can also be left out)
+ # if (dim(x)[3] %% nyear_window == 0) {
+ if (moving_average) {
+ y <- aperm(apply(x,
+ c("cell", third_dim),
+ moving_average_fun,
+ nyear_window),
+ c("cell", third_dim, ""))
+ } else {
+ # calculate mean for discret windows/bins with size of nyear_window
+ y <- array(x,
+ # set correct dimensions (with names)
+ dim = c(dim(x)[c("cell", third_dim)],
+ year = nyear_window,
+ window = dim(x)[["year"]] / nyear_window),
+ # set correct dimensions names with nyear and windows
+ dimnames = append(dimnames(x)[c("cell", third_dim)],
+ list(year = seq_len(nyear_window),
+ window = dimnames(x)[["year"]][
+ seq(round(nyear_window / 2),
+ dim(x)[["year"]],
+ nyear_window)
+ ]))) %>%
+ apply(c("cell", third_dim, "window"), mean)
+ if (interpolate) {
+ y <- aperm(apply(y,
+ c("cell", third_dim),
+ interpolate_spline,
+ x,
+ nyear_window),
+ c("cell", third_dim, ""))
+ }
+ }
+ # }
+ } else if (nyear_window == 1) {
+ y <- x
+ } else {
+ stop(paste0("Amount of nyear_window (", nyear_window, ") not supported."))
+ }
+ # recycle nyear_reference subset for original x (years)
+ if (!is.null(nyear_reference)) {
+ # multiple factor
+ nmultiple <- round(dim(orig_x)[["year"]] / nyear_reference)
+ replace_multiple_id <- nmultiple * dim(y)[[3]]
+ # if average window is returned as year dimension
+ if (!moving_average & !interpolate) {
+ z <- array(NA,
+ dim = c(dim(y)[c("cell", third_dim)],
+ window = replace_multiple_id),
+ dimnames = append(dimnames(y)[c("cell", third_dim)],
+ list(window = rep(dimnames(y)[[3]],
+ nmultiple))))
+ # return as original year dimension
+ } else {
+ # years vector also for non multiples (subset only partly recycled)
+ years <- rep(NA, dim(orig_x)[["year"]]) %>%
+ `[<-`(, value = dimnames(x)[["year"]]) %>%
+ suppressWarnings()
+ z <- array(NA,
+ dim = dim(orig_x),
+ dimnames = append(dimnames(y)[c("cell", third_dim)],
+ list(year = years)))
+ }
+ # recycle subset y for rest of original (x) years in z
+ z[, , seq_len(replace_multiple_id)] <- y
+ # check if not multiple - then only partly recylce array
+ if ((dim(z)[3] - replace_multiple_id) > 0) {
+ z[, , (replace_multiple_id + 1):dim(z)[3]] <- (
+ y[, , seq_len(dim(z)[3] - replace_multiple_id)]
+ )
+ }
+ return(z)
+ } else {
+ # rename dimnames of array
+ if (all(dim(y) == dim(x))) {
+ dim(y) <- dim(x)
+ dimnames(y) <- dimnames(x)
+ }
+ }
+ } else {
+ y <- apply(x, c("cell", third_dim), mean)
+ if (is.null(dim(y))) {
+ y <- array(
+ y,
+ dim = c(cell = dim(x)[["cell"]], 1),
+ dimnames = list(cell = dimnames(x)[["cell"]], 1)
+ )
+ }
+ }
+ return(y)
+}
diff --git a/R/biocol.R b/R/biocol.R
new file mode 100755
index 0000000000000000000000000000000000000000..04bda22a48381e54a3c0b6d9d28be28b148159e5
--- /dev/null
+++ b/R/biocol.R
@@ -0,0 +1,1041 @@
+# written by Fabian Stenzel
+# 2022-2023 - stenzel@pik-potsdam.de
+
+################# BioCol calc functions ###################
+
+#' Calculate BioCol based on a PNV run and LU run of LPJmL
+#'
+#' Function to calculate BioCol based on a PNV run and LU run of LPJmL
+#' @param files_scenario list with variable names and corresponding file paths
+#' (character string) of the scenario LPJmL run. All needed files are
+#' provided in XXX. E.g.: list(leaching = "/temp/leaching.bin.json")
+#' @param files_reference list with variable names and corresponding file paths
+#' (character string) of the reference LPJmL run. All needed files are
+#' provided in XXX. E.g.: list(leaching = "/temp/leaching.bin.json"). If not
+#' needed for the applied method, set to NULL.
+#' @param time_span_scenario time span to be used for the scenario run, defined
+#' as a character string, e.g. `as.character(1982:2011)` (default)
+#' @param time_span_reference time span to be used for the scenario run, defined
+#' as an integer vector, e.g. `as.character(1901:1930)`. Can differ in offset
+#' and length from `time_span_scenario`! If `NULL` value of `time_span_scenario`
+#' is used
+#' @param reference_npp_time_span time span to read reference npp from, using
+#' index years 10:39 from potential npp input if set to NULL (default: NULL)
+#' @param reference_npp_file file to read reference npp from, using
+#' potential npp input if set to NULL (default: NULL)
+#' @param gridbased logical are pft outputs gridbased or pft-based?
+#' @param read_saved_data flag whether to read previously saved data
+#' instead of reading it in from output files (default FALSE)
+#' @param save_data whether to save input data to file (default FALSE)
+#' @param data_file file to save/read input data to/from (default NULL)
+#' @param include_fire boolean include firec in calculation of BioCol?
+#' (default TRUE)
+#' @param external_fire instead of reading in firec for fire emissions, read in
+#' this external firec file from a separate spitfire run with disabled
+#' lighning. this will then include only human induced fires
+#' (default FALSE)
+#' @param external_wood_harvest include external wood harvest from LUH2_v2h
+#' (default FALSE)
+#' @param grass_scaling whether to scale pasture harvest according to
+#' data given via grass_harvest_file (default FALSE)
+#' @param npp_threshold lower threshold for npp (to mask out non-lu areas
+#' according to Haberl et al. 2007). Below BioCol will be set to 0.
+#' (default: 20 gC/m2)
+#' @param grass_harvest_file file containing grazing data to rescale the
+#' grassland harvests according to Herrero et al. 2013. File contains:
+#' grazing_data list object with $name and $id of 29 world regions, and
+#' $Herrero_2000_kgDM_by_region containing for each of these regions and
+#' mapping_lpj67420_to_grazing_regions array with a mapping between 67420
+#' LPJmL cells and the 29 regions
+#' @param external_fire_file path to external file with human induced fire
+#' fraction c(cell,month,year) since 1500
+#' @param external_wood_harvest_file path to R-file containing processed
+#' timeline of maps for LUH2_v2h woodharvest
+#'
+#' @return list data object containing BioCol and components as arrays: biocol,
+#' biocol_overtime, biocol_overtime_perc_piref, biocol_perc,
+#' biocol_perc_piref, npp_potential, npp_act_overtime, npp_pot_overtime,
+#' npp_eco_overtime, harvest_cft_overtime, npp_luc_overtime,
+#' rharvest_cft_overtime, fire_overtime, timber_harvest_overtime,
+#' harvest_cft, biocol_harvest, grassland_scaling_factor_cellwise,
+#' biocol_luc, biocol_luc_piref
+#'
+#' @export
+read_calc_biocol <- function( # nolint
+ files_scenario,
+ files_reference,
+ time_span_scenario,
+ time_span_reference = NULL,
+ reference_npp_time_span = NULL,
+ reference_npp_file = NULL,
+ gridbased = TRUE,
+ read_saved_data = FALSE,
+ save_data = FALSE,
+ data_file = NULL,
+ include_fire = FALSE,
+ external_fire = FALSE,
+ external_wood_harvest = FALSE,
+ grass_scaling = FALSE,
+ npp_threshold = 20,
+ grass_harvest_file = "grazing_data.RData",
+ external_fire_file = "human_ignition_fraction.RData",
+ external_wood_harvest_file = "wood_harvest_biomass_sum_1500-2014_67420.RData"
+) {
+ if (is.null(time_span_reference)) time_span_reference <- time_span_scenario
+ if (grass_scaling && !file.exists(grass_harvest_file)) {
+ stop(
+ paste0("Grass harvest scaling enabled, but grass_harvest_file does not exist in: ", # nolint
+ grass_harvest_file)
+ )
+ }
+ if (external_wood_harvest && !file.exists(external_wood_harvest_file)) {
+ stop(
+ paste0("External wood harvest enabled, but external_wood_harvest_file does not exist in: ", # nolint
+ external_wood_harvest_file)
+ )
+ }
+ if (external_fire && !file.exists(external_fire_file)) {
+ stop(
+ paste0("External fire fraction file enabled, but external_fire_file does not exist in: ", # nolint
+ external_fire_file)
+ )
+ }
+ # reading required data
+ if (read_saved_data) {
+ if (file.exists(data_file)) {
+ print(paste0("Reading in data from previously saved data file"))
+ load(data_file)
+ wood_harvest[is.na(wood_harvest)] <- 0
+ } else {
+ stop(
+ paste0("data_file: '",
+ data_file,
+ "' does not exist but is required since reading is set to FALSE."
+ )
+ )
+ }
+ if (save_data) {
+ save_data <- FALSE
+ print(
+ paste0("Both read_saved_data and save_data have been set to TRUE. ",
+ "Overwriting with the same data does not make sense, saving ",
+ "disabled. ")
+ )
+ }
+ } else {
+ print("Reading in data from outputs")
+
+ file_type <- tools::file_ext(files_reference$grid)
+
+ if (file_type %in% c("json", "clm")) {
+ # read grid
+ grid <- lpjmlkit::read_io(
+ files_reference$grid
+ )
+ # calculate cell area
+ cellarea <- lpjmlkit::calc_cellarea(grid)
+ lat <- grid$data[, , 2]
+ lon <- grid$data[, , 1]
+
+ npp <- lpjmlkit::read_io(
+ files_scenario$npp,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>% drop() # gC/m2
+
+ if (!is.null(reference_npp_file)) {
+ npp_ref <- lpjmlkit::read_io(
+ reference_npp_file,
+ subset = list(year = as.character(reference_npp_time_span))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)
+ ) %>% drop() # remaining bands
+ }
+
+ pftnpp <- lpjmlkit::read_io(
+ files_scenario$pft_npp,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)
+ )
+
+ harvest <- lpjmlkit::read_io(
+ files_scenario$pft_harvestc,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)
+ )
+
+ rharvest <- lpjmlkit::read_io(
+ files_scenario$pft_rharvestc,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum))
+
+ timber <- lpjmlkit::read_io(
+ files_scenario$timber_harvestc,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)
+ ) %>% drop() # remaining bands
+
+ if (include_fire) {
+
+ # read fire in monthly res. if possible, then multiply with monthly
+ # human/total ignition frac and aggregate to yearly. Otherwise aggregate
+ # human/total ignition frac to yearly and multiply with yearly firec
+ fire_raw <- lpjmlkit::read_io(
+ files_scenario$firec,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(band = sum)
+ ) # gC/m2
+
+ if (external_fire) {
+ load(external_fire_file) # frac = c(cell,month,year)
+ }
+
+ if ("month" %in% names(dim(fire_raw))) {
+ if (external_fire) {
+ fire <- apply(
+ fire_raw * frac[, , year = time_span_scenario],
+ c("cell", "year"),
+ sum,
+ na.rm = TRUE
+ ) # gC/m2
+ rm(frac)
+
+ } else {
+ fire <- apply(
+ fire_raw,
+ c("cell", "year"),
+ sum,
+ na.rm = TRUE
+ ) # gC/m2
+ }
+ rm(fire_raw)
+
+ } else {
+ if (external_fire) {
+ frac_yearly <- apply(
+ frac[, , year = time_span_scenario],
+ c("cell", "year"),
+ mean,
+ na.rm = TRUE
+ )
+ fire <- fire_raw * frac_yearly
+ rm(frac_yearly, frac)
+ }
+ }
+ gc()
+ } else {
+ fire <- timber * 0
+ }
+
+ if (external_wood_harvest) {
+ load(external_wood_harvest_file) # wh_lpj in kgC
+ wh_years <- names(wh_lpj[1, ])
+ # from kgC to gC/m2
+ wood_harvest <- (
+ wh_lpj[, match(time_span_scenario, wh_years)] * 10^3 / cellarea
+ )
+ # the division can lead to NAs
+ wood_harvest[is.na(wood_harvest)] <- 0
+ rm(wh_lpj, wh_years)
+ gc()
+
+ } else {
+ wood_harvest <- fire * 0
+ }
+
+ cftfrac <- lpjmlkit::read_io(
+ files_scenario$cftfrac,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)
+ )
+
+ npp_potential <- lpjmlkit::read_io(
+ files_reference$npp,
+ subset = list(year = as.character(time_span_reference))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)
+ ) %>% drop() # gC/m2
+
+ fpc <- lpjmlkit::read_io(
+ files_scenario$fpc,
+ subset = list(year = as.character(time_span_scenario))) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(band = sum)
+ )
+
+ pftbands <- lpjmlkit::read_meta(files_scenario$fpc)$nbands - 1
+
+ } else if (file_type == "nc") { # to be added
+ stop(
+ "nc reading has not been updated to latest functionality.",
+ " Please contact Fabian Stenzel"
+ )
+
+ } else {
+ stop("Unrecognized file type (",
+ file_type,
+ ")")
+ }
+
+ bp_bands <- c(15, 16, 31, 32)
+ grass_bands <- c(14, 30)
+ nat_bands <- 1:pftbands
+
+ if (!gridbased) { # needs to be scaled with standfrac
+ pftnpp[, , nat_bands] <- pftnpp[, , nat_bands] * fpc[, , 2:(pftbands + 1)]
+ pftnpp[, , -c(nat_bands)] <- pftnpp[, , -c(nat_bands)] * cftfrac
+ harvest <- harvest * cftfrac
+ }
+
+ pftnpp_grasslands <- apply(
+ pftnpp[, , pftbands + grass_bands],
+ c(1, 2),
+ sum
+ ) #gC/m2 only from grassland bands
+
+ pftnpp_cft <- apply(
+ pftnpp[, , -c(nat_bands, pftbands + grass_bands, pftbands + bp_bands)],
+ c(1, 2), sum
+ ) #gC/m2 not from grassland and bioenergy bands
+
+ pftnpp_bioenergy <- apply(
+ pftnpp[, , pftbands + bp_bands],
+ c(1, 2),
+ sum
+ ) #gC/m2 only from bioenergy bands
+
+ pftnpp_nat <- apply(
+ pftnpp[, , nat_bands], c(1, 2), sum) # gC/m2
+
+ if (is.null(reference_npp_file)){
+ pi_window <- 3:32
+ npp_ref <- npp_potential[, pi_window]
+ } # npp_ref
+
+ harvest_grasslands <- apply(
+ harvest[, , grass_bands],
+ c(1, 2),
+ sum
+ ) # gC/m2 only from grassland bands
+
+ harvest_bioenergy <- apply(
+ harvest[, , bp_bands],
+ c(1, 2),
+ sum
+ ) # gC/m2 only from bioenergy bands
+
+ harvest_cft <- apply(
+ harvest[, , -c(grass_bands, bp_bands)],
+ c(1, 2),
+ sum
+ ) # gC/m2 not from grassland and bioenergy bands
+
+ rharvest_cft <- apply(
+ rharvest[, , -c(grass_bands, bp_bands)],
+ c(1, 2),
+ sum
+ ) # gC/m2 not from grassland and bioenergy bands
+
+ if (save_data) {
+ if (!file.exists(data_file)) {
+ print(paste0("Writing data file: ", data_file))
+ } else {
+ print(
+ paste0(
+ "Data file (",
+ data_file,
+ ") already exists, old file renamed to: ",
+ data_file,
+ "_sav")
+ )
+ file.rename(data_file, paste0(data_file, "_sav"))
+ }
+
+ save(npp_potential,
+ npp,
+ npp_ref,
+ pftnpp_cft,
+ pftnpp_nat,
+ pftnpp_grasslands,
+ pftnpp_bioenergy,
+ harvest_cft,
+ rharvest_cft,
+ fire,
+ timber,
+ fpc,
+ cftfrac,
+ harvest_grasslands,
+ harvest_bioenergy,
+ wood_harvest,
+ lat,
+ lon,
+ cellarea,
+ file = data_file)
+ }
+ }
+
+ print(paste0("Calculating data"))
+
+ if (grass_scaling) {
+ load(grass_harvest_file)
+
+ nregs <- length(grazing_data$name)
+
+ lpj_grass_harvest_region <- array(0, dim = nregs)
+
+ lpj_grass_harvest_2000 <- rowMeans(
+ harvest_grasslands[, (1995 - start_year + 1) : (2005 - start_year + 1)]
+ ) * cellarea / 1000 * 2 # from gC/m2 to kgDM
+
+ grassland_scaling_factor_cellwise <- array(1, dim = grid$ncells)
+
+ for (r in 1:nregs) {
+ lpj_grass_harvest_region[r] <- sum(
+ lpj_grass_harvest_2000[which(mapping_lpj67420_to_grazing_regions == r)]
+ )
+ }
+
+ scaling_factor <- (
+ grazing_data$Herrero_2000_kgDM_by_region / lpj_grass_harvest_region
+ )
+
+ for (r in 1:nregs) {
+ grassland_scaling_factor_cellwise[
+ which(mapping_lpj67420_to_grazing_regions == r)
+ ] <- scaling_factor[r]
+ }
+ harvest_grasslands <- harvest_grasslands * rep(
+ grassland_scaling_factor_cellwise,
+ times = length(harvest_grasslands[1, ])
+ )
+ }
+
+ npp_act_overtime <- colSums(npp * cellarea) / 10^15 # gC/m2 to GtC
+ npp_pot_overtime <- colSums(npp_potential * cellarea) / 10^15 # gC/m2 to GtC
+ npp_eco_overtime <- colSums(pftnpp_nat * cellarea) / 10^15 # gC/m2 to GtC
+ npp_luc_overtime <- npp_pot_overtime - npp_act_overtime
+
+ harvest_cft_overtime <- colSums(
+ harvest_cft * cellarea
+ ) / 10^15 # gC/m2 to GtC
+ rharvest_cft_overtime <- colSums(
+ rharvest_cft * cellarea
+ ) / 10^15 # gC/m2 to GtC
+ harvest_grasslands_overtime <- colSums(
+ harvest_grasslands * cellarea
+ ) / 10^15 # gC/m2 to GtC
+ harvest_bioenergy_overtime <- colSums(
+ harvest_bioenergy * cellarea
+ ) / 10^15 # gC/m2 to GtC
+
+ timber_harvest_overtime <- colSums(
+ timber * cellarea
+ ) / 10^15 # gC/m2 to GtC
+ fire_overtime <- colSums(
+ fire * cellarea
+ ) / 10^15 # gC/m2 to GtC
+ wood_harvest_overtime <- colSums(
+ wood_harvest * cellarea
+ ) / 10^15 # gC/m2 to GtC
+
+ if (include_fire) {
+ biocol_overtime <- harvest_cft_overtime + rharvest_cft_overtime +
+ harvest_grasslands_overtime + harvest_bioenergy_overtime +
+ timber_harvest_overtime + fire_overtime + npp_luc_overtime +
+ wood_harvest_overtime
+ } else {
+ biocol_overtime <- harvest_cft_overtime + rharvest_cft_overtime +
+ harvest_grasslands_overtime + harvest_bioenergy_overtime +
+ timber_harvest_overtime + npp_luc_overtime +
+ wood_harvest_overtime
+ }
+
+ biocol_overtime_perc_piref <- (
+ biocol_overtime / mean(colSums(npp_ref * cellarea) / 10^15) * 100
+ )
+ biocol_luc <- npp_potential - npp
+ # pick a PI window that excludes onset effects, but is reasonable early
+
+ if (include_fire) {
+ biocol_harvest <- (
+ harvest_cft + rharvest_cft + harvest_grasslands + harvest_bioenergy +
+ timber + fire + wood_harvest
+ )
+ } else {
+ biocol_harvest <- (
+ harvest_cft + rharvest_cft + harvest_grasslands + harvest_bioenergy +
+ timber + wood_harvest
+ )
+ }
+
+ biocol <- biocol_harvest + biocol_luc
+ # set to 0 below lower threshold of NPP
+ biocol[abs(npp_potential) < npp_threshold] <- 0
+ # actual NPPpot as ref
+ biocol_perc <- biocol / npp_potential * 100
+
+ # NPPpi as ref
+ biocol_perc_piref <- biocol / rowMeans(npp_ref) * 100
+
+ return(list(biocol_overtime = biocol_overtime,
+ biocol = biocol,
+ biocol_perc = biocol_perc,
+ biocol_overtime_perc_piref = biocol_overtime_perc_piref,
+ npp = npp,
+ biocol_perc_piref = biocol_perc_piref,
+ npp_potential = npp_potential,
+ npp_act_overtime = npp_act_overtime,
+ npp_pot_overtime = npp_pot_overtime,
+ npp_eco_overtime = npp_eco_overtime,
+ npp_ref = npp_ref,
+ harvest_cft_overtime = harvest_cft_overtime,
+ npp_luc_overtime = npp_luc_overtime,
+ rharvest_cft_overtime = rharvest_cft_overtime,
+ fire_overtime = fire_overtime,
+ timber_harvest_overtime = timber_harvest_overtime,
+ harvest_cft = harvest_cft,
+ rharvest_cft = rharvest_cft,
+ wood_harvest_overtime = wood_harvest_overtime,
+ biocol_harvest = biocol_harvest,
+ biocol_luc = biocol_luc)) #, biocol_luc_piref = biocol_luc_piref))
+
+}
+
+#' Calculate BioCol
+#'
+#' Wrapper function to calculate BioCol
+#'
+#' @param path_lu folder of landuse scenario run
+#' @param path_pnv folder of pnv reference run
+#' @param start_year first year of simulations
+#' @param stop_year last year of simulations
+#' @param reference_npp_time_span time span to read reference npp from, using
+#' index years 10:39 from potential npp input if set to NULL (default: NULL)
+#' @param reference_npp_file file to read reference npp from, using
+#' potential npp input if set to NULL (default: NULL)
+#' @param gridbased logical are pft outputs gridbased or pft-based?
+#' @param read_saved_data flag whether to read previously saved data
+#' instead of reading it in from output files (default FALSE)
+#' @param save_data whether to save input data to file (default FALSE)
+#' @param data_file file to save/read input data to/from (default NULL)
+#' @param include_fire boolean include firec in calculation of BioCol?
+#' (default TRUE)
+#' @param external_fire instead of reading in firec for fire emissions, read in
+#' this external firec file from a separate spitfire run with disabled
+#' lighning. this will then include only human induced fires
+#' (default FALSE)
+#' @param external_wood_harvest include external wood harvest from LUH2_v2h
+#' (default FALSE)
+#' @param grass_scaling whether to scale pasture harvest according to
+#' data given via grass_harvest_file (default FALSE)
+#' @param npp_threshold lower threshold for npp (to mask out non-lu areas
+#' according to Haberl et al. 2007). Below BioCol will be set to 0.
+#' (default: 20 gC/m2)
+#' @param grass_harvest_file file containing grazing data to rescale the
+#' grassland harvests according to Herrero et al. 2013. File contains:
+#' grazing_data list object with $name and $id of 29 world regions, and
+#' $Herrero_2000_kgDM_by_region containing for each of these regions and
+#' mapping_lpj67420_to_grazing_regions array with a mapping between 67420
+#' LPJmL cells and the 29 regions
+#' @param external_fire_file path to external file with human induced fire
+#' fraction c(cell,month,year) since 1500
+#' @param external_wood_harvest_file path to R-file containing processed
+#' timeline of maps for LUH2_v2h woodharvest
+#'
+#' @return list data object containing BioCol and components as arrays: biocol,
+#' biocol_overtime, biocol_overtime_perc_piref, biocol_perc,
+#' biocol_perc_piref, npp_potential, npp_act_overtime, npp_pot_overtime,
+#' npp_eco_overtime, harvest_cft_overtime, npp_luc_overtime,
+#' rharvest_cft_overtime, fire_overtime, timber_harvest_overtime,
+#' harvest_cft, biocol_harvest, grassland_scaling_factor_cellwise,
+#' biocol_luc, biocol_luc_piref
+#'
+#' @export
+calc_biocol <- function(
+ path_lu,
+ path_pnv,
+ start_year,
+ stop_year,
+ reference_npp_time_span = NULL,
+ reference_npp_file = NULL,
+ varnames = NULL,
+ gridbased = TRUE,
+ read_saved_data = FALSE,
+ save_data = FALSE,
+ data_file = NULL,
+ include_fire = FALSE,
+ external_fire = FALSE,
+ external_wood_harvest = FALSE,
+ grass_scaling = FALSE,
+ npp_threshold = 20,
+ grass_harvest_file = "grazing_data.RData",
+ external_fire_file = "human_ignition_fraction.RData",
+ external_wood_harvest_file = "wood_harvest_biomass_sum_1500-2014_67420.RData"
+) {
+ if (is.null(varnames)) {
+ print(
+ paste0("Varnames not given, using standard values, which might not fit ",
+ "this specific configuration. Please check!")
+ )
+ varnames <- data.frame(
+ row.names = c(
+ "grid",
+ "npp",
+ "pft_npp",
+ "pft_harvest",
+ "pft_rharvest",
+ "firec",
+ "timber_harvest",
+ "cftfrac",
+ "fpc"
+ ),
+ outname = c(
+ "grid.bin.json",
+ "mnpp.bin.json",
+ "pft_npp.bin.json",
+ "pft_harvest.bin.json",
+ "pft_rharvest.bin.json",
+ "firec.bin.json",
+ "timber_harvestc.bin.json",
+ "cftfrac.bin.json",
+ "fpc.bin.json"
+ ),
+ timestep = c("Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y")
+ )
+ }
+
+ # translate varnames and folders to files_scenarios/reference lists
+ files_scenario <- list(
+ grid = paste0(path_lu, varnames["grid", "outname"]),
+ npp = paste0(path_lu, varnames["npp", "outname"]),
+ pft_npp = paste0(path_lu, varnames["pft_npp", "outname"]),
+ pft_harvestc = paste0(path_lu, varnames["pft_harvest", "outname"]),
+ pft_rharvestc = paste0(path_lu,varnames["pft_rharvest", "outname"]),
+ firec = paste0(path_lu, varnames["firec", "outname"]),
+ timber_harvestc = paste0(path_lu, varnames["timber_harvest", "outname"]),
+ cftfrac = paste0(path_lu, varnames["cftfrac", "outname"]),
+ fpc = paste0(path_lu, varnames["fpc", "outname"])
+ )
+ files_reference <- list(
+ grid = paste0(path_pnv, varnames["grid", "outname"]),
+ npp = paste0(path_pnv, varnames["npp", "outname"]),
+ pft_npp = paste0(path_pnv, varnames["pft_npp", "outname"]),
+ pft_harvestc = paste0(path_pnv, varnames["pft_harvest", "outname"]),
+ pft_rharvestc = paste0(path_pnv, varnames["pft_rharvest", "outname"]),
+ firec = paste0(path_pnv, varnames["firec", "outname"]),
+ timber_harvestc = paste0(path_pnv, varnames["timber_harvest", "outname"]),
+ cftfrac = paste0(path_pnv, varnames["cftfrac", "outname"]),
+ fpc = paste0(path_pnv, varnames["fpc", "outname"])
+ )
+ return(
+ read_calc_biocol(
+ files_scenario = files_scenario,
+ files_reference = files_reference,
+ time_span_scenario = as.character(start_year:stop_year),
+ time_span_reference = as.character(start_year:stop_year),
+ reference_npp_time_span = reference_npp_time_span,
+ reference_npp_file = reference_npp_file,
+ gridbased = gridbased,
+ read_saved_data = read_saved_data,
+ save_data = save_data,
+ data_file = data_file,
+ include_fire = include_fire,
+ external_fire = external_fire,
+ external_wood_harvest = external_wood_harvest,
+ grass_scaling = grass_scaling,
+ npp_threshold = npp_threshold,
+ grass_harvest_file = grass_harvest_file,
+ external_fire_file = external_fire_file,
+ external_wood_harvest_file = external_wood_harvest_file
+ )
+ )
+}
+
+
+#' Plot absolute BioCol, overtime, maps, and npp into given folder
+#'
+#' Wrapper function to plot absolute biocol, overtime, maps, and npp into given
+#' folder
+#'
+#' @param biocol_data biocol data list object (returned from calc_biocol)
+#' containing biocol, npp_eco_overtime, npp_act_overtime, npp_pot_overtime,
+#' npp_bioenergy_overtime, biocol_overtime, npp_harv_overtime,
+#' biocol_overtime_perc_piref, biocol_perc, biocol_perc_piref, npp all in GtC
+#' @param path_write folder to write into
+#' @param plotyears range of years to plot over time
+#' @param min_val y-axis minimum value for plot over time
+#' @param max_val y-axis maximum value for plot over time
+#' @param legendpos position of legend
+#' @param start_year first year of biocol_data object
+#' @param mapyear year to plot biocol map for
+#' @param mapyear_buffer +- years around mapyear to average biocol
+#' (make sure these years exist in biocol_data)
+#' @param highlightyear year(s) that should be highlighted in overtime plot
+#' @param eps write plots as eps, instead of png (default = FALSE)
+#'
+#' @return none
+#' @export
+plot_biocol <- function(
+ biocol_data,
+ path_write,
+ plotyears,
+ min_val,
+ max_val,
+ legendpos,
+ start_year,
+ mapyear,
+ mapyear_buffer = 5,
+ highlightyear,
+ eps = FALSE
+) {
+ mapindex <- mapyear - start_year
+ print(paste0("Plotting BioCol figures"))
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ plot_global(
+ data = rowMeans(
+ biocol_data$biocol[, (mapindex - mapyear_buffer) : (mapindex + mapyear_buffer)] # nolint
+ ),
+ file = paste0(path_write, "BioCol_absolute_", mapyear, ".png"),
+ type = "exp",
+ title = "",
+ # paste0("BioCol_abs in ", mapyear),
+ pow2min = 0,
+ pow2max = 12,
+ legendtitle = "GtC",
+ leg_yes = TRUE,
+ only_pos = FALSE,
+ eps = eps
+ )
+
+ plot_global(
+ data = rowMeans(
+ biocol_data$biocol_luc[, (mapindex - mapyear_buffer) : (mapindex + mapyear_buffer)] # nolint
+ ),
+ file = paste0(path_write, "BioCol_luc_", mapyear, ".png"),
+ type = "exp",
+ title = "",
+ # paste0("BioCol_luc in ", mapyear),
+ pow2min = 0,
+ pow2max = 12,
+ legendtitle = "GtC",
+ leg_yes = TRUE,
+ only_pos = FALSE,
+ eps = eps
+ )
+
+ plot_global(
+ data = rowMeans(
+ biocol_data$biocol_harvest[, (mapindex - mapyear_buffer) : (mapindex + mapyear_buffer)] # nolint
+ ),
+ file = paste0(path_write, "BioCol_harv_", mapyear, ".png"),
+ type = "exp",
+ title = "",
+ # paste0("BioCol_harv in ", mapyear),
+ pow2min = 0,
+ pow2max = 12,
+ legendtitle = "GtC",
+ leg_yes = TRUE,
+ only_pos = FALSE,
+ eps = eps
+ )
+
+ plot_biocol_ts(
+ biocol_data = biocol_data,
+ file = paste0(
+ path_write, "BioCol_overtime_LPJmL_", plotyears[1], "-", plotyears[2], ".png" # nolint
+ ),
+ first_year = start_year,
+ plot_years = plotyears,
+ min_val = min_val,
+ ref = "pi",
+ legendpos = legendpos,
+ max_val = max_val,
+ eps = eps,
+ highlight_years = highlightyear
+ )
+
+ plot_biocol_map(
+ data = rowMeans(
+ biocol_data$biocol_perc[, (mapindex - mapyear_buffer) : (mapindex + mapyear_buffer)] # nolint
+ ),
+ file = paste0(path_write, "BioCol_LPJmL_", mapyear, ".png"),
+ legendtitle = "% of NPPpot",
+ eps = eps,
+ title = "",
+ # paste0("BioCol_perc ",mapyear-mapyear_buffer, " - ",mapyear+mapyear_buffer)
+ )
+
+ plot_biocol_map(
+ data = rowMeans(
+ biocol_data$biocol_perc_piref[, (mapindex - mapyear_buffer) : (mapindex + mapyear_buffer)] # nolint
+ ),
+ file = paste0(path_write, "BioCol_perc_piref_LPJmL_", mapyear, ".png"),
+ title = "",
+ # paste0("BioCol_perc ",mapyear-mapyear_buffer, " - ",mapyear+mapyear_buffer),
+ legendtitle = "% of NPPref",
+ eps = eps
+ )
+
+ plot_global(
+ data = rowMeans(
+ biocol_data$npp[, (mapindex - mapyear_buffer) : (mapindex + mapyear_buffer)] # nolint
+ ),
+ file = paste0(path_write, "NPP_LPJmL_", mapyear, ".png"),
+ type = "lin",
+ only_pos = TRUE,
+ title = "",
+ legendtitle = "gC/m2",
+ leg_yes = TRUE,
+ min = 0,
+ max = 1800
+ )
+}
+
+
+#' Plot global map of BioCol to file
+#'
+#' Plot global map of BioCol to file with legend colors similar to
+#' Haberl et al. 2007
+#'
+#' @param data array containing BioCol percentage value for each gridcell
+#' @param file character string for location/file to save plot to
+#' @param plotyears range of years to plot over time
+#' @param title character string title for plot
+#' @param legendtitle character string legend title
+#' @param zero_threshold smallest value to be distinguished from 0 in legend,
+#' both for negative and positive values (default: 0.1)
+#' @param eps write eps file instead of PNG (boolean) - (default: FALSE)
+#'
+#' @return none
+#'
+#' @export
+plot_biocol_map <- function(
+ data, file,
+ title = "",
+ legendtitle = "",
+ zero_threshold = 0.1,
+ eps = FALSE
+) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ brks <- c(-400, -200, -100, -50, -zero_threshold,
+ zero_threshold, 10, 20, 30, 40, 50, 60, 70, 80, 100)
+ classes <- c("<-200", "-200 - -100", "-100 - -50",
+ paste0("-50 - -", zero_threshold),
+ paste0("-", zero_threshold, " - ", zero_threshold),
+ paste0(zero_threshold, " - 10"), "10 - 20", "20 - 30", "30 - 40",
+ "40 - 50", "50 - 60", "60 - 70", "70 - 80", "80 - 100")
+ palette <- c("navy", "royalblue3", "royalblue1", "skyblue1",
+ "grey80", "yellowgreen", "greenyellow", "yellow",
+ "gold", "orange", "orangered", "orangered4", "brown4",
+ "black")
+ data[data < brks[1]] <- brks[1]
+ data[data > brks[length(brks)]] <- brks[length(brks)]
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1 : (length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+
+ } else {
+ grDevices::png(file, width = 7.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+ ra <- raster::raster(ncols = 720, nrows = 360)
+ range <- range(data)
+ ra[raster::cellFromXY(ra, cbind(lon, lat))] <- data
+ extent <- raster::extent(c(-180, 180, -60, 90))
+ graphics::par(bty = "n", oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0), xpd = TRUE)
+ raster::plot(ra, ext = extent, breaks = brks, col = palette, main = "",
+ legend = FALSE, axes = FALSE)
+ graphics::title(title, line = -2)
+ maps::map("world", add = TRUE, res = 0.4, lwd = 0.25, ylim = c(-60, 90))
+ graphics::legend(x = -180, y = 50, fill = palette, border = palette,
+ legend = classes, title = legendtitle)
+ grDevices::dev.off()
+}
+
+#' Plot absolute BioCol, overtime, maps, and npp into given folder
+#'
+#' Plot to file a comparison over time of global sums of BioCol, NPPpot, NPPeco,
+#' and NPPact, with legend similar to Krausmann et al. 2013
+#'
+#' @param biocol_data biocol data list object (returned from calc_biocol)
+#' containing biocol, npp_eco_overtime, npp_act_overtime, npp_pot_overtime,
+#' npp_bioenergy_overtime, biocol_overtime, npp_harv_overtime,
+#' biocol_overtime_perc_piref, biocol_perc, biocol_perc_piref, npp
+#' all in GtC
+#' @param file character string for location/file to save plot to
+#' @param first_year first year of biocol object
+#' @param plot_years range of years to plot over time
+#' @param highlight_years year(s) that should be highlighted in overtime plot
+#' (default: 2000)
+#' @param min_val y-axis minimum value for plot over time (default: 0)
+#' @param max_val y-axis maximum value for plot over time (default: 100)
+#' @param legendpos position of legend (default: "topleft")
+#' @param highlight_years year(s) that should be highlighted in overtime plot
+#' (default: 2000)
+#' @param ref reference period for biocol ("pi" or "act"), to either use
+#' biocol_data$biocol_overtime_perc_piref or biocol_data$biocol_overtime
+#' @param eps write plots as eps, instead of png (default = FALSE)
+#'
+#' @return none
+#'
+#' @export
+plot_biocol_ts <- function(
+ biocol_data,
+ file,
+ first_year,
+ plot_years,
+ highlight_years = 2000,
+ min_val = 0,
+ max_val = 100,
+ legendpos = "topleft",
+ ext = FALSE,
+ eps = FALSE,
+ ref = "pi"
+) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ last_year <- first_year + length(biocol_data$npp_act_overtime) - 1
+ colz <- c("slateblue", "gold", "green3", "darkorange", "black",
+ "red3", "green", "brown", "yellow", "turquoise",
+ "darkgreen")
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1 : (length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+
+ } else {
+ grDevices::png(file, width = 3.5, height = 3, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+
+ graphics::par(bty = "o", oma = c(0, 0, 0, 0), mar = c(4, 5, 1, 3))
+ graphics::plot(NA, ylab = "GtC/yr", xlab = "Year", xlim = plot_years,
+ ylim = c(min_val, max_val), xaxs = "i", yaxs = "i")
+ graphics::grid()
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$npp_pot_overtime,
+ type = "l",
+ col = colz[1]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$npp_act_overtime,
+ type = "l",
+ col = colz[2])
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$npp_eco_overtime,
+ type = "l",
+ col = colz[3]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$npp_luc_overtime,
+ type = "l",
+ col = colz[4]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$biocol_overtime,
+ type = "l",
+ col = colz[5]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$harvest_cft_overtime,
+ type = "l",
+ col = colz[7]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$rharvest_cft_overtime,
+ type = "l",
+ col = colz[8]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$fire_overtime,
+ type = "l", col = colz[9]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$timber_harvest_overtime,
+ type = "l",
+ col = colz[10]
+ )
+ graphics::lines(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$wood_harvest_overtime,
+ type = "l",
+ col = colz[11]
+ )
+
+ graphics::par(bty = "n", oma = c(0, 0, 0, 0), mar = c(4, 5, 1, 3), new = TRUE)
+ if (ref == "pi") {
+ graphics::plot(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$biocol_overtime_perc_piref,
+ ylab = "",
+ xlab = "",
+ xlim = plot_years,
+ ylim = c(0, 35),
+ type = "l",
+ col = colz[6],
+ xaxs = "i",
+ yaxs = "i",
+ axes = FALSE
+ )
+ } else if (ref == "act") {
+ graphics::plot(
+ x = seq(first_year, last_year, 1),
+ y = biocol_data$biocol_overtime,
+ ylab = "",
+ xlab = "",
+ xlim = plot_years,
+ ylim = c(0, 35),
+ type = "l",
+ col = colz[6],
+ xaxs = "i",
+ yaxs = "i",
+ axes = FALSE
+ )
+ }else {
+ stop(paste0("Unknown value for parameter ref: ", ref, " - Aborting."))
+ }
+
+ graphics::axis(side = 4, col = colz[6], col.axis = colz[6])
+ graphics::mtext(text = "%", col = colz[6], side = 4, line = 2)
+
+ if (!is.null(highlight_years)) {
+ for (y in highlight_years) {
+ lines(x = c(y, y), y = c(min_val, max_val), col = "grey40")
+ }
+ }
+
+ graphics::legend(
+ legendpos,
+ legend = c(
+ "NPPpot (PNV)", "NPPact (landuse)", "NPPeco", "NPPluc", "HANPP",
+ "BioCol [% NPPpi]", "harvestc", "rharvest", "firec", "timber_harvest",
+ "wood_harvest"
+ ), col = colz, lty = 1, cex = 1)
+ grDevices::dev.off()
+}
diff --git a/R/classify_biomes.R b/R/classify_biomes.R
new file mode 100755
index 0000000000000000000000000000000000000000..de4212110f3e89a8288bc1944d1b8d982e9a056f
--- /dev/null
+++ b/R/classify_biomes.R
@@ -0,0 +1,593 @@
+#' Classify biomes
+#'
+#' Classify biomes based on foliage protected cover (FPC) and temperature
+#' LPJmL output plus either vegetation carbon or pft_lai depending on
+#' the savanna_proxy option and elevation if montane_arctic_proxy requires this
+#'
+#' @param path_reference path to the reference LPJmL run. If not provided,
+#' the path is extracted from the file paths provided in files_reference.
+#' @param files_reference list with variable names and corresponding file paths
+#' (character string) of the reference LPJmL run. All needed files are
+#' provided as key value pairs, e.g.:
+#' list(leaching = "/temp/leaching.bin.json"). If not needed for the
+#' applied method, set to NULL.
+#' @param time_span_reference time span to be used for the scenario run, defined
+#' as an character string, e.g. `as.character(1901:1930)`.
+#' @param savanna_proxy `list` with either pft_lai or vegc as
+#' key and value in m2/m2 for pft_lai (default = 6) and gC/m2 for
+#' vegc (default would be 7500), Set to `NULL` if no proxy should be
+#' used.
+#' @param montane_arctic_proxy `list` with either "elevation" or "latitude" as
+#' name/key and value in m for elevation (default 1000) and degree for
+#' latitude (default would be 55), Set to `NULL` if no proxy is used.
+#' @param tree_cover_thresholds list with minimum tree cover thresholds for
+#' definition of forest, woodland, savanna and grassland. Only changes to
+#' the default have to be included in the list, for the rest the default
+#' is used.
+#' Default values, based on the IGBP land cover classification system:
+#' "boreal forest" = 0.6
+#' "temperate forest" = 0.6
+#' "temperate woodland" = 0.3
+#' "temperate savanna" = 0.1
+#' "tropical forest" = 0.6
+#' "tropical woodland" = 0.3
+#' "tropical savanna" = 0.1
+#' In the boreal zone, there is no woodland, everything below the
+#' boreal forest threshold will be classified as boreal tundra.
+#' @param avg_nyear_args list of arguments to be passed to
+#' \link[biospheremetrics]{average_nyear_window} (see for more info).
+#' To be used for time series analysis
+#' @return list object containing biome_id (main biome per grid cell [dim=c(ncells)]), # nolint
+#' and list of respective biome_names[dim=c(nbiomes)]
+#'
+#' @examples
+#' \dontrun{
+#' classify_biomes(
+#' path_data = "/p/projects/open/Fabian/runs/Gamma/output/historic_gamma"
+#' timespan = c(1982:2011))
+#' }
+#'
+#' @export
+classify_biomes <- function(path_reference = NULL,
+ files_reference = NULL,
+ time_span_reference,
+ savanna_proxy = list(pft_lai = 6),
+ montane_arctic_proxy = list(elevation = 1000),
+ tree_cover_thresholds = list(),
+ avg_nyear_args = list(), # currently a place holder
+ input_files = list(),
+ diff_output_files = list()) {
+
+ if (is.null(files_reference) && is.null(path_reference)) {
+ stop("files_reference or path_reference must be provided")
+
+ } else if (!is.null(path_reference) && is.null(files_reference)) {
+ # Get main file type (meta, clm)
+ file_ext <- get_file_ext(path_reference)
+
+ # List required output files for each boundary
+ output_files <- list_outputs("biome",
+ only_first_filename = FALSE)
+
+ files_reference <- get_filenames(
+ path = path_reference,
+ output_files = output_files,
+ diff_output_files = diff_output_files,
+ input_files = input_files,
+ file_ext = file_ext
+ )
+ }
+
+ # test if provided proxies are valid
+ savanna_proxy_name <- match.arg(
+ names(savanna_proxy),
+ c(NA, "vegc", "pft_lai")
+ )
+ montane_arctic_proxy_name <- match.arg(names(montane_arctic_proxy),
+ c(NA, "elevation", "latitude"))
+
+ # define default minimum tree cover for forest / woodland / savanna
+ min_tree_cover <- list("boreal forest" = 0.6,
+ "temperate forest" = 0.6,
+ "temperate woodland" = 0.3,
+ "temperate savanna" = 0.1,
+ "tropical forest" = 0.6,
+ "tropical woodland" = 0.3,
+ "tropical savanna" = 0.1)
+
+ # replace default values by values defined in tree_cover_thresholds
+ # parameter -> won't be applied if not specified
+ replace_idx <- match(names(tree_cover_thresholds), names(min_tree_cover))
+ if (any(is.na(replace_idx))) {
+ stop(paste0(
+ names(tree_cover_thresholds)[which(is.na(replace_idx))],
+ " is not valid. Please use a name of: ",
+ paste0(names(min_tree_cover), collapse = ", ")
+ ))
+ }
+ min_tree_cover[replace_idx] <- tree_cover_thresholds
+
+ # test if forest threshold is always > woodland threshold > savanna threshold
+ if (min_tree_cover[["temperate forest"]] <=
+ min_tree_cover[["temperate woodland"]] |
+ min_tree_cover[["temperate woodland"]] <=
+ min_tree_cover[["temperate savanna"]] |
+ min_tree_cover[["tropical woodland"]] <=
+ min_tree_cover[["tropical savanna"]] |
+ min_tree_cover[["tropical forest"]] <=
+ min_tree_cover[["tropical woodland"]]) {
+ stop(paste0("Tree cover threshold for forest are not always higher than",
+ "tree cover thresholds for woodland and savanna. Aborting."))
+ }
+ # -------------------------------------------------------------------------- #
+ # read in relevant data
+ grid <- lpjmlkit::read_io(
+ files_reference$grid,
+ silent = TRUE
+ )
+
+ lat <- lpjmlkit::as_array(grid, subset = list(band = 2)) %>%
+ drop()
+ fpc <- lpjmlkit::read_io(
+ files_reference$fpc,
+ subset = list(year = time_span_reference),
+ silent = TRUE
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array()
+
+ temp <- lpjmlkit::read_io(
+ files_reference$temp,
+ subset = list(year = time_span_reference),
+ silent = TRUE
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate =
+ list(month = sum, day = sum, band = sum)) %>%
+ suppressWarnings()
+
+ if (!is.na(savanna_proxy_name)) {
+ savanna_proxy_data <- lpjmlkit::read_io(
+ files_reference[[savanna_proxy_name]],
+ subset = list(year = time_span_reference),
+ silent = TRUE
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ suppressWarnings()
+ }
+
+ if (!is.na(montane_arctic_proxy_name)) {
+ if (montane_arctic_proxy_name == "elevation") {
+ elevation <- lpjmlkit::read_io(
+ files_reference$elevation,
+ silent = TRUE
+ )$data %>%
+ drop()
+ }
+ }
+
+ fpc_nbands <- dim(fpc)[["band"]]
+ npft <- fpc_nbands - 1
+
+ # average fpc
+ avg_fpc <- do.call(
+ average_nyear_window,
+ append(list(x = fpc),
+ avg_nyear_args)
+ )
+
+ # average vegc or pft_lai
+ if (!is.na(savanna_proxy_name)) {
+ avg_savanna_proxy_data <- drop(
+ do.call(
+ average_nyear_window,
+ append(list(x = savanna_proxy_data),
+ avg_nyear_args)
+ )
+ )
+ }
+
+ # average temp
+ # TODO understand why additional dimension is added here but not for fpc
+ # (67420, 1)
+ avg_temp <- do.call(
+ average_nyear_window,
+ append(list(x = temp), # fix_dimnames(temp, "temp", timespan, ncell, npft)),
+ avg_nyear_args)
+ )
+
+ # biome_names after biome classification in Ostberg et al. 2013
+ # (https://doi.org/10.5194/esd-4-347-2013), Ostberg et al 2015
+ # (https://doi.org/10.1088/1748-9326/10/4/044011) and Gerten et al. 2020
+ # (https://doi.org/10.1038/s41893-019-0465-1)
+
+ # biome names
+ biome_mapping <- system.file("extdata",
+ "biomes.csv",
+ package = "biospheremetrics") %>%
+ readr::read_delim(col_types = readr::cols(), delim = ";")
+ biome_names <- biome_mapping$id
+ names(biome_names) <- biome_mapping$name
+
+
+ pft_categories <- system.file("extdata",
+ "pft_categories.csv",
+ package = "biospheremetrics") %>%
+ read_pft_categories() %>%
+ dplyr::filter(., npft_proxy == npft)
+
+ fpc_names <- dplyr::filter(pft_categories, category == "natural")$pft
+ # TODO this is only required if header files without band names are read in
+ # but maybe ok to use external data here?
+ dimnames(avg_fpc)$band <- c("natural stand fraction", fpc_names)
+
+ fpc_trees <- dplyr::filter(
+ pft_categories,
+ type == "tree" & category == "natural"
+ )$pft
+
+ third_dim <- names(dim(avg_fpc))[
+ !names(dim(avg_fpc)) %in% c("cell", "band")
+ ] %>% {
+ if (rlang::is_empty(.)) NULL else .
+ }
+
+ fpc_tree_total <- apply(
+ lpjmlkit::asub(avg_fpc, band = fpc_trees),
+ c("cell", third_dim),
+ sum,
+ na.rm = TRUE
+ )
+ fpc_total <- apply(
+ lpjmlkit::asub(avg_fpc, band = -1),
+ c("cell", third_dim),
+ sum,
+ na.rm = TRUE
+ )
+ max_share_trees <- apply(
+ lpjmlkit::asub(avg_fpc, band = fpc_trees),
+ c("cell", third_dim),
+ max,
+ na.rm = TRUE
+ )
+
+ # use vegc 7500 gC/m2 or natLAI 6 as proxy threshold for forest/savanna
+ # "boundary
+ if (!is.null(savanna_proxy)) {
+ if (savanna_proxy_name == "pft_lai") {
+ avg_savanna_proxy_data <- apply(
+ lpjmlkit::asub(avg_savanna_proxy_data, band = 1:npft) * # nolint
+ lpjmlkit::asub(avg_fpc, band = 2: (npft + 1)) *
+ lpjmlkit::asub(avg_fpc, band = 1),
+ c("cell", third_dim),
+ sum
+ )
+ } else {
+ avg_savanna_proxy_data <- drop(avg_savanna_proxy_data)
+ }
+ is_tropical_proxy <- avg_savanna_proxy_data >= savanna_proxy[[savanna_proxy_name]] # nolint
+ is_savanna_proxy <- avg_savanna_proxy_data < savanna_proxy[[savanna_proxy_name]] # nolint
+ } else {
+ is_tropical_proxy <- array(TRUE,
+ dim = dim(avg_temp),
+ dimnames = dimnames(avg_temp))
+ is_savanna_proxy <- array(FALSE,
+ dim = dim(avg_temp),
+ dimnames = dimnames(avg_temp))
+ }
+
+ # Desert
+ is_desert <- {
+ fpc_total <= 0.05 &
+ avg_temp >= 0 #-2
+ }
+
+ # montane (for classification of montane grassland)
+ if (!is.na(montane_arctic_proxy_name)) {
+ if (montane_arctic_proxy_name == "elevation") {
+ is_montane_artic <- elevation > montane_arctic_proxy[[
+ montane_arctic_proxy_name
+ ]]
+ } else if (montane_arctic_proxy_name == "latitude") {
+ is_montane_artic <- !(abs(lat) > montane_arctic_proxy[[
+ montane_arctic_proxy_name
+ ]])
+ }
+ }
+
+ # FORESTS ------------------------------------------------------------------ #
+ is_boreal_forest <- {
+ fpc_tree_total >= min_tree_cover[["boreal forest"]]
+ }
+ is_temperate_forest <- {
+ fpc_tree_total >= min_tree_cover[["temperate forest"]]
+ }
+ is_tropical_forest <- {
+ fpc_tree_total >= min_tree_cover[["tropical forest"]]
+ }
+ # Boreal Evergreen
+ is_boreal_evergreen <- {
+ is_boreal_forest &
+ lpjmlkit::asub(
+ avg_fpc, band = "boreal needleleaved evergreen tree"
+ ) == max_share_trees
+ }
+
+ if (npft == 9) {
+ # Boreal Broadleaved Deciduous
+ # no simulation of boreal needleleaved summergreen trees
+ is_boreal_broad_deciduous <- {
+ is_boreal_forest &
+ (
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "boreal broadleaved summergreen tree"
+ ) == max_share_trees
+ )
+ }
+ } else {
+ # Boreal Deciduous
+ is_boreal_broad_deciduous <- {
+ is_boreal_forest &
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "boreal broadleaved summergreen tree"
+ ) == max_share_trees
+ }
+
+ is_boreal_needle_deciduous <- {
+ is_boreal_forest &
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "boreal needleleaved summergreen tree"
+ ) == max_share_trees
+ }
+ }
+
+ # Temperate Coniferous Forest
+ is_temperate_coniferous <- {
+ is_temperate_forest &
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "temperate needleleaved evergreen tree"
+ ) == max_share_trees
+ }
+ # Temperate Broadleaved Evergreen Forest
+ is_temperate_broadleaved_evergreen <- { # nolint
+ is_temperate_forest &
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "temperate broadleaved evergreen tree"
+ ) == max_share_trees
+ }
+ # Temperate Broadleaved Deciduous Forest
+ is_temperate_broadleaved_deciduous <- { # nolint
+ is_temperate_forest &
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "temperate broadleaved summergreen tree"
+ ) == max_share_trees
+ }
+
+ # Tropical Rainforest
+ is_tropical_evergreen <- {
+ is_tropical_forest &
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "tropical broadleaved evergreen tree"
+ ) == max_share_trees &
+ is_tropical_proxy
+ }
+
+ # Tropical Seasonal & Deciduous Forest
+ is_tropical_raingreen <- {
+ is_tropical_forest &
+ (lpjmlkit::asub(
+ avg_fpc,
+ band = "tropical broadleaved raingreen tree"
+ ) == max_share_trees) &
+ is_tropical_proxy
+ }
+ # Warm Woody Savanna, Woodland & Shrubland
+ is_tropical_forest_savanna <- {
+ is_tropical_forest &
+ (
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "tropical broadleaved evergreen tree"
+ ) == max_share_trees |
+ lpjmlkit::asub(
+ avg_fpc,
+ band = "tropical broadleaved raingreen tree"
+ ) == max_share_trees
+ ) &
+ is_savanna_proxy
+ }
+
+ # WOODY savanna ----------------------------------------------------------- #
+
+ # Temperate Woody Savanna, Woodland & Shrubland
+ is_temperate_woody_savanna <- {
+ fpc_tree_total <= min_tree_cover[["temperate forest"]] &
+ fpc_tree_total >= min_tree_cover[["temperate woodland"]] &
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") >
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass") &
+ avg_temp >= 0 #-2 &
+ #lat < 55
+ }
+ # Warm Woody Savanna, Woodland & Shrubland
+ is_tropical_woody_savanna <- {
+ fpc_tree_total <= min_tree_cover[["tropical forest"]] &
+ fpc_tree_total >= min_tree_cover[["tropical woodland"]] &
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") <
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass")
+ }
+
+ # OPEN SHRUBLAND / SAVANNAS ----------------------------------------------- #
+
+ # Temperate Savanna & Open Shrubland
+ is_temperate_shrubland <- {
+ fpc_tree_total <= min_tree_cover[["temperate woodland"]] &
+ fpc_tree_total >= min_tree_cover[["temperate savanna"]] &
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") >
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass") &
+ avg_temp >= 0 #-2 &
+ #lat < 55
+ }
+ # Warm Savanna & Open Shrubland
+ is_tropical_shrubland <- {
+ fpc_tree_total <= min_tree_cover[["tropical woodland"]] &
+ fpc_tree_total >= min_tree_cover[["tropical savanna"]] &
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") <
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass") &
+ avg_temp >= 0 #-2
+ }
+
+ # GRASSLAND ---------------------------------------------------------------- #
+
+ # Temperate grassland
+ is_temperate_grassland <- {
+ fpc_total > 0.05 &
+ fpc_tree_total <= min_tree_cover[["temperate savanna"]] &
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") >
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass") &
+ avg_temp >= 0 #-2 &
+ #lat < 55
+ }
+ # Warm grassland
+ is_tropical_grassland <- {
+ fpc_total > 0.05 &
+ fpc_tree_total <= min_tree_cover[["tropical savanna"]] &
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") <
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass") &
+ avg_temp >= 0 #-2
+ }
+
+ # Arctic Tundra ------------------------------------------------------------ #
+ is_arctic_tundra <- {
+ (!is_boreal_forest &
+ !is_temperate_forest &
+ (
+ avg_temp < 0 |
+ lpjmlkit::asub(avg_fpc, band = "temperate c3 grass") ==
+ lpjmlkit::asub(avg_fpc, band = "tropical c4 grass")) &
+ fpc_total > 0.05
+ ) |
+ (avg_temp < 0 & fpc_total < 0.05)
+ }
+
+ # Rocks and Ice
+ is_rocks_and_ice <- {
+ fpc_total == 0 &
+ avg_temp < 0 #-2
+ }
+ # Water body
+ is_water <- {
+ lpjmlkit::asub(avg_fpc, band = 1) == 0
+ }
+
+ # CLASSIFY BIOMES ---------------------------------------------------------- #
+
+ # initiate biome_class array
+ biome_class <- array(NA,
+ dim = c(grid$meta$ncell),
+ dimnames = dimnames(fpc_total))
+
+ biome_class[is_desert] <- biome_names["Desert"]
+
+ # forests
+ biome_class[is_boreal_evergreen] <- biome_names["Boreal Evergreen Forest"]
+ biome_class[is_boreal_broad_deciduous] <- (
+ biome_names["Boreal Broadleaved Deciduous Forest"]
+ )
+ biome_class[is_boreal_needle_deciduous] <- (
+ biome_names["Boreal Needleleaved Deciduous Forest"]
+ )
+ biome_class[is_temperate_coniferous] <- (
+ biome_names["Temperate Coniferous Forest"]
+ )
+ biome_class[is_temperate_broadleaved_evergreen] <- (
+ biome_names["Temperate Broadleaved Evergreen Forest"]
+ )
+ biome_class[is_temperate_broadleaved_deciduous] <- (
+ biome_names["Temperate Broadleaved Deciduous Forest"]
+ )
+ biome_class[is_tropical_evergreen] <- biome_names["Tropical Rainforest"]
+ biome_class[is_tropical_raingreen] <- (
+ biome_names["Tropical Seasonal & Deciduous Forest"]
+ )
+ biome_class[is_tropical_forest_savanna] <- (
+ biome_names["Warm Woody Savanna, Woodland & Shrubland"]
+ )
+
+ # woody savanna
+ biome_class[is_temperate_woody_savanna] <- (
+ biome_names["Temperate Woody Savanna, Woodland & Shrubland"]
+ )
+ biome_class[is_tropical_woody_savanna] <- (
+ biome_names["Warm Woody Savanna, Woodland & Shrubland"]
+ )
+
+ # open shrubland / savanna
+ biome_class[is_temperate_shrubland] <- (
+ biome_names["Temperate Savanna & Open Shrubland"]
+ )
+
+ biome_class[is_tropical_shrubland] <- (
+ biome_names["Warm Savanna & Open Shrubland"]
+ )
+
+ # grassland
+ biome_class[is_temperate_grassland] <- (
+ biome_names["Temperate Grassland"]
+ )
+ biome_class[is_tropical_grassland] <- biome_names["Warm Grassland"]
+
+ biome_class[is_arctic_tundra] <- biome_names["Arctic Tundra"]
+ if (!is.na(montane_arctic_proxy_name)) {
+ biome_class[
+ biome_class == biome_names["Arctic Tundra"] & is_montane_artic
+ ] <- biome_names["Montane Grassland"]
+ }
+
+ # other
+ biome_class[is_rocks_and_ice] <- biome_names["Rocks and Ice"]
+ biome_class[is_water] <- biome_names["Water"]
+
+ return(list(biome_id = biome_class, biome_names = names(biome_names)))
+}
+
+
+read_pft_categories <- function(file_path) {
+ # read_delim, col_types = readr::cols(), delim = ";")to suppress messages
+ readr::read_delim(file_path, col_types = readr::cols(), delim = ";") %>%
+ # change 1, 0.5, 0 values to TRUE and NAs (NA's can be dropped)
+ dplyr::mutate_at(dplyr::vars(dplyr::starts_with(c("category_", "zone_"))),
+ function(x) ifelse(as.logical(x), TRUE, NA)) %>%
+ # filter natural pfts
+ dplyr::filter(category_natural) %>%
+ # all binary zone columns (tropical, temperate, boreal) in one categorical
+ # zone column
+ tidyr::pivot_longer(cols = starts_with("zone_"),
+ names_to = "zone",
+ names_prefix = "zone_",
+ values_to = "zone_value",
+ values_drop_na = TRUE) %>%
+ # all binary category columns (natural, needle, evergreen) in one categorical # nolint
+ # category column
+ tidyr::pivot_longer(cols = starts_with("category_"),
+ names_to = "category",
+ names_prefix = "category_",
+ values_to = "category_value",
+ values_drop_na = TRUE) %>%
+ # delete side product - logical columns
+ dplyr::select(-c("category_value", "zone_value")) %>%
+ # values to lpjml_index, names to length of npft (convert to numeric)
+ tidyr::pivot_longer(cols = starts_with("lpjml_index_npft_"),
+ values_to = "lpjml_index",
+ names_to = "npft_proxy",
+ names_transform = list(npft_proxy = function(x) suppressWarnings(as.numeric(x))), # nolint
+ names_prefix = "lpjml_index_npft_") %>%
+ return()
+}
\ No newline at end of file
diff --git a/R/ecorisk.R b/R/ecorisk.R
new file mode 100755
index 0000000000000000000000000000000000000000..092dc50055ae243e1f85cefbdc559e9a73f4268c
--- /dev/null
+++ b/R/ecorisk.R
@@ -0,0 +1,3957 @@
+# written by Fabian Stenzel, based on work by Sebastian Ostberg
+# 2022-2023 - stenzel@pik-potsdam.de
+
+################# EcoRisk calc functions ###################
+
+#' Wrapper for calculating the ecosystem change metric EcoRisk
+#'
+#' Function to read in data for ecorisk, and call the calculation function once,
+#' if overtime is FALSE, or for each timeslice of length window years, if
+#' overtime is TRUE
+#'
+#' @param path_ref folder of reference run
+#' @param path_scen folder of scenario run
+#' @param read_saved_data whether to read in previously saved data
+#' (default: FALSE)
+#' @param save_data file to save read in data to (default NULL)
+#' @param save_ecorisk file to save EcoRisk data to (default NULL)
+#' @param nitrogen include nitrogen outputs for pools and fluxes into EcoRisk
+#' calculation (default FALSE)
+#' @param weighting apply "old" (Ostberg-like), "new", or "equal" weighting of
+#' vegetation_structure_change weights (default "equal")
+#' @param varnames data.frame with names of output files (outname) and time res.
+#' (timestep) -- can be specified to account for variable file names
+#' (default NULL -- standard names as below)
+#' @param time_span_reference vector of years to use as scenario period
+#' @param time_span_scenario vector of years to use as scenario period
+#' @param dimensions_only_local flag whether to use only local change component
+#' for water/carbon/nitrogen fluxes and pools, or use an average of
+#' local change, global change and ecosystem balance (default FALSE)
+#' @param overtime logical: calculate ecorisk as time-series? (default: FALSE)
+#' @param window integer, number of years for window length (default: 30)
+#' @param debug write out all nitrogen state variables (default FALSE)
+#'
+#' @return list data object containing arrays of ecorisk_total,
+#' vegetation_structure_change, local_change, global_importance,
+#' ecosystem_balance, carbon_stocks, carbon_fluxes, water_fluxes
+#' (+ nitrogen_stocks and nitrogen_fluxes)
+#'
+#' @export
+ecorisk_wrapper <- function(path_ref,
+ path_scen,
+ read_saved_data = FALSE,
+ save_data = NULL,
+ save_ecorisk = NULL,
+ nitrogen = TRUE,
+ weighting = "equal",
+ varnames = NULL,
+ time_span_reference,
+ time_span_scenario,
+ dimensions_only_local = FALSE,
+ overtime = FALSE,
+ window = 30,
+ debug = FALSE) {
+ if (is.null(varnames)) {
+ print("variable name list not provided, using standard list, which might
+ not be applicable for this case ...")
+ varnames <- data.frame(
+ row.names = c(
+ "grid", "fpc", "fpc_bft", "cftfrac", "firec", "rh_harvest", "npp",
+ "evapinterc", "runoff", "transp", "soillitc", "vegc", "swcsum", "firef",
+ "rh", "harvestc", "rharvestc", "pft_harvestc", "pft_rharvestc", "evap",
+ "interc", "discharge", "soilc", "litc", "swc", "vegn", "soilnh4",
+ "soilno3", "leaching", "n2o_denit", "n2o_nit", "n2o_denit", "n2_emis",
+ "bnf", "n_volatilization"
+ ),
+ outname = c(
+ "grid.bin", "fpc.bin", "fpc_bft.bin", "cftfrac.bin", "firec.bin",
+ "rh_harvest.bin", "npp.bin", "evapinterc.bin", "runoff.bin",
+ "transp.bin", "soillitc.bin", "vegc.bin", "swcsum.bin", "firef.bin",
+ "rh.bin", "flux_harvest.bin", "flux_rharvest.bin",
+ "pft_harvest.pft.bin", "pft_rharvest.pft.bin", "evap.bin", "interc.bin",
+ "discharge.bin", "soilc.bin", "litc.bin", "swc.bin", "vegn.bin",
+ "soilnh4.bin", "soilno3.bin", "leaching.bin", "n2o_denit.bin",
+ "n2o_nit.bin", "n2o_denit.bin", "n2_emis.bin", "bnf.bin",
+ "n_volatilization.bin"
+ ),
+ timestep = c(
+ "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y",
+ "Y", "Y", "Y", "Y", "Y", "Y", "Y", , "Y", "Y", "Y", "Y", , "Y", "Y",
+ "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y"
+ )
+ )
+ }
+
+ nyears <- length(time_span_reference)
+ nyears_scen <- length(time_span_scenario)
+ if (nyears < 30 || nyears_scen < 30) {
+ stop("Warning: timespan in reference or scenario is smaller than 30 years.")
+ }
+ # translate varnames and folders to files_scenarios/reference lists
+ files_scenario <- list(
+ grid = paste0(path_scen, varnames["grid", "outname"]),
+ fpc = paste0(path_scen, varnames["fpc", "outname"]),
+ fpc_bft = paste0(path_scen, varnames["fpc_bft", "outname"]),
+ cftfrac = paste0(path_scen, varnames["cftfrac", "outname"]),
+ firec = paste0(path_scen, varnames["firec", "outname"]),
+ npp = paste0(path_scen, varnames["npp", "outname"]),
+ runoff = paste0(path_scen, varnames["runoff", "outname"]),
+ transp = paste0(path_scen, varnames["transp", "outname"]),
+ vegc = paste0(path_scen, varnames["vegc", "outname"]),
+ firef = paste0(path_scen, varnames["firef", "outname"]),
+ rh = paste0(path_scen, varnames["rh", "outname"]),
+ harvestc = paste0(path_scen, varnames["harvestc", "outname"]),
+ rharvestc = paste0(path_scen, varnames["rharvestc", "outname"]),
+ pft_harvestc = paste0(path_scen, varnames["pft_harvest", "outname"]),
+ pft_rharvestc = paste0(path_scen, varnames["pft_rharvest", "outname"]),
+ evap = paste0(path_scen, varnames["evap", "outname"]),
+ interc = paste0(path_scen, varnames["interc", "outname"]),
+ discharge = paste0(path_scen, varnames["discharge", "outname"]),
+ soilc = paste0(path_scen, varnames["soilc", "outname"]),
+ litc = paste0(path_scen, varnames["litc", "outname"]),
+ swc = paste0(path_scen, varnames["swc", "outname"]),
+ vegn = paste0(path_scen, varnames["vegn", "outname"]),
+ soilnh4 = paste0(path_scen, varnames["soilnh4", "outname"]),
+ soilno3 = paste0(path_scen, varnames["soilno3", "outname"]),
+ leaching = paste0(path_scen, varnames["leaching", "outname"]),
+ n2o_denit = paste0(path_scen, varnames["n2o_denit", "outname"]),
+ n2o_nit = paste0(path_scen, varnames["n2o_nit", "outname"]),
+ n2_emis = paste0(path_scen, varnames["n2_emis", "outname"]),
+ bnf = paste0(path_scen, varnames["bnf", "outname"]),
+ n_volatilization = paste0(path_scen, varnames["n_volatilization", "outname"])
+ )
+ files_reference <- list(
+ grid = paste0(path_ref, varnames["grid", "outname"]),
+ fpc = paste0(path_ref, varnames["fpc", "outname"]),
+ fpc_bft = paste0(path_ref, varnames["fpc_bft", "outname"]),
+ cftfrac = paste0(path_ref, varnames["cftfrac", "outname"]),
+ firec = paste0(path_ref, varnames["firec", "outname"]),
+ npp = paste0(path_ref, varnames["npp", "outname"]),
+ runoff = paste0(path_ref, varnames["runoff", "outname"]),
+ transp = paste0(path_ref, varnames["transp", "outname"]),
+ vegc = paste0(path_ref, varnames["vegc", "outname"]),
+ firef = paste0(path_ref, varnames["firef", "outname"]),
+ rh = paste0(path_ref, varnames["rh", "outname"]),
+ harvestc = paste0(path_ref, varnames["harvestc", "outname"]),
+ rharvestc = paste0(path_ref, varnames["rharvestc", "outname"]),
+ pft_harvestc = paste0(path_ref, varnames["pft_harvest", "outname"]),
+ pft_rharvestc = paste0(path_ref, varnames["pft_rharvest", "outname"]),
+ evap = paste0(path_ref, varnames["evap", "outname"]),
+ interc = paste0(path_ref, varnames["interc", "outname"]),
+ discharge = paste0(path_ref, varnames["discharge", "outname"]),
+ soilc = paste0(path_ref, varnames["soilc", "outname"]),
+ litc = paste0(path_ref, varnames["litc", "outname"]),
+ swc = paste0(path_ref, varnames["swc", "outname"]),
+ vegn = paste0(path_ref, varnames["vegn", "outname"]),
+ soilnh4 = paste0(path_ref, varnames["soilnh4", "outname"]),
+ soilno3 = paste0(path_ref, varnames["soilno3", "outname"]),
+ leaching = paste0(path_ref, varnames["leaching", "outname"]),
+ n2o_denit = paste0(path_ref, varnames["n2o_denit", "outname"]),
+ n2o_nit = paste0(path_ref, varnames["n2o_nit", "outname"]),
+ n2_emis = paste0(path_ref, varnames["n2_emis", "outname"]),
+ bnf = paste0(path_ref, varnames["bnf", "outname"]),
+ n_volatilization = paste0(path_ref, varnames["n_volatilization", "outname"])
+ )
+
+ if (overtime && window != nyears) stop("Overtime is enabled, but window \
+ length (", window, ") does not match the reference nyears.")
+
+ if (read_saved_data) {
+ if (!is.null(save_data)) {
+ print(paste("Loading saved data from:", save_data))
+ load(file = save_data)
+ } else {
+ stop("save_data is not specified as parameter, ",
+ "nothing to load ... exiting")
+ }
+ } else {
+ # first read in all lpjml output files required for computing EcoRisk
+ returned_vars <- read_ecorisk_data(
+ files_reference = files_reference,
+ files_scenario = files_scenario,
+ save_file = save_data,
+ export = FALSE,
+ nitrogen = nitrogen,
+ time_span_reference = time_span_reference,
+ time_span_scenario = time_span_scenario,
+ debug = debug
+ )
+ # extract variables from return list object and give them proper names
+ state_ref <- returned_vars$state_ref
+ state_scen <- returned_vars$state_scen
+ fpc_ref <- returned_vars$fpc_ref
+ fpc_scen <- returned_vars$fpc_scen
+ bft_ref <- returned_vars$bft_ref
+ bft_scen <- returned_vars$bft_scen
+ cft_ref <- returned_vars$cft_ref
+ cft_scen <- returned_vars$cft_scen
+ lat <- returned_vars$lat
+ lon <- returned_vars$lon
+ cell_area <- returned_vars$cell_area
+ rm(returned_vars)
+ }
+
+ ncells <- length(cell_area)
+ slices <- (nyears_scen - window + 1)
+ ecorisk <- list(
+ ecorisk_total = array(0, dim = c(ncells, slices)),
+ vegetation_structure_change = array(0, dim = c(ncells, slices)),
+ local_change = array(0, dim = c(ncells, slices)),
+ global_importance = array(0, dim = c(ncells, slices)),
+ ecosystem_balance = array(0, dim = c(ncells, slices)),
+ carbon_stocks = array(0, dim = c(ncells, slices)),
+ carbon_fluxes = array(0, dim = c(ncells, slices)),
+ water_stocks = array(0, dim = c(ncells, slices)),
+ water_fluxes = array(0, dim = c(ncells, slices)),
+ nitrogen_stocks = array(0, dim = c(ncells, slices)),
+ nitrogen_fluxes = array(0, dim = c(ncells, slices))
+ )
+ for (y in 1:slices) {
+ print(paste0("Calculating time slice ", y, " of ", slices))
+ returned <- calc_ecorisk(
+ fpc_ref = fpc_ref,
+ fpc_scen = fpc_scen[, , y:(y + window - 1)],
+ bft_ref = bft_ref,
+ bft_scen = bft_scen[, , y:(y + window - 1)],
+ cft_ref = cft_ref,
+ cft_scen = cft_scen[, , y:(y + window - 1)],
+ state_ref = state_ref,
+ state_scen = state_scen[, y:(y + window - 1), ],
+ weighting = weighting,
+ lat = lat,
+ lon = lon,
+ cell_area = cell_area,
+ dimensions_only_local = dimensions_only_local,
+ nitrogen = nitrogen
+ )
+ ecorisk$ecorisk_total[, y] <- returned$ecorisk_total
+ ecorisk$vegetation_structure_change[, y] <- (
+ returned$vegetation_structure_change
+ )
+ ecorisk$local_change[, y] <- returned$local_change
+ ecorisk$global_importance[, y] <- returned$global_importance
+ ecorisk$ecosystem_balance[, y] <- returned$ecosystem_balance
+ ecorisk$carbon_stocks[, y] <- returned$carbon_stocks
+ ecorisk$carbon_fluxes[, y] <- returned$carbon_fluxes
+ ecorisk$water_stocks[, y] <- returned$water_stocks
+ ecorisk$water_fluxes[, y] <- returned$water_fluxes
+ if (nitrogen) {
+ ecorisk$nitrogen_stocks[, y] <- returned$nitrogen_stocks
+ ecorisk$nitrogen_fluxes[, y] <- returned$nitrogen_fluxes
+ }
+ }
+
+
+ ############## export and save data if requested #############
+ if (!(is.null(save_ecorisk))) {
+ print(paste0("Saving EcoRisk data to: ", save_ecorisk))
+ save(ecorisk, file = save_ecorisk)
+ }
+ #
+ ###
+ return(ecorisk)
+}
+
+#' Calculate the ecosystem change metric EcoRisk between 2 sets of states
+#'
+#' Function to calculate the ecosystem change metric EcoRisk, based on
+#' gamma/vegetation_structure_change
+#' work from Sykes (1999), Heyder (2011), and Ostberg (2015,2018).
+#' This is a reformulated version in R, not producing 100% similar values
+#' than the C/bash version from Ostberg et al. 2018, but similar the methodology
+#'
+#' @param fpc_ref reference run data for fpc
+#' @param fpc_scen scenario run data for fpc
+#' @param bft_ref reference run data for fpc_bft
+#' @param bft_scen scenario run data for fpc_bft
+#' @param cft_ref reference run data for cftfrac
+#' @param cft_scen scenario run data for cftfrac
+#' @param state_ref reference run data for state variables
+#' @param state_scen scenario run data for state variables
+#' @param weighting apply "old" (Ostberg-like), "new", or "equal" weighting of
+#' vegetation_structure_change weights (default "equal")
+#' @param lat latitude array
+#' @param lon longitude array
+#' @param cell_area cellarea array
+#' @param dimensions_only_local flag whether to use only local change component
+#' for water/carbon/nitrogen fluxes and pools, or use an average of
+#' local change, global change and ecosystem balance (default FALSE)
+#' @param nitrogen include nitrogen outputs (default: TRUE)
+#'
+#' @return list data object containing arrays of ecorisk_total,
+#' vegetation_structure_change, local_change, global_importance,
+#' ecosystem_balance, carbon_stocks, carbon_fluxes, water_fluxes
+#' (+ nitrogen_stocks and nitrogen_fluxes)
+#'
+#' @export
+calc_ecorisk <- function(fpc_ref,
+ fpc_scen,
+ bft_ref,
+ bft_scen,
+ cft_ref,
+ cft_scen,
+ state_ref,
+ state_scen,
+ weighting = "equal",
+ lat,
+ lon,
+ cell_area,
+ dimensions_only_local = FALSE,
+ nitrogen = TRUE) {
+ di_ref <- dim(fpc_ref)
+ di_scen <- dim(fpc_scen)
+ ncells <- di_ref[1]
+ nyears <- di_ref[3]
+ if (di_ref[3] != di_scen[3]) {
+ stop("Dimension year does not match between fpc_scen and fpc_ref.")
+ }
+ # calc vegetation_structure_change and variability of
+ # vegetation_structure_change within
+ # reference period S(vegetation_structure_change,
+ # sigma_vegetation_structure_change)
+ fpc_ref_mean <- apply(fpc_ref, c(1, 2), mean)
+ bft_ref_mean <- apply(bft_ref, c(1, 2), mean)
+ cft_ref_mean <- apply(cft_ref, c(1, 2), mean)
+
+
+ sigma_vegetation_structure_change_ref_list <- array(
+ 0, dim = c(ncells, nyears)
+ )
+ # calculate for every year of the reference period,
+ # vegetation_structure_change between that year and the average reference
+ # period year
+ # this gives the variability of vegetation_structure_change within the
+ # reference period
+ for (y in 1:nyears) {
+ sigma_vegetation_structure_change_ref_list[, y] <- calc_delta_v( # nolint
+ fpc_ref = fpc_ref_mean,
+ fpc_scen = fpc_ref[, , y],
+ bft_ref = bft_ref_mean,
+ bft_scen = bft_ref[, , y],
+ cft_ref = cft_ref_mean,
+ cft_scen = cft_ref[, , y],
+ weighting = weighting
+ )
+ }
+
+ # calculate the std deviation over the reference period for each gridcell
+ vegetation_structure_changesd <- apply(
+ sigma_vegetation_structure_change_ref_list,
+ c(1),
+ stats::sd
+ )
+
+ # calculate vegetation_structure_change between average reference and average
+ # scenario period
+ vegetation_structure_change <- calc_delta_v(
+ fpc_ref = fpc_ref_mean,
+ fpc_scen = apply(fpc_scen, c(1, 2), mean),
+ bft_ref = bft_ref_mean,
+ bft_scen = apply(bft_scen, c(1, 2), mean),
+ cft_ref = cft_ref_mean,
+ cft_scen = apply(cft_scen, c(1, 2), mean),
+ weighting = weighting
+ )
+ #
+ ####
+ ############## calc EcoRisk components ################
+ # variable names for the state vector
+ # 1:3 carbon fluxes
+ # 4:6 water fluxes
+ # 7:8 carbon pools/stocks,
+ # 9:10 water pools
+ # 11 additional variables for global/local difference, but not included in
+ # stocks/fluxes
+ # 12:13 nitrogen pools/stocks
+ # 14:16 nitrogen fluxes
+
+ delta <- vegetation_structure_change * s_change_to_var_ratio(
+ vegetation_structure_change,
+ vegetation_structure_changesd
+ ) # vegetation_structure_change
+
+ lc <- calc_component(
+ ref = state_ref,
+ scen = state_scen,
+ local = TRUE,
+ cell_area = cell_area
+ ) # local change
+
+ gi <- calc_component(
+ ref = state_ref,
+ scen = state_scen,
+ local = FALSE,
+ cell_area = cell_area
+ ) # global importance
+
+ eb <- calc_ecosystem_balance(
+ ref = state_ref,
+ scen = state_scen
+ ) # ecosystem balance
+
+ if (dimensions_only_local == TRUE) {
+
+ # carbon fluxes (local change)
+ cf <- calc_component(
+ ref = state_ref[, , 1:3],
+ scen = state_scen[, , 1:3],
+ local = TRUE,
+ cell_area = cell_area)
+
+ # carbon stocks (local change)
+ cs <- calc_component(
+ ref = state_ref[, , 7:8],
+ scen = state_scen[, , 7:8],
+ local = TRUE,
+ cell_area = cell_area
+ )
+
+ # water fluxes (local change)
+ wf <- calc_component(
+ ref = state_ref[, , 4:6],
+ scen = state_scen[, , 4:6],
+ local = TRUE,
+ cell_area = cell_area
+ )
+
+ # water pools (local change)
+ ws <- calc_component(
+ ref = state_ref[, , 9:10],
+ scen = state_scen[, , 9:10],
+ local = TRUE,
+ cell_area = cell_area
+ )
+
+ # nitrogen stocks (local change)
+ if (nitrogen) {
+ ns <- calc_component(
+ ref = state_ref[, , 12:13],
+ scen = state_scen[, , 12:13],
+ local = TRUE,
+ cell_area = cell_area
+ )
+
+ # nitrogen fluxes (local change)
+ nf <- calc_component(
+ ref = state_ref[, , 14:16],
+ scen = state_scen[, , 14:16],
+ local = TRUE,
+ cell_area = cell_area
+ )
+ }
+
+ } else {
+ cf <- (
+ calc_component(
+ ref = state_ref[, , 1:3],
+ scen = state_scen[, , 1:3],
+ local = TRUE,
+ cell_area = cell_area
+ ) + # carbon fluxes
+ calc_component(
+ ref = state_ref[, , 1:3],
+ scen = state_scen[, , 1:3],
+ local = FALSE,
+ cell_area = cell_area
+ ) +
+ calc_ecosystem_balance(
+ ref = state_ref[, , 1:3],
+ scen = state_scen[, , 1:3]
+ )
+ ) / 3
+
+ # carbon stocks
+ cs <- (
+ calc_component(
+ ref = state_ref[, , 7:8],
+ scen = state_scen[, , 7:8],
+ local = TRUE,
+ cell_area = cell_area
+ ) +
+ calc_component(
+ ref = state_ref[, , 7:8],
+ scen = state_scen[, , 7:8],
+ local = FALSE,
+ cell_area = cell_area
+ ) +
+ calc_ecosystem_balance(
+ ref = state_ref[, , 7:8],
+ scen = state_scen[, , 7:8]
+ )
+ ) / 3
+
+ # water fluxes
+ wf <- (
+ calc_component(
+ ref = state_ref[, , 4:6],
+ scen = state_scen[, , 4:6],
+ local = TRUE,
+ cell_area = cell_area
+ ) +
+ calc_component(
+ ref = state_ref[, , 4:6],
+ scen = state_scen[, , 4:6],
+ local = FALSE,
+ cell_area = cell_area
+ ) + calc_ecosystem_balance(
+ ref = state_ref[, , 4:6],
+ scen = state_scen[, , 4:6]
+ )
+ ) / 3
+
+ # water pools
+ ws <- (
+ calc_component(
+ ref = state_ref[, , 9:10],
+ scen = state_scen[, , 9:10],
+ local = TRUE,
+ cell_area = cell_area
+ ) +
+ calc_component(
+ ref = state_ref[, , 9:10],
+ scen = state_scen[, , 9:10],
+ local = FALSE,
+ cell_area = cell_area
+ ) +
+ calc_ecosystem_balance(
+ ref = state_ref[, , 9:10],
+ scen = state_scen[, , 9:10]
+ )
+ ) / 3
+
+ if (nitrogen) {
+
+ # nitrogen stocks (local change)
+ ns <- (
+ calc_component(
+ ref = state_ref[, , 12:13],
+ scen = state_scen[, , 12:13],
+ local = TRUE,
+ cell_area = cell_area
+ ) +
+ calc_component(
+ ref = state_ref[, , 12:13],
+ scen = state_scen[, , 12:13],
+ local = FALSE, cell_area = cell_area
+ ) +
+ calc_ecosystem_balance(
+ ref = state_ref[, , 12:13],
+ scen = state_scen[, , 12:13]
+ )
+ ) / 3
+
+ # nitrogen fluxes (local change)
+ nf <- (
+ calc_component(
+ ref = state_ref[, , 14:16],
+ scen = state_scen[, , 14:16],
+ local = TRUE,
+ cell_area = cell_area
+ ) +
+ calc_component(
+ ref = state_ref[, , 14:16],
+ scen = state_scen[, , 14:16],
+ local = FALSE,
+ cell_area = cell_area
+ ) +
+ calc_ecosystem_balance(
+ ref = state_ref[, , 14:16],
+ scen = state_scen[, , 14:16]
+ )
+ ) / 3
+ }
+ }
+
+ # calc total EcoRisk as the average of the 4 components
+ ecorisk_full <- (delta + lc + gi + eb) / 4 # check for NAs
+
+ if (nitrogen) {
+ ecorisk <- list(
+ ecorisk_total = ecorisk_full,
+ vegetation_structure_change = delta,
+ local_change = lc,
+ global_importance = gi,
+ ecosystem_balance = eb,
+ carbon_stocks = cs,
+ carbon_fluxes = cf,
+ water_fluxes = wf,
+ water_stocks = ws,
+ nitrogen_stocks = ns,
+ nitrogen_fluxes = nf
+ )
+
+ } else {
+ ecorisk <- list(
+ ecorisk_total = ecorisk_full,
+ vegetation_structure_change = delta,
+ local_change = lc,
+ global_importance = gi,
+ ecosystem_balance = eb,
+ carbon_stocks = cs,
+ carbon_fluxes = cf,
+ water_fluxes = wf,
+ water_stocks = ws
+ )
+ }
+ ###
+ return(ecorisk)
+}
+
+#' Read in output data from LPJmL to calculate the ecosystem change metric
+#' EcoRisk
+#'
+#' Utility function to read in output data from LPJmL for calculation of EcoRisk
+#'
+#' @param files_reference folder of reference run
+#' @param files_scenario folder of scenario run
+#' @param save_file file to save read in data to (default NULL)
+#' @param export flag whether to export réad in data to global environment
+#' (default FALSE)
+#' @param time_span_reference vector of years to use as scenario period
+#' @param time_span_scenario vector of years to use as scenario period
+#' @param nitrogen include nitrogen outputs for pools and fluxes into EcoRisk
+#' calculation (default FALSE)
+#' @param debug write out all nitrogen state variables (default FALSE)
+#'
+#' @return list data object containing arrays of state_ref, mean_state_ref,
+#' state_scen, mean_state_scen, fpc_ref, fpc_scen, bft_ref, bft_scen,
+#' cft_ref, cft_scen, lat, lon, cell_area
+#'
+#' @export
+read_ecorisk_data <- function(files_reference, # nolint
+ files_scenario,
+ save_file = NULL,
+ export = FALSE,
+ time_span_reference,
+ time_span_scenario,
+ nitrogen,
+ debug = FALSE) {
+ file_type <- tools::file_ext(files_reference$grid)
+
+ if (file_type %in% c("json", "clm")) {
+ # read grid
+ grid <- lpjmlkit::read_io(
+ files_reference$grid,
+ )
+ # calculate cell area
+ cell_area <- lpjmlkit::calc_cellarea(grid)
+ lat <- grid$data[, , 2]
+ lon <- grid$data[, , 1]
+
+ ### read in lpjml output
+ # for vegetation_structure_change (fpc,fpc_bft,cftfrac)
+ print("Reading in fpc, fpc_bft, cftfrac")
+
+ cft_scen <- aperm(lpjmlkit::read_io(
+ files_scenario$cftfrac,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)), c(1, 3, 2))
+
+ bft_scen <- aperm(lpjmlkit::read_io(
+ files_scenario$fpc_bft,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)), c(1, 3, 2))
+
+ fpc_scen <- aperm(lpjmlkit::read_io(
+ files_scenario$fpc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)), c(1, 3, 2))
+
+ if (file.exists(files_reference$cftfrac)) {
+ cft_ref <- aperm(lpjmlkit::read_io(
+ files_reference$cftfrac,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)), c(1, 3, 2))
+ } else {
+ cft_ref <- cft_scen * 0
+ }
+
+ if (file.exists(files_reference$fpc_bft)) {
+ bft_ref <- aperm(lpjmlkit::read_io(
+ files_reference$fpc_bft,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)), c(1, 3, 2))
+ } else {
+ bft_ref <- bft_scen * 0
+ }
+
+ fpc_ref <- aperm(lpjmlkit::read_io(
+ files_reference$fpc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)), c(1, 3, 2))
+
+ # cffiles = ( firec rh_harvest npp ) yearly carbon fluxes
+ print("Reading in firec, rh_harvest, npp")
+
+ rh_scen <- lpjmlkit::read_io(
+ files_scenario$rh,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ if (file.exists(files_scenario$harvestc)) {
+ harvest_scen <- lpjmlkit::read_io(
+ files_scenario$harvestc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ } else if (file.exists(files_scenario$pft_harvestc)) {
+ harvest_scen <- lpjmlkit::read_io(
+ files_scenario$pft_harvestc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum, band = sum)) %>%
+ drop()
+
+ } else {
+ stop("Missing harvestc output in scenario folder.")
+ }
+
+ if (file.exists(files_scenario$rharvestc)) {
+ rharvest_scen <- lpjmlkit::read_io(
+ files_scenario$rharvestc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ } else if (file.exists(files_scenario$pft_rharvestc)) {
+ rharvest_scen <- lpjmlkit::read_io(
+ files_scenario$pft_rharvestc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum, band = sum)) %>%
+ drop()
+
+ } else {
+ stop("Missing rharvestc output in scenario folder.")
+ }
+
+ rh_harvest_scen <- rh_scen + harvest_scen + rharvest_scen
+
+ firec_scen <- lpjmlkit::read_io(
+ files_scenario$firec,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ npp_scen <- lpjmlkit::read_io(
+ files_scenario$npp,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ rh_ref <- lpjmlkit::read_io(
+ files_reference$rh,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ if (file.exists(files_reference$harvestc)) {
+ harvest_ref <- lpjmlkit::read_io(
+ files_reference$harvestc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ } else if (file.exists(files_reference$pft_harvestc)) {
+ harvest_ref <- lpjmlkit::read_io(
+ files_reference$pft_harvestc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum, band = sum)) %>%
+ drop()
+
+ } else {
+ print("No harvest output available for reference period, setting to 0.")
+ harvest_ref <- harvest_scen * 0
+ }
+
+ if (file.exists(files_reference$rharvestc)) {
+ rharvest_ref <- lpjmlkit::read_io(
+ files_reference$rharvestc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ } else if (file.exists(files_reference$pft_rharvestc)) {
+ rharvest_ref <- lpjmlkit::read_io(
+ files_reference$pft_rharvestc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum, band = sum)) %>%
+ drop()
+
+ } else {
+ print("No rharvest output available for reference period, setting to 0.")
+ rharvest_ref <- rharvest_scen * 0
+ }
+
+ rh_harvest_ref <- rh_ref + harvest_ref + rharvest_ref
+
+ firec_ref <- lpjmlkit::read_io(
+ files_reference$firec,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ npp_ref <- lpjmlkit::read_io(
+ files_reference$npp,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # wffiles = (evapinterc runoff transp) - yearly water fluxes
+ print("Reading in evapinterc, runoff, transp")
+
+ evap_ref <- lpjmlkit::read_io(
+ files_reference$evap,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ interc_ref <- lpjmlkit::read_io(
+ files_reference$interc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ evapinterc_ref <- evap_ref + interc_ref
+
+ runoff_ref <- lpjmlkit::read_io(
+ files_reference$runoff,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ transp_ref <- lpjmlkit::read_io(
+ files_reference$transp,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ evap_scen <- lpjmlkit::read_io(
+ files_scenario$evap,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ interc_scen <- lpjmlkit::read_io(
+ files_scenario$interc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ evapinterc_scen <- evap_scen + interc_scen
+
+ runoff_scen <- lpjmlkit::read_io(
+ files_scenario$runoff,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ transp_scen <- lpjmlkit::read_io(
+ files_scenario$transp,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # csfiles = ( soillitc vegc_avg ) #carbon pools
+ print("Reading in soillitc, vegc")
+
+ soil_ref <- lpjmlkit::read_io(
+ files_reference$soilc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ litc_ref <- lpjmlkit::read_io(
+ files_reference$litc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ soillitc_ref <- soil_ref + litc_ref
+
+ vegc_ref <- lpjmlkit::read_io(
+ files_reference$vegc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ soil_scen <- lpjmlkit::read_io(
+ files_scenario$soilc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ litc_scen <- lpjmlkit::read_io(
+ files_scenario$litc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ soillitc_scen <- soil_scen + litc_scen
+
+ vegc_scen <- lpjmlkit::read_io(
+ files_scenario$vegc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # water pools = (swcsum discharge)
+ print("Reading in swcsum, discharge")
+ swcsum_ref <- lpjmlkit::read_io(
+ files_reference$swc,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum, band = sum)) %>%
+ drop()
+
+ swcsum_scen <- lpjmlkit::read_io(
+ files_scenario$swc,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum, band = sum)) %>%
+ drop()
+
+ discharge_ref <- lpjmlkit::read_io(
+ files_reference$discharge,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ discharge_scen <- lpjmlkit::read_io(
+ files_scenario$discharge,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ print("Reading in firef")
+
+ firef_ref <- lpjmlkit::read_io(
+ files_reference$firef,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ firef_scen <- lpjmlkit::read_io(
+ files_scenario$firef,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+
+ # nitrogen variables
+ if (nitrogen) {
+ print(
+ paste0(
+ "Reading in n-pools: soilnh4, soilno3 + fluxes: leaching, bnf, ",
+ "n_volatilization, n2o_nit, n2o_denit n2_emis"
+ )
+ )
+
+ # reference state
+ # pools: soilnh4, soilno3
+ soilnh4_ref <- lpjmlkit::read_io(
+ files_reference$soilnh4,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ soilno3_ref <- lpjmlkit::read_io(
+ files_reference$soilno3,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ vegn_ref <- lpjmlkit::read_io(
+ files_reference$vegn,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # fluxes: leaching, n2o_nit, n2o_denit n2_emis, bnf, n_volatilization
+ leaching_ref <- lpjmlkit::read_io(
+ files_reference$leaching,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n2o_denit_ref <- lpjmlkit::read_io(
+ files_reference$n2o_denit,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n2o_nit_ref <- lpjmlkit::read_io(
+ files_reference$n2o_nit,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n2_emis_ref <- lpjmlkit::read_io(
+ files_reference$n2_emis,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ bnf_ref <- lpjmlkit::read_io(
+ files_reference$bnf,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n_volatilization_ref <- lpjmlkit::read_io(
+ files_reference$n_volatilization,
+ subset = list(year = as.character(time_span_reference))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # Calculating compound n emissions vector
+ aggregated_n_emissions_ref <- (
+ n_volatilization_ref + n2o_nit_ref + n2o_denit_ref + n2_emis_ref
+ )
+ soiln_ref <- soilno3_ref + soilnh4_ref
+
+ # scenario state
+ # pools: soilnh4, soilno3
+ soilnh4_scen <- lpjmlkit::read_io(
+ files_scenario$soilnh4,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ soilno3_scen <- lpjmlkit::read_io(
+ files_scenario$soilno3,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ vegn_scen <- lpjmlkit::read_io(
+ files_scenario$vegn,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # fluxes: leaching, n2o_nit, n2o_denit n2_emis, bnf, n_volatilization
+ leaching_scen <- lpjmlkit::read_io(
+ files_scenario$leaching,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n2o_denit_scen <- lpjmlkit::read_io(
+ files_scenario$n2o_denit,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n2o_nit_scen <- lpjmlkit::read_io(
+ files_scenario$n2o_nit,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n2_emis_scen <- lpjmlkit::read_io(
+ files_scenario$n2_emis,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ bnf_scen <- lpjmlkit::read_io(
+ files_scenario$bnf,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ n_volatilization_scen <- lpjmlkit::read_io(
+ files_scenario$n_volatilization,
+ subset = list(year = as.character(time_span_scenario))
+ ) %>%
+ lpjmlkit::transform(to = c("year_month_day")) %>%
+ lpjmlkit::as_array(aggregate = list(month = sum)) %>%
+ drop()
+
+ # Calculating compound n emissions vector
+ aggregated_n_emissions_scen <- (
+ n_volatilization_scen + n2o_nit_scen + n2o_denit_scen + n2_emis_scen
+ )
+ soiln_scen <- soilno3_scen + soilnh4_scen
+
+
+ if (debug) {
+ nitrogen_scen <- list(
+ n_volatilization = n_volatilization_scen,
+ n2o_nit = n2o_nit_scen,
+ n2o_denit = n2o_denit_scen,
+ n2_emis = n2_emis_scen,
+ leaching = leaching_scen,
+ bnf = bnf_scen
+ )
+ nitrogen_ref <- list(
+ n_volatilization = n_volatilization_ref,
+ n2o_nit = n2o_nit_ref,
+ n2o_denit = n2o_denit_ref,
+ n2_emis = n2_emis_ref,
+ leaching = leaching_ref,
+ bnf = bnf_ref
+ )
+
+ save(
+ nitrogen_scen,
+ nitrogen_ref,
+ file = paste0(
+ dirname(save_file),
+ "nitrogen_states_debug.RData"
+ )
+ )
+ }
+ } # end if nitrogen
+
+ } else if (file_type == "nc") { # to be added
+ stop(
+ "nc reading has not been updated to latest functionality. ",
+ "Please contact Fabian Stenzel"
+ )
+ } else {
+ stop("Unrecognized file type (", file_type, ")")
+ }
+
+ if (nitrogen) {
+ state_ref <- abind::abind(
+ firec_ref, # 1
+ rh_harvest_ref, # 2
+ npp_ref, # 3
+ evapinterc_ref, # 4
+ runoff_ref, # 5
+ transp_ref, # 6
+ soillitc_ref, # 7
+ vegc_ref, # 8
+ swcsum_ref, # 9
+ discharge_ref, # 10
+ firef_ref, # 11
+ soiln_ref, # 12
+ vegn_ref, # 13
+ leaching_ref, # 14
+ bnf_ref, # 15
+ aggregated_n_emissions_ref, # 16
+ along = 3
+ )
+
+ state_scen <- abind::abind(
+ firec_scen, # 1
+ rh_harvest_scen, # 2
+ npp_scen, # 3
+ evapinterc_scen, # 4
+ runoff_scen, # 5
+ transp_scen, # 6
+ soillitc_scen, # 7
+ vegc_scen, # 8
+ swcsum_scen, # 9
+ discharge_scen, # 10
+ firef_scen, # 11
+ soiln_scen, # 12
+ vegn_scen, # 13
+ leaching_scen, # 14
+ bnf_scen, # 15
+ aggregated_n_emissions_scen, # 16
+ along = 3
+ )
+ di <- dimnames(state_ref)
+ var_names <- c(
+ "firec", "rh_harvest", "npp", "evapinterc", "runoff", "transp",
+ "soillitc", "vegc", "swcsum", "discharge", "firef", "soiln", "vegn",
+ "leaching", "bnf", "aggregated_n_emissions"
+ )
+ di[[3]] <- var_names
+ dimnames(state_ref) <- di
+ dimnames(state_scen) <- di
+
+ } else {
+ state_ref <- abind::abind(
+ firec_ref,
+ rh_harvest_ref,
+ npp_ref,
+ evapinterc_ref,
+ runoff_ref,
+ transp_ref,
+ soillitc_ref,
+ vegc_ref,
+ swcsum_ref,
+ discharge_ref,
+ firef_ref,
+ along = 3
+ )
+
+ state_scen <- abind::abind(
+ firec_scen,
+ rh_harvest_scen,
+ npp_scen,
+ evapinterc_scen,
+ runoff_scen,
+ transp_scen,
+ soillitc_scen,
+ vegc_scen,
+ swcsum_scen,
+ discharge_scen,
+ firef_scen,
+ along = 3
+ )
+
+ di <- dimnames(state_ref)
+ var_names <- c(
+ "firec", "rh_harvest", "npp", "evapinterc", "runoff",
+ "transp", "soillitc", "vegc", "swcsum", "discharge", "firef"
+ )
+ di[[3]] <- var_names
+ dimnames(state_ref) <- di
+ dimnames(state_scen) <- di
+ }
+
+ if (!(is.null(save_file))) {
+ print(paste0("Saving data to: ", save_file))
+ save(state_ref, state_scen, fpc_ref, fpc_scen,
+ bft_ref, bft_scen, cft_ref, cft_scen, lat, lon, cell_area,
+ file = save_file
+ )
+ }
+ return(
+ list(
+ state_ref = state_ref,
+ state_scen = state_scen,
+ fpc_ref = fpc_ref,
+ fpc_scen = fpc_scen,
+ bft_ref = bft_ref,
+ bft_scen = bft_scen,
+ cft_ref = cft_ref,
+ cft_scen = cft_scen,
+ lat = lat,
+ lon = lon,
+ cell_area = cell_area
+ )
+ )
+}
+
+#' Calculates changes in vegetation structure (vegetation_structure_change)
+#'
+#' Utility function to calculate changes in vegetation structure
+#' (vegetation_structure_change) for calculation of EcoRisk
+#'
+#' @param fpc_ref reference fpc array (dim: [ncells,npfts+1])
+#' @param fpc_scen scenario fpc array (dim: [ncells,npfts+1])
+#' @param bft_ref reference bft array (dim: [ncells,nbfts])
+#' @param bft_scen scenario bft array (dim: [ncells,nbfts])
+#' @param cft_ref reference cft array (dim: [ncells,ncfts])
+#' @param cft_scen scenario cft array (dim: [ncells,ncfts])
+#' @param weighting apply "old" (Ostberg-like), "new", or "equal" weighting of
+#' vegetation_structure_change weights (default "equal")
+#'
+#' @return vegetation_structure_change array of size ncells with the
+#' vegetation_structure_change value [0,1] for each cell
+#'
+#' @examples
+#' \dontrun{
+#' vegetation_structure_change <- calc_delta_v(
+#' fpc_ref = fpc_ref_mean,
+#' fpc_scen = apply(fpc_scen, c(1, 2), mean),
+#' bft_ref = bft_ref_mean,
+#' bft_scen = apply(bft_scen, c(1, 2), mean),
+#' cft_ref = cft_ref_mean,
+#' cft_scen = apply(cft_scen, c(1, 2), mean),
+#' weighting = "equal"
+#' )
+#' }
+#' @export
+calc_delta_v <- function(fpc_ref, # nolint
+ fpc_scen,
+ bft_ref,
+ bft_scen,
+ cft_ref,
+ cft_scen,
+ weighting = "equal") {
+ di <- dim(fpc_ref)
+ ncells <- di[1]
+ npfts <- di[2] - 1
+
+ fpc_ref[fpc_ref < 0] <- 0
+ fpc_scen[fpc_scen < 0] <- 0
+ bft_ref[bft_ref < 0] <- 0
+ bft_scen[bft_scen < 0] <- 0
+ cft_ref[cft_ref < 0] <- 0
+ cft_scen[cft_scen < 0] <- 0
+
+ if (npfts == 9) {
+
+ # barren = 1 - crop area - natural vegetation area +
+ # barren under bioenergy trees
+ barren_area_ref <- (
+ 1 - rowSums(cft_ref) -
+ rowSums(fpc_ref[, 2:10]) * fpc_ref[, 1] +
+ rowSums(cft_ref[, c(16, 32)]) * (1 - rowSums(bft_ref[, c(1:4, 7:10)]))
+ )
+
+ barren_area_ref[barren_area_ref < 0] <- 0
+
+ tree_area_ref <- array(0, dim = c(ncells, 11))
+
+ # natural tree area fractions scaled by total natural frac
+ tree_area_ref[, 1:7] <- (
+ fpc_ref[, 2:8] * fpc_ref[, 1]
+ )
+
+ # fraction of rainfed tropical and temperate BE trees scaled by total
+ # rainfed bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_ref[, 8:9] <- (
+ cft_ref[, 16] * bft_ref[, 1:2] / rowSums(bft_ref[, c(1, 2, 4)])
+ )
+
+ # fraction of irrigated tropical and temperate BE trees scaled by total
+ # irrigated bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_ref[, 10:11] <- (
+ cft_ref[, 32] * bft_ref[, 7:8] / rowSums(bft_ref[, c(7, 8, 10)])
+ )
+
+ grass_area_ref <- array(0, dim = c(ncells, 20))
+
+ # natural grass
+ grass_area_ref[, 1:2] <- fpc_ref[, 9:10] * fpc_ref[, 1]
+
+ # crops
+ grass_area_ref[, 3:15] <- cft_ref[, 1:13] + cft_ref[, 17:29]
+
+ # managed grass rf
+ grass_area_ref[, 16] <- cft_ref[, 14]
+
+ # managed grass irr
+ grass_area_ref[, 17] <- cft_ref[, 30]
+
+ # bioenergy grass
+ grass_area_ref[, 18] <- cft_ref[, 15] + cft_ref[, 31]
+
+ # fraction of rainfed grass under bioenergy trees
+ grass_area_ref[, 19] <- (
+ cft_ref[, 16] * bft_ref[, 4] / rowSums(bft_ref[, c(1, 2, 4)])
+ )
+
+ # fraction of irrigated grass under bioenergy trees
+ grass_area_ref[, 20] <- (
+ cft_ref[, 32] * bft_ref[, 10] / rowSums(bft_ref[, c(7, 8, 10)])
+ )
+
+ # barren
+ barren_area_scen <- (
+ 1 - rowSums(cft_scen) -
+ rowSums(fpc_scen[, 2:10]) * fpc_scen[, 1] +
+ rowSums(cft_scen[, c(16, 32)]) * (1 - rowSums(bft_scen[, c(1:4, 7:10)]))
+ )
+
+ barren_area_scen[barren_area_scen < 0] <- 0
+
+ tree_area_scen <- array(0, dim = c(ncells, 11))
+
+ # natural tree area fractions scaled by total natural frac
+ tree_area_scen[, 1:7] <- (
+ fpc_scen[, 2:8] * fpc_scen[, 1]
+ )
+
+ # fraction of rainfed tropical and temperate BE trees scaled by total
+ # rainfed bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_scen[, 8:9] <- (
+ cft_scen[, 16] * bft_scen[, 1:2] / rowSums(bft_scen[, c(1, 2, 4)])
+ )
+
+ # fraction of irrigated tropical and temperate BE trees scaled by total
+ # irrigated bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_scen[, 10:11] <- (
+ cft_scen[, 32] * bft_scen[, 7:8] / rowSums(bft_scen[, c(7, 8, 10)])
+ )
+ grass_area_scen <- array(0, dim = c(ncells, 20))
+
+ # natural grass
+ grass_area_scen[, 1:2] <- fpc_scen[, 9:10] * fpc_scen[, 1]
+
+ # crops
+ grass_area_scen[, 3:15] <- cft_scen[, 1:13] + cft_scen[, 17:29]
+
+ # managed grass rf
+ grass_area_scen[, 16] <- cft_scen[, 14]
+
+ # managed grass irr
+ grass_area_scen[, 17] <- cft_scen[, 30]
+
+ # bioenergy grass
+ grass_area_scen[, 18] <- cft_scen[, 15] + cft_scen[, 31]
+
+ # fraction of rainfed grass under bioenergy trees
+ grass_area_scen[, 19] <- (
+ cft_scen[, 16] * bft_scen[, 4] / rowSums(bft_scen[, c(1, 2, 4)])
+ )
+
+ # fraction of irrigated grass under bioenergy trees
+ grass_area_scen[, 20] <- (
+ cft_scen[, 32] * bft_scen[, 10] / rowSums(bft_scen[, c(7, 8, 10)])
+ )
+
+ # evergreenness, needleleavedness, tropicalness, borealness, naturalness
+ tree_attributes <- matrix(
+ c(
+ c(1, 0, 1, 0, 1), # 1 TrBE
+ c(0, 0, 1, 0, 1), # 2 TrBR
+ c(1, 1, 0, 0, 1), # 3 TeNE
+ c(1, 0, 0, 0, 1), # 4 TeBE
+ c(0, 0, 0, 0, 1), # 5 TeBS
+ c(1, 1, 0, 1, 1), # 6 BoNE
+ c(0, 0.25, 0, 1, 1), # 7 BoS (including larchs)
+ c(1, 0, 1, 0, 0), # 8 TrBi tropical bioenergy rainfed
+ c(0, 0, 0, 0, 0), # 9 TeBi temperate bioenergy rainfed
+ c(1, 0, 1, 0, 0), # 10 TrBi tropical bioenergy irrigated
+ c(0, 0, 0, 0, 0) # 11 TeBi temperate bioenergy irrigated
+ ),
+ nrow = 11,
+ byrow = TRUE
+ )
+
+ if (weighting == "equal") {
+ tree_weights <- c(0.2, 0.2, 0.2, 0.2, 0.2)
+
+ # changed compared to Sebastian Ostberg's method
+ } else if (weighting == "new") {
+ tree_weights <- c(0.2, 0.2, 0.3, 0.3, 0.3) / 1.3
+
+ # Sebastian's method (no downscaling to weightsum 1)
+ } else if (weighting == "old") {
+ tree_weights <- c(0.2, 0.2, 0.3, 0.3, 0.3)
+
+ } else {
+ stop("Unknown method of weighting.")
+ }
+
+ grass_attributes <- array(0, dim = c(ncells, 20, 2))
+ # 1 C3grass
+ # 2 C4grass
+ # 3 TemperateCereals
+ # 4 Rice
+ # 5 Maize
+ # 6 TropicalCereals
+ # 7 Pulses
+ # 8 TemperateRoots
+ # 9 TropicalRoots
+ # 10 Sunflower
+ # 11 Soybean
+ # 12 Groundnut
+ # 13 Rapeseed
+ # 14 Sugarcane
+ # 15 Others
+ # 16 Managed grass rainfed
+ # 17 Managed grass irrigated
+ # 18 Bioenergy grass
+ # 19 Grass under rainfed Bioenergy trees
+ # 20 Grass under irrigated Bioenergy trees
+
+ # tropicalness
+ grass_attributes[, , 1] <- rep(
+ c(0, 1, 0, 1, 1, 1, 0.5, 0, 1, 0.5, 1, 1, 0.5, 1, 0.5, NA, NA, 1, NA, NA),
+ each = ncells
+ )
+
+ # naturalness
+ grass_attributes[, , 2] <- rep(
+ c(1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
+ each = ncells
+ )
+
+ # dynamic share of tropicalness for rf/irr grasslands taken from ratio of
+ # bioenergy grasses
+ dyn_grass_attributes <- cbind(
+ bft_scen[, 6] / rowSums(bft_scen[, 5:6]),
+ bft_scen[, 12] / rowSums(bft_scen[, 11:12])
+ )
+
+ dyn_grass_attributes[!is.finite(dyn_grass_attributes)] <- 0
+
+ # managed grass rf/irr
+ grass_attributes[, 16:17, 1] <- dyn_grass_attributes
+
+ # grass under biotrees rf/irr (taken from managed grass)
+ grass_attributes[, 19:20, 1] <- dyn_grass_attributes
+
+ if (weighting == "equal") {
+ grass_weights <- c(0.2, 0.2)
+
+ # changed compared to Sebastian Ostberg's method
+ } else if (weighting == "new") {
+ grass_weights <- c(0.5, 0.5)
+
+ # Sebastian Ostbergs's method (no downscaling to weightsum 1)
+ } else if (weighting == "old") {
+ grass_weights <- c(0.3, 0.3)
+
+ } else {
+ stop("Unknown method of weighting.")
+ }
+
+ } else if (npfts == 11) {
+
+ # barren = 1 - crop area - natural vegetation area +
+ # barren under bioenergy trees
+ barren_area_ref <- (
+ 1 - rowSums(cft_ref) -
+ rowSums(fpc_ref[, 2:12]) * fpc_ref[, 1] +
+ rowSums(cft_ref[, c(16, 32)]) * (1 - rowSums(bft_ref[, c(4:9, 13:18)]))
+ )
+
+ barren_area_ref[barren_area_ref < 0] <- 0
+
+ tree_area_ref <- array(0, dim = c(ncells, 12))
+
+ # natural tree area fractions scaled by total natural frac
+ tree_area_ref[, 1:8] <- fpc_ref[, 2:9] * fpc_ref[, 1]
+
+ # fraction of rainfed tropical and temperate BE trees scaled by total
+ # rainfed bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_ref[, 9:10] <- (
+ cft_ref[, 16] * bft_ref[, 7:8] / rowSums(bft_ref[, 4:8])
+ )
+
+ # fraction of irrigated tropical and temperate BE trees scaled by total
+ # irrigated bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_ref[, 11:12] <- (
+ cft_ref[, 32] * bft_ref[, 16:17] / rowSums(bft_ref[, 13:17])
+ )
+
+ grass_area_ref <- array(0, dim = c(ncells, 21))
+
+ # natural grass
+ grass_area_ref[, 1:3] <- fpc_ref[, 10:12] * fpc_ref[, 1]
+
+ # crops
+ grass_area_ref[, 4:16] <- cft_ref[, 1:13] + cft_ref[, 17:29]
+
+ # managed grass rf
+ grass_area_ref[, 17] <- cft_ref[, 14]
+
+ # managed grass irr
+ grass_area_ref[, 18] <- cft_ref[, 30]
+
+ # bioenergy grass
+ grass_area_ref[, 19] <- cft_ref[, 15] + cft_ref[, 31]
+
+ # fraction of rainfed grass under bioenergy trees
+ grass_area_ref[, 20] <- (
+ cft_ref[, 16] * rowSums(bft_ref[, 4:6]) / rowSums(bft_ref[, 4:8])
+ )
+
+ # fraction of irrigated grass under bioenergy trees
+ grass_area_ref[, 21] <- (
+ cft_ref[, 32] * rowSums(bft_ref[, 13:15]) / rowSums(bft_ref[, 13:17])
+ )
+
+ # barren = 1 - crop area - natural vegetation area +
+ # barren under bioenergy trees
+ barren_area_scen <- (
+ 1 - rowSums(cft_scen) -
+ rowSums(fpc_scen[, 2:12]) * fpc_scen[, 1] +
+ rowSums(cft_scen[, c(16, 32)]) * (1 - rowSums(bft_scen[, c(4:9, 13:18)]))
+ )
+
+ barren_area_scen[barren_area_scen < 0] <- 0
+
+ tree_area_scen <- array(0, dim = c(ncells, 12))
+
+ # natural tree area fractions scaled by total natural frac
+ tree_area_scen[, 1:8] <- fpc_scen[, 2:9] * fpc_scen[, 1]
+
+ # fraction of rainfed tropical and temperate BE trees scaled by total
+ # rainfed bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_scen[, 9:10] <- (
+ cft_scen[, 16] * bft_scen[, 7:8] / rowSums(bft_scen[, 4:8])
+ )
+
+ # fraction of irrigated tropical and temperate BE trees scaled by total
+ # irrigated bioenergy tree area and relative fpc of bioenergy trees and
+ # grass under bioenergy trees
+ tree_area_scen[, 11:12] <- (
+ cft_scen[, 32] * bft_scen[, 16:17] / rowSums(bft_scen[, 13:17])
+ )
+
+ grass_area_scen <- array(0, dim = c(ncells, 21))
+
+ # natural grass
+ grass_area_scen[, 1:3] <- fpc_scen[, 10:12] * fpc_scen[, 1]
+
+ # crops
+ grass_area_scen[, 4:16] <- cft_scen[, 1:13] + cft_scen[, 17:29]
+
+ # managed grass rf
+ grass_area_scen[, 17] <- cft_scen[, 14]
+
+ # managed grass irr
+ grass_area_scen[, 18] <- cft_scen[, 30]
+
+ # bioenergy grass
+ grass_area_scen[, 19] <- cft_scen[, 15] + cft_scen[, 31]
+
+ # fraction of rainfed grass under bioenergy trees
+ grass_area_scen[, 20] <- (
+ cft_scen[, 16] * rowSums(bft_scen[, 4:6]) / rowSums(bft_scen[, 4:8])
+ )
+
+ # fraction of irrigated grass under bioenergy trees
+ grass_area_scen[, 21] <- (
+ cft_scen[, 32] * rowSums(bft_scen[, 13:15]) / rowSums(bft_scen[, 13:17])
+ )
+
+ # evergreenness, needleleavedness, tropicalness, borealness, naturalness
+ tree_attributes <- matrix(
+ c(
+ c(1, 0, 1, 0, 1), # 1 TrBE
+ c(0, 0, 1, 0, 1), # 2 TrBR
+ c(1, 1, 0, 0, 1), # 3 TeNE
+ c(1, 0, 0, 0, 1), # 4 TeBE
+ c(0, 0, 0, 0, 1), # 5 TeBS
+ c(1, 1, 0, 1, 1), # 6 BoNE
+ c(0, 0, 0, 1, 1), # 7 BoBS
+ c(0, 1, 0, 1, 1), # 8 BoNS
+ c(1, 0, 1, 0, 0), # 9 TrBi tropical bioenergy rainfed
+ c(0, 0, 0, 0, 0), # 10 TeBi temperate bioenergy rainfed
+ c(1, 0, 1, 0, 0), # 11 TrBi tropical bioenergy irrigated
+ c(0, 0, 0, 0, 0) # 12 TeBi temperate bioenergy irrigated
+ ),
+ nrow = 12,
+ byrow = TRUE
+ )
+
+ if (weighting == "equal") {
+ tree_weights <- c(0.2, 0.2, 0.2, 0.2, 0.2)
+
+ # changed compared to Sebastian Ostberg's method
+ } else if (weighting == "new") {
+ tree_weights <- c(0.2, 0.2, 0.3, 0.3, 0.3) / 1.3
+
+ # Sebastian Ostberg's method (no downscaling to weightsum 1)
+ } else if (weighting == "old") {
+ tree_weights <- c(0.2, 0.2, 0.3, 0.3, 0.3)
+
+ } else {
+ stop("Unknown method of weighting.")
+ }
+
+ grass_attributes <- array(0, dim = c(ncells, 21, 3))
+ # 1 C4grass tropic
+ # 2 C3grass temperate
+ # 3 C3grass polar
+ # 4 TemperateCereals
+ # 5 Rice
+ # 6 Maize
+ # 7 TropicalCereals
+ # 8 Pulses
+ # 9 TemperateRoots
+ # 10 TropicalRoots
+ # 11 Sunflower
+ # 12 Soybean
+ # 13 Groundnut
+ # 14 Rapeseed
+ # 15 Sugarcane
+ # 16 Others
+ # 17 Managed grass rainfed
+ # 18 Managed grass irrigated
+ # 19 Bioenergy grass
+ # 20 Grass under rainfed Bioenergy trees
+ # 21 Grass under irrigated Bioenergy trees
+
+ # tropicalness
+ grass_attributes[, , 1] <- rep(
+ c(1, 0, 0, 0, 1, 1, 1, 0.5, 0, 1, 0.5, 1, 1, 0.5, 1, 0.5, NA, NA, 1, NA, NA), # nolint
+ each = ncells
+ )
+
+ # borealness
+ grass_attributes[, , 2] <- rep(
+ c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, NA, NA, 0, NA, NA),
+ each = ncells
+ )
+
+ # naturalness
+ grass_attributes[, , 3] <- rep(
+ c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
+ each = ncells
+ )
+
+ # dynamic share of tropicalness for grass under irr biotrees
+ dyn_trop_grass_attributes <- cbind(
+ # dynamic share of tropicalness for rf grasslands
+ bft_scen[, 1] / rowSums(bft_scen[, 1:3]),
+ # dynamic share of tropicalness for irr grasslands
+ bft_scen[, 10] / rowSums(bft_scen[, 10:12]),
+ # dynamic share of tropicalness for grass under rf biotrees
+ bft_scen[, 4] / rowSums(bft_scen[, 4:6]),
+ bft_scen[, 13] / rowSums(bft_scen[, 13:15])
+ )
+
+ dyn_trop_grass_attributes[!is.finite(dyn_trop_grass_attributes)] <- 0
+
+ # managed grass rf/irr, grass under biotrees rf/irr
+ grass_attributes[, c(17, 18, 20, 21), 1] <- dyn_trop_grass_attributes
+
+ # dynamic share of borealness for grass under irr biotrees
+ dyn_boreal_grass_attributes <- cbind(
+ # dynamic share of borealness for rf grasslands
+ bft_scen[, 3] / rowSums(bft_scen[, 1:3]),
+ # dynamic share of borealness for irr grasslands
+ bft_scen[, 12] / rowSums(bft_scen[, 10:12]),
+ # dynamic share of borealness for grass under rf biotrees
+ bft_scen[, 6] / rowSums(bft_scen[, 4:6]),
+ bft_scen[, 15] / rowSums(bft_scen[, 13:15])
+ )
+
+ dyn_boreal_grass_attributes[!is.finite(dyn_boreal_grass_attributes)] <- 0
+
+ # managed grass rf/irr, grass under biotrees rf/irr
+ grass_attributes[, c(17, 18, 20, 21), 2] <- dyn_boreal_grass_attributes
+
+ if (weighting == "equal") {
+ grass_weights <- c(0.2, 0.2, 0.2)
+
+ } else if (weighting == "old" || weighting == "new") {
+ grass_weights <- c(0.3333333, 0.3333333, 0.3333333)
+
+ } else {
+ stop("Unknown method of weighting.")
+ }
+
+ } else {
+ stop("Unknown number of pfts.")
+ }
+
+ # compute vegetation_structure_change
+ barren_v <- fBasics::rowMins(cbind(barren_area_ref, barren_area_scen))
+
+ trees_v <- fBasics::rowMins(
+ cbind(rowSums(tree_area_ref, na.rm = TRUE),
+ rowSums(tree_area_scen, na.rm = TRUE))
+ )
+
+ grass_v <- fBasics::rowMins(
+ cbind(rowSums(grass_area_ref, na.rm = TRUE),
+ rowSums(grass_area_scen, na.rm = TRUE))
+ )
+
+ inner_sum_trees <- (
+ # evergreenness
+ abs(
+ rowSums(tree_area_ref[, ] * rep(tree_attributes[, 1], each = ncells), na.rm = TRUE) - # nolint
+ rowSums(tree_area_scen[, ] * rep(tree_attributes[, 1], each = ncells), na.rm = TRUE) # nolint
+ ) * tree_weights[1] +
+ # needleleavedness
+ abs(
+ rowSums(tree_area_ref[, ] * rep(tree_attributes[, 2], each = ncells), na.rm = TRUE) - # nolint
+ rowSums(tree_area_scen[, ] * rep(tree_attributes[, 2], each = ncells), na.rm = TRUE) # nolint
+ ) * tree_weights[2] +
+ # tropicalness
+ abs(
+ rowSums(tree_area_ref[, ] * rep(tree_attributes[, 3], each = ncells), na.rm = TRUE) - # nolint
+ rowSums(tree_area_scen[, ] * rep(tree_attributes[, 3], each = ncells), na.rm = TRUE) # nolint
+ ) * tree_weights[3] +
+ # borealness
+ abs(
+ rowSums(tree_area_ref[, ] * rep(tree_attributes[, 4], each = ncells), na.rm = TRUE) - # nolint
+ rowSums(tree_area_scen[, ] * rep(tree_attributes[, 4], each = ncells), na.rm = TRUE) # nolint
+ ) * tree_weights[4] +
+ # naturalness
+ abs(
+ rowSums(tree_area_ref[, ] * rep(tree_attributes[, 5], each = ncells), na.rm = TRUE) - # nolint
+ rowSums(tree_area_scen[, ] * rep(tree_attributes[, 5], each = ncells), na.rm = TRUE) # nolint
+ ) * tree_weights[5]
+ )
+
+ if (npfts == 9) {
+
+ inner_sum_grasses <- (
+ # tropicalness
+ abs(
+ rowSums(grass_area_ref[, ] * grass_attributes[, , 1], na.rm = TRUE) -
+ rowSums(grass_area_scen[, ] * grass_attributes[, , 1], na.rm = TRUE)
+ ) * grass_weights[1] +
+ # naturalness
+ abs(
+ rowSums(grass_area_ref[, ] * grass_attributes[, , 2], na.rm = TRUE) -
+ rowSums(grass_area_scen[, ] * grass_attributes[, , 2], na.rm = TRUE)
+ ) * grass_weights[2]
+ )
+
+ } else if (npfts == 11) {
+
+ inner_sum_grasses <- (
+ # tropicalness
+ abs(
+ rowSums(grass_area_ref[, ] * grass_attributes[, , 1], na.rm = TRUE) -
+ rowSums(grass_area_scen[, ] * grass_attributes[, , 1], na.rm = TRUE)
+ ) * grass_weights[1] +
+ # borealness
+ abs(
+ rowSums(grass_area_ref[, ] * grass_attributes[, , 2], na.rm = TRUE) -
+ rowSums(grass_area_scen[, ] * grass_attributes[, , 2], na.rm = TRUE)
+ ) * grass_weights[2] +
+ # naturalness
+ abs(
+ rowSums(grass_area_ref[, ] * grass_attributes[, , 3], na.rm = TRUE) -
+ rowSums(grass_area_scen[, ] * grass_attributes[, , 3], na.rm = TRUE)
+ ) * grass_weights[3]
+ )
+
+ } else {
+ stop("Unknown number of pfts.")
+ }
+
+ vegetation_structure_change <- (
+ 1 - barren_v -
+ trees_v * (1 - inner_sum_trees) -
+ grass_v * (1 - inner_sum_grasses)
+ )
+
+ vegetation_structure_change[vegetation_structure_change < 0] <- 0
+
+ vegetation_structure_change[!is.finite(vegetation_structure_change)] <- 0
+
+ return(vegetation_structure_change)
+}
+
+
+################# further EcoRisk utility functions ##################
+
+t_sigmoid_trafo <- function(x) {
+ return(-1 / exp(3) + (1 + 1 / exp(3)) / (1 + exp(-6 * (x - 0.5))))
+}
+
+
+balance <- function(v1, v2) {
+ return(1 - sum(v1 * v2) / (sqrt(sum(v1 * v1)) * sqrt(sum(v2 * v2))))
+}
+
+
+std_cellwise <- function(a) {
+ return(apply(a, 1, stats::sd))
+}
+
+
+global_yearly_weighted_mean <- function(a, cell_area) {
+ # a is matrix with dim=c(cells,years)
+ # cell_area the corresponding cell_area array with dim=c(cells)
+ return(
+ sum(a * cell_area, na.rm = TRUE) /
+ (length(a[1, ]) * sum(cell_area, na.rm = TRUE))
+ )
+}
+
+
+globally_weighted_mean_foreach_var <- function(x, cell_area) { # nolint
+ # x is matrix with dim=c(ncells,vars)
+ # cell_area the corresponding cell_area array to x with dim=c(ncells)
+ return(colSums(x * cell_area, na.rm = TRUE) / sum(cell_area, na.rm = TRUE))
+}
+
+
+s_change_to_var_ratio <- function(x, s) {
+ return(1 / (1 + exp(-4 * (x / s - 2))))
+}
+
+
+#' based on Heyder 2011 eq. 6-9; epsilon case handling from code
+#' by Sebastian Ostberg (not documented in papers)
+#' @param ref mean reference state vector of dimension c(ncells,variables)
+#' @param scen mean scenario state vector of dimension c(ncells,variables)
+#' @param epsilon threshold for variables to be treated as 0
+#'
+#' @returns the length of the difference vector for each cell
+state_diff_local <- function(ref, scen, epsilon = 10^-4) {
+
+ # Ostberg code: case change_metric_lu_comparison_jun2013.c
+ di <- dim(ref)
+ # generally normalize the scenario state vector by the reference state
+ s_scen <- scen / ref
+ s_ref <- array(1, dim = di) # initialize
+
+ # for variables in places, where ref is small (<epsilon),
+ # but scen larger (Ostberg code, line 798)
+ # Sebastian set back scenario and reference vector, to keep the unscaled
+ # values (Ostberg code, line 804)
+ cells_ref0 <- abs(ref) < epsilon & abs(scen) > epsilon
+ s_scen[cells_ref0] <- scen[cells_ref0]
+ s_ref[cells_ref0] <- ref[cells_ref0]
+
+ # for variables in places, where ref and scen are small (<epsilon),
+ # return 0 (both are 1, difference is 0) (Ostberg code, line 809)
+ s_scen[abs(ref) < epsilon & abs(scen) < epsilon] <- 1 # no change
+
+ # normalize both state vectors by the sqrt(amount of state variables) to
+ # ensure length(s_ref)==1 (this is part of the weighting in the Ostberg
+ # code)
+ s_ref <- s_ref / sqrt(di[2])
+ s_scen <- s_scen / sqrt(di[2])
+
+ # length of the local difference vector s_scen (sl2) - s_ref (sl1)
+ return(sqrt(rowSums((s_scen - s_ref) * (s_scen - s_ref))))
+}
+
+
+
+#' c based on Heyder 2011 eq. 10-13
+#'
+#' @param ref mean reference state vector of dimension c(ncells,variables)
+#' @param scen mean scenario state vector of dimension c(ncells,variables)
+#' @param cell_area area of each cell as a vector of dim=c(ncells)
+#' @param epsilon threshold for variables to be treated as 0
+#'
+#' @returns the length of the difference vector for each cell
+state_diff_global <- function(ref, scen, cell_area, epsilon = 10^-4) {
+
+ di <- dim(ref)
+ ncells <- di[1]
+ global_mean_ref <- globally_weighted_mean_foreach_var(ref, cell_area)
+ global_mean_scen <- globally_weighted_mean_foreach_var(scen, cell_area)
+
+ # if global mean state in ref period is 0 (e.g. for landuse vars in pnv run?)
+ # take the mean scen state instead
+ cells_ref0 <- abs(global_mean_ref) < epsilon & abs(global_mean_scen) > epsilon
+ global_mean_ref[cells_ref0] <- global_mean_scen[cells_ref0]
+ # if both are 0 take 1, then the division is defined but 0 - 0 leads
+ # to no change, which is what EcoRisk should show
+ cells_both0 <- (
+ abs(global_mean_ref) < epsilon & abs(global_mean_scen) < epsilon
+ )
+ global_mean_ref[cells_both0] <- 1
+
+ norm <- rep(global_mean_ref, each = ncells)
+ dim(norm) <- dim(ref)
+ s_scen <- scen / norm
+ s_ref <- ref / norm
+
+ # normalize both state vectors by the sqrt(amount of state variables) to
+ # ensure length(s_ref)==1
+ # (this is part of the weighting in the Ostberg code)
+ s_ref <- s_ref / sqrt(di[2])
+ s_scen <- s_scen / sqrt(di[2])
+
+ # length of the difference vector s_scen (sl2) - s_ref (sl1) for each cell
+ return(sqrt(rowSums((s_scen - s_ref) * (s_scen - s_ref))))
+}
+
+
+calc_component <- function(ref, scen, local, cell_area, export = FALSE) {
+ # calc mean ref and scen state
+ ref_mean <- apply(ref, c(1, 3), mean)
+ scen_mean <- apply(scen, c(1, 3), mean)
+ di <- dim(ref)
+ ncells <- di[1]
+ nyears <- di[2]
+
+ if (local) {
+ x <- t_sigmoid_trafo(state_diff_local(ref = ref_mean, scen = scen_mean))
+ } else {
+ x <- t_sigmoid_trafo(
+ state_diff_global(ref = ref_mean, scen = scen_mean, cell_area = cell_area)
+ )
+ }
+ # calculation of the change-to-variability ratio in my view is mathematically
+ # not correctly described in Heyder and Ostberg
+ # - the way I understand it: recalculate the c/g/b value for each year of the
+ # ref period compared to the mean of the ref period as "scenario" and then
+ # calc the variability (sd) of that
+ sigma_x_ref_list <- array(0, dim = c(ncells, nyears))
+ for (i in 1:nyears) {
+ if (local) {
+ sigma_x_ref_list[, i] <- t_sigmoid_trafo(
+ state_diff_local(ref = ref_mean, scen = ref[, i, ])
+ )
+ } else {
+ sigma_x_ref_list[, i] <- t_sigmoid_trafo(
+ state_diff_global(
+ ref = ref_mean,
+ scen = ref[, i, ],
+ cell_area = cell_area
+ )
+ )
+ }
+ }
+
+ sigma_x_ref <- apply(sigma_x_ref_list, 1, stats::sd)
+ if (export) export_vars2global_env(x, sigma_x_ref)
+
+ return(x * s_change_to_var_ratio(x, sigma_x_ref))
+}
+
+
+balance_shift <- function(ref, scen, epsilon = 10^-4) {
+ # param ref with dimension c(ncells,nvars)
+ # param scen with dimension c(ncells,nvars)
+
+ # first normalize as for local change
+ s_scen <- scen / ref
+ s_ref <- array(1, dim = dim(ref))
+
+ # for variables in places, where ref is small (<epsilon), but scen larger
+ # (Ostberg code, line 798/vector length calc in line 837)
+ # set back scenario vector, to keep the unscaled values (Ostberg code,
+ # line 805)
+ s_scen[abs(ref) < epsilon & abs(scen) > epsilon] <- (
+ scen[abs(ref) < epsilon & abs(scen) > epsilon]
+ )
+
+ # for variables in places, where ref and scen are small (<epsilon),
+ # set scen to 1 (both are 1, difference is 0 -- no change) (Ostberg code,
+ # line 809)
+
+ # results in no change
+ s_scen[abs(ref) < epsilon & abs(scen) < epsilon] <- 1
+ # absa(_ts) in Sebastians Ostberg's code
+ abs_ref <- sqrt(rowSums(s_ref * s_ref))
+ # absb(_ts) in Sebastian Ostberg's code
+ abs_scen <- sqrt(rowSums(s_scen * s_scen))
+ # =1-angle_ts
+ b1 <- 1 - (rowSums(s_ref * s_scen) / abs_ref / abs_scen)
+
+ # restrain to the maximum range for the acos function
+ b1[b1 < 0] <- 0
+ b1[b1 > 2] <- 2
+ angle <- acos(1 - b1) * 360 / 2 / pi
+ angle[b1 == 1] <- 0
+ b <- b1 * 2
+ b[angle > 60] <- 1
+
+ return(b)
+}
+
+
+calc_ecosystem_balance <- function(ref, scen, export = FALSE) {
+ ref_mean <- apply(ref, c(1, 3), mean)
+ scen_mean <- apply(scen, c(1, 3), mean)
+ di <- dim(ref)
+ ncells <- di[1]
+ nyears <- di[2]
+
+ b <- balance_shift(ref = ref_mean, scen = scen_mean)
+ # calculation of the change-to-variability ratio in my view is mathematically
+ # not correctly described in Heyder and Ostberg
+ # - the way I understand it: recalculate the c/g/b value for each year of the
+ # ref period compared to the mean
+ # of the ref period as "scenario" and then calc the variability (sd) of that
+ sigma_b_ref_list <- array(0, dim = c(ncells, nyears))
+ for (i in 1:nyears) {
+ sigma_b_ref_list[, i] <- balance_shift(ref = ref_mean, scen = ref[, i, ])
+ }
+ sigma_b_ref <- apply(sigma_b_ref_list, 1, stats::sd)
+ if (export) export_vars2global_env(b, sigma_b_ref)
+
+ return(b * s_change_to_var_ratio(b, sigma_b_ref))
+}
+
+
+#' Create modified EcoRisk data file
+#'
+#' Function to create a modified EcoRisk data file where each reference cell is
+#' compared to the average reference biome cell. The scenario period is
+#' overwritten with the original reference period and all reference cells are
+#' set to the average cell of the prescribed reference biome ref_biom
+#'
+#' @param data_file_in path to input data
+#' @param data_file_out path to save modified data to
+#' @param biome_classes_in biome classes object as returned from classify_biomes
+#' @param ref_biom reference biome from biome classes that all cells should
+#' be compared to
+#'
+#' @export
+replace_ref_data_with_average_ref_biome_cell <- function( # nolint
+ data_file_in,
+ data_file_out,
+ biome_classes_in,
+ ref_biom
+) {
+ if (data_file_in == data_file_out) {
+ stop(
+ "Same file for input and output of data, would overwrite ",
+ "original data. Aborting."
+ )
+ }
+
+ load(data_file_in)
+
+ ref_cells <- which(biome_classes_in$biome_id == ref_biom)
+
+ # first set all scen vacrossrs to the ref vars # [1:64240, 1:30, 1:10]
+ state_scen <- state_ref
+
+ fpc_scen <- fpc_ref
+ bft_scen <- bft_ref
+ cft_scen <- cft_ref
+
+ di_state <- dim(state_scen)
+ di_fpc <- dim(fpc_scen)
+ di_bft <- dim(bft_scen)
+ di_cft <- dim(cft_scen)
+
+ # now replace all ref cells with that of the mean ref biom cell
+ # FS 2022-08-10: keeping the year-to-year variation
+ if (length(ref_cells) == 1) {
+ av_year_state <- state_scen[ref_cells, , ]
+ fpc_ref <- rep(fpc_scen[ref_cells, , ], each = di_fpc[1])
+ bft_ref <- rep(bft_scen[ref_cells, , ], each = di_bft[1])
+ cft_ref <- rep(cft_scen[ref_cells, , ], each = di_cft[1])
+ } else {
+ av_year_state <- apply(state_scen[ref_cells, , ], c(2, 3), mean)
+ fpc_ref <- rep(
+ apply(fpc_scen[ref_cells, , ], c(2, 3), mean),
+ each = di_fpc[1]
+ )
+ bft_ref <- rep(
+ apply(bft_scen[ref_cells, , ], c(2, 3), mean),
+ each = di_bft[1]
+ )
+ cft_ref <- rep(
+ apply(cft_scen[ref_cells, , ], c(2, 3), mean),
+ each = di_cft[1]
+ )
+ }
+ state_ref <- rep(av_year_state, each = di_state[1])
+ dim(state_ref) <- di_state
+
+ # is the same for each year, thus for the mean just take one year
+ # mean_state_ref <- rep(colMeans(av_year_state), each = di_state[1])
+ # FS: mean states were removed from data file, removing also here
+
+ dim(fpc_ref) <- di_fpc
+ dim(bft_ref) <- di_bft
+ dim(cft_ref) <- di_cft
+
+ # and write out the modified data
+ # save(state_ref,mean_state_ref,state_scen,mean_state_scen,fpc_ref,fpc_scen,
+ # bft_ref,bft_scen,cft_ref,cft_scen,lat,lon,cell_area,file = data_file_out)
+ save(state_ref,
+ state_scen,
+ fpc_ref,
+ fpc_scen,
+ bft_ref,
+ bft_scen,
+ cft_ref,
+ cft_scen,
+ lat,
+ lon,
+ cell_area,
+ file = data_file_out)
+}
+
+
+#' Create modified EcoRisk data for crosstable
+#'
+#' Function to create a modified EcoRisk data file where for each biome
+#' the average scenario cell is compared to the average scenario cell of all
+#' other biomes. This can then be used to compute a crosstable with the average
+#' difference between each of them as in the SI of Ostberg et al. 2013
+#' (Critical impacts of global warming on land ecosystems)
+#'
+#' @param data_file_in path to input data
+#' @param data_file_out path to save modified data to
+#' @param biome_classes_in biome classes object as returned from classify_biomes
+#' @param pick_cells pick one specific cell as representative for the biome
+#' instead of computing the average state
+#'
+#' @export
+ecorisk_cross_table <- function(data_file_in,
+ data_file_out,
+ biome_classes_in,
+ pick_cells = NULL) {
+ if (data_file_in == data_file_out) {
+ stop(
+ "Same file for input and output of data, would overwrite original data. ",
+ "Aborting."
+ )
+ }
+ load(data_file_in)
+
+ # save scenario state vectors, they contain relevant data (ref can go)
+ state_scen_sav <- state_scen
+ fpc_scen_sav <- fpc_scen
+ bft_scen_sav <- bft_scen
+ cft_scen_sav <- cft_scen
+
+ nbiomes <- max(biome_classes_in$biome_id) # by default 19
+ state_ref <- array(0, dim = c(nbiomes, nbiomes, dim(state_scen_sav)[2:3]))
+ state_scen <- state_ref
+ fpc_ref <- array(0, dim = c(nbiomes, nbiomes, dim(fpc_scen_sav)[2:3]))
+ fpc_scen <- fpc_ref
+ bft_ref <- array(0, dim = c(nbiomes, nbiomes, dim(bft_scen_sav)[2:3]))
+ bft_scen <- bft_ref
+ cft_ref <- array(0, dim = c(nbiomes, nbiomes, dim(cft_scen_sav)[2:3]))
+ cft_scen <- cft_ref
+
+ # now replace all ref cells with that of the mean ref biome cell
+ for (b in sort(unique(biome_classes_in$biome_id))) {
+ ref_cells <- which(biome_classes_in$biome_id == b)
+
+ if (is.null(pick_cells)) {
+ if (length(ref_cells) == 1) {
+ # average over cells, keeping the average year-to-year variation
+ av_state <- state_scen_sav[ref_cells, , ]
+ av_fpc <- fpc_scen_sav[ref_cells, , ]
+ av_bft <- bft_scen_sav[ref_cells, , ]
+ av_cft <- cft_scen_sav[ref_cells, , ]
+ } else {
+ # average over cells, keeping the average year-to-year variation
+ av_state <- apply(state_scen_sav[ref_cells, , ], c(2, 3), mean)
+ av_fpc <- apply(fpc_scen_sav[ref_cells, , ], c(2, 3), mean)
+ av_bft <- apply(bft_scen_sav[ref_cells, , ], c(2, 3), mean)
+ av_cft <- apply(cft_scen_sav[ref_cells, , ], c(2, 3), mean)
+ }
+ } else {
+ av_state <- state_scen_sav[pick_cells[b], , ]
+ av_fpc <- fpc_scen_sav[pick_cells[b], , ]
+ av_bft <- bft_scen_sav[pick_cells[b], , ]
+ av_cft <- cft_scen_sav[pick_cells[b], , ]
+ }
+
+ state_ref[b, , , ] <- rep(av_state, each = nbiomes)
+ state_scen[, b, , ] <- rep(av_state, each = nbiomes)
+
+ mean_state_ref <- apply(state_ref, c(1, 3), mean)
+ mean_state_scen <- apply(state_scen, c(1, 3), mean)
+
+ fpc_ref[b, , , ] <- rep(av_fpc, each = nbiomes)
+ fpc_scen[, b, , ] <- rep(av_fpc, each = nbiomes)
+
+ bft_ref[b, , , ] <- rep(av_bft, each = nbiomes)
+ bft_scen[, b, , ] <- rep(av_bft, each = nbiomes)
+
+ cft_ref[b, , , ] <- rep(av_cft, each = nbiomes)
+ cft_scen[, b, , ] <- rep(av_cft, each = nbiomes)
+ }
+ dim(state_ref) <- c(nbiomes * nbiomes, dim(state_scen_sav)[2:3])
+ dim(state_scen) <- c(nbiomes * nbiomes, dim(state_scen_sav)[2:3])
+ dim(fpc_ref) <- c(nbiomes * nbiomes, dim(fpc_scen_sav)[2:3])
+ dim(fpc_scen) <- c(nbiomes * nbiomes, dim(fpc_scen_sav)[2:3])
+ dim(bft_ref) <- c(nbiomes * nbiomes, dim(bft_scen_sav)[2:3])
+ dim(bft_scen) <- c(nbiomes * nbiomes, dim(bft_scen_sav)[2:3])
+ dim(cft_ref) <- c(nbiomes * nbiomes, dim(cft_scen_sav)[2:3])
+ dim(cft_scen) <- c(nbiomes * nbiomes, dim(cft_scen_sav)[2:3])
+
+ lat <- rep(0, nbiomes * nbiomes)
+ lon <- rep(1, nbiomes * nbiomes)
+ cell_area <- rep(2, nbiomes * nbiomes)
+
+ # and write out the modified data
+ save(state_ref,
+ mean_state_ref,
+ state_scen,
+ mean_state_scen,
+ fpc_ref,
+ fpc_scen,
+ bft_ref,
+ bft_scen,
+ cft_ref,
+ cft_scen,
+ lat,
+ lon,
+ cell_area,
+ file = data_file_out)
+}
+
+
+################# biome (dis-)aggregation functions ##################
+
+#' Get biome names
+#'
+#' Returns biome names with variable length (abbreviated, short, or full)
+#'
+#' @param biome_name_length integer chose from 1,2,3 for abbreviated, short,
+#' or full biome names
+#'
+#' @export
+get_biome_names <- function(biome_name_length = 2) {
+ biome_mapping <- utils::read.csv(
+ file = system.file(
+ "extdata",
+ "biomes.csv",
+ package = "biospheremetrics"
+ ),
+ sep = ";"
+ )
+
+ if (biome_name_length == 1) {
+ biome_class_names <- biome_mapping$abbreviation
+ } else if (biome_name_length == 2) {
+ biome_class_names <- biome_mapping$short_name
+ } else if (biome_name_length == 3) {
+ biome_class_names <- biome_mapping$name
+ } else {
+ stop(
+ "Value for parameter biome_name_length out of range 1,2,3 - ",
+ "was given as: ",
+ biome_name_length
+ )
+ }
+
+ return(biome_class_names)
+}
+
+
+#' Averages EcoRisk values across regions
+#'
+#' Returns the average value across either 4 regions or all (19) biomes for
+#' EcoRisk and each of the subcomponents for each
+#'
+#' @param data List object, of which every item should be disaggregated
+#' @param biome_class biome class list object as returned by classify_biomes
+#' @param type string controlling whether to return minimum, mean, maximum
+#' ("minmeanmax") or Q10,Q50,Q90 ("quantile") - default: "quantile"
+#' @param classes string for into how many regions should be disaggregated
+#' "4biomes" (tropics/temperate/boreal/arctic) or "allbiomes"
+#'
+#' @examples
+#' \dontrun{
+#' disaggregate_into_biomes(
+#' ecorisk = ecorisk,
+#' biome_class = biome_classes,
+#' type = "quantile", classes = "4biomes"
+#' )
+#' }
+#' @export
+disaggregate_into_biomes <- function(data, # nolint
+ biome_class,
+ type = "quantile",
+ classes = "4biomes") {
+ di <- dim(data[[1]])
+ comp_names <- names(data)
+
+ if (type == "minmeanmax") {
+ type_names <- c("min", "mean", "max")
+ } else if (type == "quantile") {
+ type_names <- c("Q10", "Q50", "Q90")
+ }
+
+ if (length(di) > 1) {
+ slices <- di[2]
+ } else {
+ slices <- 1
+ }
+
+ if (classes == "4biomes") {
+ tropics <- c(1, 2, 9, 10, 11)
+ temperate <- c(3, 4, 5, 12, 13, 14)
+ boreal <- c(6, 7, 8)
+ arctic <- c(15, 16)
+ cell_list <- list(
+ tropical_cells = which(biome_class$biome_id %in% tropics),
+ temperate_cells = which(biome_class$biome_id %in% temperate),
+ boreal_cells = which(biome_class$biome_id %in% boreal),
+ arctic_cells = which(biome_class$biome_id %in% arctic)
+ )
+ nclasses <- 4
+
+ } else if (classes == "allbiomes") {
+ nclasses <- max(unique(biome_class$biome_id))
+
+ } else {
+ stop(
+ "Unknown parameter classes: ",
+ classes,
+ ", should be either '4biomes' or 'allbiomes'"
+ )
+ }
+
+ data_dims <- length(data)
+
+ data_biomes <- array(0, dim = c(nclasses, data_dims, 3, slices))
+
+ if (classes == "4biomes") { # aggregate to trop/temp/boreal/arctic
+ for (s in 1:slices) {
+ for (b in 1:nclasses) {
+ for (c in 1:data_dims) {
+
+ if (type == "minmeanmax") {
+ data_biomes[b, c, , s] <- c(
+ min(data[[c]][cell_list[[b]], s], na.rm = TRUE),
+ mean(data[[c]][cell_list[[b]], s], na.rm = TRUE),
+ max(data[[c]][cell_list[[b]], s], na.rm = TRUE)
+ )
+
+ } else if (type == "quantile") {
+ data_biomes[b, c, , s] <- c(
+ stats::quantile(
+ data[[c]][cell_list[[b]], s],
+ probs = c(0.1, 0.5, 0.9),
+ na.rm = TRUE
+ )
+ )
+
+ } else {
+ stop(paste(
+ "type", type,
+ "unknown. please choose either 'quantile' or 'minmeanmax'"
+ ))
+ } # end if
+ } # end for
+ } # end for
+ } # end for
+
+ biome_names <- c("tropics", "temperate", "boreal", "arctic")
+ dimnames(data_biomes) <- list(biome_names, comp_names, type_names, 1:slices)
+
+ } else if (classes == "allbiomes") { # calculate all biomes separately
+ for (s in 1:slices) {
+ for (b in 1:nclasses) {
+ for (c in 1:data_dims) {
+
+ if (type == "minmeanmax") {
+ data_biomes[b, c, , s] <- c(
+ min(data[[c]][which(biome_class$biome_id == b), s], na.rm = TRUE),
+ mean(data[[c]][which(biome_class$biome_id == b), s], na.rm = TRUE), # nolint
+ max(data[[c]][which(biome_class$biome_id == b), s], na.rm = TRUE)
+ )
+
+ } else if (type == "quantile") {
+ data_biomes[b, c, , s] <- c(
+ stats::quantile(
+ data[[c]][which(biome_class$biome_id == b), s],
+ probs = c(0.1, 0.5, 0.9),
+ na.rm = TRUE
+ )
+ )
+
+ } else {
+ stop(paste(
+ "type", type,
+ "unknown. please choose either 'quantile' or 'minmeanmax'"
+ ))
+ } # end if
+ } # end for
+ } # end for
+ } # end for
+
+ biome_names <- biome_class$biome_names
+ dimnames(data_biomes) <- list(biome_names, comp_names, type_names, 1:slices)
+
+ } else {
+ stop(
+ "Unknown parameter classes: ",
+ classes,
+ ", should be either '4biomes' or 'allbiomes'"
+ )
+ }
+ return(drop(data_biomes))
+}
+
+
+#' Calculate ecorisk with each biomes average cell
+#'
+#' Function to calculate ecorisk with each biomes average cell
+#' as a measure of internal variability
+#'
+#' @param biome_classes biome classes object as returned by classify biomes,
+#' calculated for data_file_base
+#' @param data_file_base base EcoRisk to compute differences with (only ref is
+#' relevant)
+#' @param intra_biome_distrib_file file to additionally write results to
+#' @param create create new modified files, or read already existing ones?
+#' @param res how finegrained the distribution should be (resolution)
+#' @param plotting whether plots for each biome should be created
+#' @param plot_folder folder to plot into
+#' @param time_span_reference suitable 30 year reference period (e.g.
+#' c(1901,1930), c(1550,1579))
+
+#' @return data object with distibution - dim: c(biomes,ecorisk_variables,bins)
+#'
+#' @export
+calculate_within_biome_diffs <- function(biome_classes, # nolint
+ data_file_base,
+ intra_biome_distrib_file,
+ create = FALSE,
+ res = 0.05,
+ plotting = FALSE,
+ plot_folder,
+ time_span_reference,
+ vars_ecorisk) {
+ biomes_abbrv <- get_biome_names(1)
+
+ # nbiomes, nEcoRiskvars, nHISTclasses
+ intra_biome_distrib <- array(
+ 0,
+ dim = c(length(biome_classes$biome_names), 10, 1 / res)
+ )
+
+ # start
+ for (b in sort(unique(biome_classes$biome_id))) {
+ filebase <- strsplit(data_file_base, "_data.RData")[[1]]
+ print(
+ paste0(
+ "Calculating differences with biome ", b, " (",
+ biome_classes$biome_names[b], ")")
+ )
+
+ data_file <- paste0(
+ filebase, "_compared_to_average_", biomes_abbrv[b], "_data.RData"
+ )
+ ecorisk_file <- paste0(
+ filebase, "_compared_to_average_", biomes_abbrv[b], "_gamma.RData"
+ )
+
+ if (create) {
+ replace_ref_data_with_average_ref_biome_cell(
+ data_file_in = data_file_base,
+ data_file_out = data_file,
+ biome_classes_in = biome_classes,
+ ref_biom = b
+ )
+ ecorisk <- ecorisk_wrapper(
+ # does not need to be specified, as data is read from file
+ path_ref = NULL,
+ # does not need to be specified, as data is read from file
+ path_scen = NULL,
+ read_saved_data = TRUE,
+ save_data = data_file,
+ save_ecorisk = ecorisk_file,
+ varnames = vars_ecorisk,
+ time_span_reference = time_span_reference,
+ time_span_scenario = time_span_reference,
+ dimensions_only_local = FALSE
+ )
+ } else {
+ # contains ecorisk list object
+ load(ecorisk_file)
+ }
+
+ # compute average values per focus biom
+ ref_cells <- which(biome_classes$biome_id == b)
+ for (v in 1:10) {
+ intra_biome_distrib[b, v, ] <- graphics::hist(
+ ecorisk[[v]][ref_cells], breaks = seq(0, 1, res), plot = FALSE
+ )$counts
+ intra_biome_distrib[b, v, ] <- (
+ intra_biome_distrib[b, v, ] / sum(intra_biome_distrib[b, v, ])
+ )
+ }
+
+ if (plotting) {
+ plot_ecorisk_map(
+ file = paste0(
+ plot_folder, "EcoRisk/compare_ecorisk_to_", biomes_abbrv[b], ".png"
+ ),
+ focus_biome = b, biome_classes = biome_classes$biome_id,
+ data = ecorisk$ecorisk_total, title = biome_classes$biome_names[b],
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 2,
+ leg_yes = TRUE
+ )
+
+ plot_ecorisk_map(
+ file = paste0(
+ plot_folder, "EcoRisk/compare_vegetation_structure_change_to_", biomes_abbrv[b], ".png" # nolint
+ ),
+ focus_biome = b, biome_classes = biome_classes$biome_id,
+ data = ecorisk$vegetation_structure_change,
+ title = biome_classes$biome_names[b],
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 2,
+ leg_yes = TRUE
+ )
+
+ plot_ecorisk_map(
+ file = paste0(
+ plot_folder, "EcoRisk/compare_gi_to_", biomes_abbrv[b], ".png"
+ ),
+ focus_biome = b,
+ biome_classes = biome_classes$biome_id,
+ data = ecorisk$global_importance,
+ title = biome_classes$biome_names[b],
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 2,
+ leg_yes = TRUE
+ )
+
+ plot_ecorisk_map(
+ file = paste0(
+ plot_folder, "EcoRisk/compare_lc_to_", biomes_abbrv[b], ".png"
+ ),
+ focus_biome = b,
+ biome_classes = biome_classes$biome_id,
+ data = ecorisk$local_change,
+ title = biome_classes$biome_names[b],
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 2,
+ leg_yes = TRUE
+ )
+
+ plot_ecorisk_map(
+ file = paste0(
+ plot_folder, "EcoRisk/compare_eb_to_", biomes_abbrv[b], ".png"
+ ),
+ focus_biome = b,
+ biome_classes = biome_classes$biome_id,
+ data = ecorisk$ecosystem_balance,
+ title = biome_classes$biome_names[b],
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 2,
+ leg_yes = TRUE
+ )
+ } # end if plotting
+ }
+
+ ecorisk_dimensions <- c(
+ "ecorisk_total", "vegetation_structure_change", "local_change",
+ "global_importance", "ecosystem_balance", "carbon_stocks", "carbon_fluxes",
+ "water_fluxes", "nitrogen_stocks", "nitrogen_fluxes"
+ )
+
+ dim(intra_biome_distrib) <- c(biome = 19, variable = 10, bin = 1 / res)
+ dimnames(intra_biome_distrib) <- list(
+ biome = biomes_abbrv, variable = ecorisk_dimensions, bin = seq(res, 1, res)
+ )
+ save(intra_biome_distrib, file = intra_biome_distrib_file)
+
+ return(intra_biome_distrib)
+}
+
+
+################# EcoRisk plotting functions ##################
+
+#' Plot distribution of similarity within biomes
+#'
+#' Function to plot the distribution of similarity within biomes
+#'
+#' @param data data object with distibution - as returned by
+#' calculateWithInBiomeDiffs for each subcategory of ecorisk.
+#' dim: c(biomes,bins)
+#' @param biomes_abbrv to mask the focus_biome from
+#' @param scale scaling factor for distribution. defaults to 1
+#' @param title character string title for plot, default empty
+#' @param legendtitle character string legend title, default empty
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_biome_internal_distribution_to_screen <- function( # nolint
+ data,
+ biomes_abbrv,
+ title = "",
+ legendtitle = "",
+ scale = 1,
+ palette = NULL
+) {
+ di <- dim(data)
+ bins <- di["bin"]
+ res <- 1 / bins
+ biomes <- di["biome"]
+
+ if (is.null(palette)) {
+ palette <- c(
+ "white", "steelblue1", "royalblue",
+ RColorBrewer::brewer.pal(7, "YlOrRd")
+ )
+ }
+ col_index <- floor(seq(res / 2, 1 - res / 2, res) * 10) + 1
+
+ graphics::par(mar = c(2, 4, 0, 0), oma = c(0, 0, 0, 0)) # bltr
+ graphics::plot(NA, xlim = c(0, 1), ylim = c(0, 20), xlab = "EcoRisk",
+ main = title, axes = FALSE, ylab = "")
+ graphics::axis(side = 2, labels = FALSE, at = 1:biomes)
+ brks <- seq(0, 1, 0.1)
+ fields::image.plot(
+ legend.only = TRUE, col = palette,
+ useRaster = FALSE, breaks = brks, horizontal = TRUE,
+ lab.breaks = brks, legend.shrink = 0.925,
+ legend.args = list("", side = 3, font = 2, line = 1.5)
+ )
+ graphics::mtext(biomes_abbrv, side = 2, line = 1, at = 1:biomes, las = 2)
+ for (b in 1:biomes) {
+ graphics::rect(
+ xleft = seq(0, 1 - res, res),
+ xright = seq(res, 1, res),
+ ybottom = b,
+ ytop = b + data[b, ] * scale,
+ col = palette[col_index]
+ )
+ }
+}
+
+
+#' Plot to file distribution of similarity within biomes
+#'
+#' Function to plot to file the distribution of similarity within biomes
+#'
+#' @param data data object with distibution - as returned by
+#' calculateWithInBiomeDiffs. dim: c(biomes,bins)
+#' @param file to write into
+#' @param biomes_abbrv to mask the focus_biome from
+#' @param scale scaling factor for distribution. defaults to 1
+#' @param title character string title for plot, default empty
+#' @param legendtitle character string legend title, default empty
+#' @param eps write as eps or png (default: FALSE -> png)
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_biome_internal_distribution <- function( # nolint
+ data,
+ file,
+ biomes_abbrv,
+ scale,
+ title = "",
+ legendtitle = "",
+ eps = FALSE,
+ palette = NULL
+) {
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 8,
+ height = 16, paper = "special")
+ } else {
+ grDevices::png(file, width = 3, height = 6, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+ plot_biome_internal_distribution_to_screen(
+ data = data, biomes_abbrv = biomes_abbrv, scale = scale, title = title,
+ legendtitle = legendtitle, palette = palette
+ )
+ grDevices::dev.off()
+}
+
+
+#' Plot EcoRisk map to screen
+#'
+#' Function to plot a global map of EcoRisk values [0-1] per grid cell to screen
+#'
+#' @param data folder of reference run
+#' @param focus_biome highlight the biome with this id and desaturate all other
+#' (default NULL -- no highlight)
+#' @param biome_classes to mask the focus_biome from
+#' @param title character string title for plot, default empty
+#' @param legendtitle character string legend title
+#' @param leg_yes logical. whether to plot legend or not. defaults to TRUE
+#' @param leg_scale scaling factor for legend. defaults to 1
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_eco_riskmap_to_screen <- function(
+ data,
+ focus_biome = NULL,
+ biome_classes = NULL,
+ title = "",
+ legendtitle = "",
+ title_size = 1,
+ leg_yes = TRUE,
+ palette = NULL
+) {
+ brks <- seq(0, 1, 0.1)
+ data[data < brks[1]] <- brks[1]
+ data[data > brks[length(brks)]] <- brks[length(brks)]
+
+ if (is.null(palette)) {
+ palette <- c(
+ "white", "steelblue1", "royalblue",
+ RColorBrewer::brewer.pal(7, "YlOrRd")
+ )
+ }
+
+ if (!is.null(focus_biome)) {
+ focus <- data
+ focus[!(biome_classes == focus_biome)] <- NA
+ palette_low_sat <- grDevices::adjustcolor(palette, alpha.f = 0.25)
+ ra_f <- raster::raster(ncols = 720, nrows = 360)
+ ra_f[raster::cellFromXY(ra_f, cbind(lon, lat))] <- focus
+ }
+
+ ra <- raster::raster(ncols = 720, nrows = 360)
+ ra[raster::cellFromXY(ra, cbind(lon, lat))] <- data
+ range <- range(data)
+ extent <- raster::extent(c(-180, 180, -60, 90))
+ graphics::par(mar = c(0, 0, 1, 3), oma = c(0, 0, 0, 0), bty = "n")
+
+ if (is.null(focus_biome)) {
+ raster::plot(ra, ext = extent, breaks = brks, col = palette, main = "",
+ legend = FALSE, axes = FALSE)
+
+ } else {
+ raster::plot(ra, ext = extent, breaks = brks, col = palette_low_sat,
+ main = "", legend = FALSE, axes = FALSE)
+ raster::plot(ra_f, ext = extent, breaks = brks, col = palette, main = "",
+ legend = FALSE, axes = FALSE, add = TRUE)
+ }
+
+ title(main = title, line = -2, cex.main = title_size)
+ maps::map("world", add = TRUE, res = 0.4, lwd = 0.25, ylim = c(-60, 90))
+
+ if (leg_yes) {
+ fields::image.plot(
+ legend.only = TRUE, zlim = range, col = palette, breaks = brks,
+ lab.breaks = brks, legend.shrink = 0.7,
+ legend.args = list(legendtitle, side = 3, font = 2, line = 1)
+ ) # removed zlim
+ }
+}
+
+
+#' Plot EcoRisk map to file
+#'
+#' Function to plot a global map of EcoRisk values [0-1] per grid cell to file
+#'
+#' @param data folder of reference run
+#' @param file to write into
+#' @param focus_biome highlight the biome with this id and desaturate all other
+#' (default NULL -- no highlight)
+#' @param biome_classes to mask the focus_biome from
+#' @param title character string title for plot, default empty
+#' @param legendtitle character string legend title
+#' @param eps write as eps or png
+#' @param leg_yes logical. whether to plot legend or not. defaults to TRUE
+#' @param leg_scale scaling factor for legend. defaults to 1
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_map <- function(
+ data,
+ file,
+ focus_biome = NULL,
+ biome_classes = NULL,
+ title = "",
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 1,
+ leg_yes = TRUE,
+ palette = NULL
+) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+
+ } else {
+ grDevices::png(file, width = 7.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+
+ plot_eco_riskmap_to_screen(
+ data = data,
+ focus_biome = focus_biome,
+ biome_classes = biome_classes,
+ title = title,
+ legendtitle = legendtitle,
+ title_size = title_size,
+ leg_yes = leg_yes,
+ palette = palette
+ )
+
+ grDevices::dev.off()
+}
+
+
+#' Plot radial EcoRisk plot to screen
+#'
+#' Function to plot an aggregated radial status of EcoRisk values [0-1]
+#' for the different sub-categories to screen
+#'
+#' @param data EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+#' 3[min,mean,max])
+#' @param title character string title for plot, default empty
+#' @param zoom scaling factor for circle plot. defaults to 1
+#' @param type plot type, 'legend1' for variable and color legend,
+#' 'legend2' for value legend, or 'regular' (default setting)
+#' for the regular EcoRisk plot
+#' @param title_size scaling factor for tile. defaults to 1
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_radial_to_screen <- function(data, # nolint
+ title = "",
+ zoom = 1.0,
+ type = "regular",
+ title_size = 2,
+ titleline = -2,
+ use_quantile = TRUE) {
+
+ ecorisk_dims <- length(data[, 1])
+ if (ecorisk_dims == 11) {
+ names <- c(
+ ecorisk = "ecorisk",
+ deltav = "vegetation\nstructure", local = "local\nchange",
+ global = "global\nimportance", balance = "ecosystem\nbalance",
+ cstocks = "carbon\nstocks", cfluxes = "carbon\nfluxes",
+ wstocks = "water stocks", wfluxes = "water fluxes",
+ nstocks = "nitrogen\nstocks", nfluxes = "nitrogen\nfluxes"
+ )
+ # c(blue-green, yellow, violet, red, blue, orange, green, pink, grey,
+ # purple, green-blue, yellow-orange)
+
+ set <- RColorBrewer::brewer.pal(12, "Set3")
+ colz <- set[c(4, 7, 8, 11, 2, 3, 10, 5, 1, 12, 6)] # missing 2,9
+ # ecorisk vs lc gi eb cs cf ws wf ns nf
+ angles <- matrix(
+ c(90, 270, 216, 252, 180, 216, 144, 180, 108, 144, 0, 30, -30, 0, -60,
+ -30, -90, -60, 60, 90, 30, 60),
+ byrow = TRUE,
+ nrow = length(colz)
+ )
+
+ } else if (ecorisk_dims == 10) {
+ names <- c(
+ ecorisk = "ecorisk", deltav = "vegetation\nstructure",
+ local = "local\nchange", global = "global\nimportance",
+ balance = "ecosystem\nbalance", cstocks = "carbon stocks",
+ cfluxes = "carbon fluxes", wfluxes = "water fluxes",
+ nstocks = "nitrogen\nstocks", nfluxes = "nitrogen fluxes"
+ )
+
+ # c(blue-green, yellow, violet, red, blue, orange, green, pink, grey,
+ # purple, green-blue, yellow-orange)
+
+ set <- RColorBrewer::brewer.pal(12, "Set3")
+ colz <- set[c(4, 7, 8, 11, 1, 3, 10, 5, 12, 6)]
+
+ # ecorisk vs lc gi eb cs cf wf ns nf
+ angles <- matrix(
+ c(90, 270, 216, 252, 180, 216, 144, 180, 108, 144, -18, 18, -54, -18, -90,
+ -54, 54, 90, 18, 54),
+ byrow = TRUE,
+ nrow = length(colz)
+ )
+
+ } else if (ecorisk_dims == 8) {
+ names <- c(
+ ecorisk = "ecorisk", deltav = "vegetation\nstructure",
+ local = "local\nchange", global = "global\nimportance",
+ balance = "ecosystem\nbalance", cstocks = "carbon\nstocks",
+ cfluxes = "carbon fluxes", wfluxes = "water fluxes"
+ )
+ colz <- c(
+ "darkgoldenrod", RColorBrewer::brewer.pal(5, "Greens")[5],
+ RColorBrewer::brewer.pal(6, "Set1")[seq(2, 6, by = 2)],
+ rev(RColorBrewer::brewer.pal(6, "Oranges")[c(4, 5)]),
+ RColorBrewer::brewer.pal(6, "PuBu")[6]
+ )
+ angles <- matrix(
+ c(234, 270, 198, 234, 162, 198, 126, 162, 90, 126, 18, 54, -18, 18, -54,
+ -18),
+ byrow = TRUE,
+ nrow = length(colz)
+ )
+
+ } else {
+ stop("Unknown number of dimensions for ecorisk data:", ecorisk_dims)
+ }
+
+ graphics::par(oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0))
+ graphics::plot(c(-zoom, zoom), c(-zoom, zoom), type = "n", axes = FALSE,
+ ann = FALSE, asp = 1, main = "")
+ graphics::title(main = title, line = titleline, cex.main = title_size)
+
+ if (type == "legend1") {
+ circlize::draw.sector(0, 360, rou1 = 1)
+ ro <- c(1, 1.1, 0.8, 1.1, 0.8, 1, 1, 1, 1, 1, 1)
+
+ for (i in seq_along(angles[, 1])) {
+ circlize::draw.sector(
+ start.degree = angles[i, 1] + 90,
+ end.degree = angles[i, 2] + 90,
+ col = colz[i],
+ clock.wise = FALSE,
+ rou1 = 0,
+ rou2 = ro[i],
+ border = "black"
+ )
+ }
+
+ if (ecorisk_dims == 11) {
+ graphics::text(names,
+ # er vs lc gi eb cs cf ws wf ns nf
+ x = c(1.1, 1.0, 0.2, -0.8, -1.6, -0.6, 0.1, 0.8, 1.05, -1.7, -1.4),
+ y = c(-0.15, -0.9, -1.3, -1.3, -0.9, 1.2, 1.2, 0.85, 0.25, 0.3, 0.85),
+ adj = 0
+ )
+
+ } else if (ecorisk_dims == 10) {
+ graphics::text(names,
+ x = c(1.1, 1.0, 0.2, -0.8, -1.6, -0.4, 0.7, 1.05, -1.7, -1.5),
+ y = c(-0.15, -0.9, -1.3, -1.3, -0.9, 1.2, 1, 0.25, 0.3, 1), adj = 0
+ )
+
+ } else if (ecorisk_dims == 8) {
+ graphics::text(
+ names,
+ x = c(1.1, 0.6, -0.2, -1.2, -1.7, -1.5, -0.4, 0.7),
+ y = c(-0.3, -1.1, -1.3, -1, -0.5, 1, 1.2, 1),
+ adj = 0
+ )
+
+ } else {
+ stop("Unknown number of dimensions for ecorisk data:", ecorisk_dims)
+ }
+
+ # line lc
+ circlize::draw.sector(start.degree = (angles[3, 1] + angles[3, 2]) / 2 + 90,
+ end.degree = (angles[3, 1] + angles[3, 2]) / 2 + 90,
+ rou1 = 0.7,
+ rou2 = 1.1)
+ # line ecorisk
+ circlize::draw.sector(
+ start.degree = -9,
+ end.degree = -9,
+ rou1 = 0.9,
+ rou2 = 1.05
+ )
+ # line eb
+ circlize::draw.sector(start.degree = (angles[5, 1] + angles[5, 2]) / 2 + 90,
+ end.degree = (angles[5, 1] + angles[5, 2]) / 2 + 90, rou1 = 0.7,
+ rou2 = 1.1)
+ circlize::draw.sector(start.degree = 180,
+ end.degree = 180,
+ clock.wise = FALSE,
+ rou1 = -1.2,
+ rou2 = 1.2,
+ border = "black",
+ lwd = 2)
+
+ } else if (type == "legend2") {
+ graphics::text("+", x = 0, y = 0)
+ circlize::draw.sector(0, 360, rou1 = 1)
+ circlize::draw.sector(0, 360, rou1 = 0.65)
+ circlize::draw.sector(0, 360, rou1 = 0.3)
+ # sector
+ circlize::draw.sector(start.degree = -18 + 90,
+ end.degree = 18 + 90,
+ clock.wise = FALSE,
+ rou1 = 0.55,
+ border = "black")
+ # uncertainty arrow
+ circlize::draw.sector(start.degree = 90,
+ end.degree = 90,
+ clock.wise = FALSE,
+ rou1 = 0.4,
+ rou2 = 0.8,
+ border = "black")
+ # uncertainty lower
+ circlize::draw.sector(start.degree = -9 + 90,
+ end.degree = 9 + 90,
+ clock.wise = FALSE,
+ rou1 = 0.8,
+ rou2 = 0.8,
+ border = "black")
+ # uncertainty upper
+ circlize::draw.sector(start.degree = -9 + 90,
+ end.degree = 9 + 90,
+ clock.wise = FALSE,
+ rou1 = 0.4,
+ rou2 = 0.4,
+ border = "black")
+ # 0.3
+ circlize::draw.sector(start.degree = 270 - 270,
+ end.degree = 270 - 270,
+ clock.wise = FALSE,
+ rou1 = 0.3,
+ rou2 = 1.3,
+ border = "black",
+ lty = "dashed")
+ # 0.65
+ circlize::draw.sector(start.degree = 280 - 270,
+ end.degree = 280 - 270,
+ clock.wise = FALSE,
+ rou1 = 0.65,
+ rou2 = 1.3,
+ border = "black",
+ lty = "dashed")
+ # 1.0
+ circlize::draw.sector(start.degree = 290 - 270,
+ end.degree = 290 - 270,
+ clock.wise = FALSE,
+ rou1 = 1,
+ rou2 = 1.3,
+ border = "black",
+ lty = "dashed")
+ graphics::text(c("0.3", "0.65", "1"),
+ x = c(1.4, 1.45, 1.25),
+ y = c(0, 0.25, 0.45))
+
+ # plot how the whiskers are calculated
+ # quantile case
+ if (use_quantile) {
+ graphics::text(c("Q90", "Q50", "Q10"),
+ x = c(-0.3, -0.29, -0.26),
+ y = c(0.8, 0.48, 0.35),
+ cex = 0.7)
+
+ # minmeanmax case
+ } else {
+ graphics::text(c("max", "mean", "min"),
+ x = c(-0.3, -0.29, -0.26),
+ y = c(0.8, 0.48, 0.35),
+ cex = 0.7)
+ }
+
+ } else if (type == "regular") {
+
+ circlize::draw.sector(180, 360, rou1 = 1, col = "gray80")
+
+ for (i in seq_along(angles[, 1])) {
+ mangle <- mean(angles[i, ])
+ if (i == 1) mangle <- -98
+ dmin <- data[i, 1]
+ dmedian <- data[i, 2]
+ dmax <- data[i, 3]
+ circlize::draw.sector(start.degree = angles[i, 1] + 90,
+ end.degree = angles[i, 2] + 90, col = colz[i],
+ rou1 = dmedian,
+ clock.wise = FALSE,
+ border = "black")
+ # uncertainty arrow
+ circlize::draw.sector(start.degree = mangle + 90,
+ end.degree = mangle + 90,
+ clock.wise = FALSE,
+ rou1 = dmin,
+ rou2 = dmax,
+ border = "black")
+ circlize::draw.sector(start.degree = mangle - 9 + 90,
+ end.degree = mangle + 9 + 90,
+ clock.wise = FALSE,
+ rou1 = dmin,
+ rou2 = dmin,
+ border = "black")
+ # uncertainty upper
+ circlize::draw.sector(start.degree = mangle - 9 + 90,
+ end.degree = mangle + 9 + 90,
+ clock.wise = FALSE,
+ rou1 = dmax,
+ rou2 = dmax,
+ border = "black")
+ }
+ circlize::draw.sector(0, 360, rou1 = 1)
+ circlize::draw.sector(0, 360, rou1 = 0.6)
+ circlize::draw.sector(0, 360, rou1 = 0.3)
+ circlize::draw.sector(start.degree = 180,
+ end.degree = 180,
+ clock.wise = FALSE,
+ rou1 = -1.2,
+ rou2 = 1.2,
+ border = "black",
+ lwd = 2)
+ } else {
+ stop("Unknown type ", type,
+ ". Please use 'legend1' for variable and color legend,
+ 'legend2' for value legend, or 'regular' (default setting) ",
+ "for the regular ecorisk plot.")
+ }
+}
+
+
+#' Plot radial EcoRisk plot to file
+#'
+#' Function to plot an aggregated radial status of EcoRisk values [0-1]
+#' for the different sub-categories to file
+#'
+#' @param data EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+#' 3[min,mean,max])
+#' @param file to write into
+#' @param title character string title for plot, default empty
+#' @param type plot type, 'legend1' for variable and color legend,
+#' 'legend2' for value legend, or 'regular' (default setting)
+#' for the regular EcoRisk plot
+#' @param eps write as eps or png
+#' @param leg_yes logical. whether to plot legend or not. defaults to TRUE
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_radial <- function(data,
+ file,
+ title = "",
+ leg_yes = TRUE,
+ eps = FALSE,
+ use_quantile = TRUE) {
+ # param data EcoRisk data array c(8[ncomponents],3[min,median,max])
+ # param title title for plot
+ # param type plot type, 'legend1' for variable and color legend, 'legend2'
+ # for value legend, or 'regular' (default setting) for the regular EcoRisk
+ # plot
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+ if (length(which(data < 0 | data > 1)) > 0) {
+ print(
+ "Warning: there are values in data outside the expected EcoRisk range [0..1]." # nolint
+ )
+ }
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+
+ } else {
+ grDevices::png(file, width = 7.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+
+ # adjust the margins, dependent on whether a legend should be plotted or not
+ graphics::par(fig = c(0, 0.7, 0, 1)) # , oma=c(0,0,0,0),mar=c(0,0,0,0))
+
+ # plot main EcoRisk radial
+ plot_ecorisk_radial_to_screen(data = data, title = title, zoom = 1.0,
+ type = "regular")
+
+ if (leg_yes) {
+ graphics::par(fig = c(0.7, 1, 0, 0.5), new = TRUE)
+ plot_ecorisk_radial_to_screen(data = data, title = "", zoom = 1.5,
+ type = "legend1")
+ graphics::par(fig = c(0.7, 1, 0.5, 1), new = TRUE)
+ plot_ecorisk_radial_to_screen(data = data, title = "", zoom = 1.5,
+ type = "legend2", use_quantile = use_quantile)
+ }
+ grDevices::dev.off()
+}
+
+
+#' Plot timeline of EcoRisk variables to screen
+#'
+#' Function to plot timeline of EcoRisk variables to screen
+#'
+#' @param data EcoRisk data array
+#' c(4/19[biomes],8/10[nEcoRiskcomponents],3[min,mean,max],timeslices)
+#' @param timerange of the data input
+#' @param yrange range for y axis default c(0,1)
+#' @param leg_yes plot legend (default TRUE)
+#'
+#' @return None
+#'
+#' @export
+plot_overtime_to_screen <- function(data,
+ timerange,
+ yrange = c(0, 1),
+ leg_yes = TRUE,
+ leg_only = FALSE,
+ varnames = NULL) {
+ ecorisk_dims <- dim(data)[1]
+
+ if (is.null(varnames)) {
+ if (ecorisk_dims == 10) {
+ names <- c(
+ ecorisk = "ecorisk", deltav = "vegetation structure",
+ local = "local change", global = "global importance",
+ balance = "ecosystem balance", cstocks = "carbon stocks",
+ cfluxes = "carbon fluxes", wfluxes = "water fluxes",
+ nstocks = "nitrogen stocks", nfluxes = "nitrogen fluxes"
+ )
+ # c(blue-green, yellow, violet, red, blue, orange, green, pink, grey,
+ # purple, green-blue, yellow-orange)
+ set <- RColorBrewer::brewer.pal(12, "Set3")
+ colz <- set[c(4, 7, 8, 11, 1, 3, 10, 5, 12, 6)]
+
+ } else if (ecorisk_dims == 8) {
+ names <- c(
+ ecorisk = "ecorisk", deltav = "vegetation structure",
+ local = "local change", global = "global importance",
+ balance = "ecosystem balance", cstocks = "carbon stocks",
+ cfluxes = "carbon fluxes", wfluxes = "water fluxes"
+ )
+ colz <- c(
+ "darkgoldenrod", RColorBrewer::brewer.pal(5, "Greens")[5],
+ RColorBrewer::brewer.pal(6, "Set1")[seq(2, 6, by = 2)],
+ rev(RColorBrewer::brewer.pal(6, "Oranges")[c(4, 5)]),
+ RColorBrewer::brewer.pal(6, "PuBu")[6]
+ )
+
+ } else {
+ stop("Unknown number of dimensions for ecorisk data: ", ecorisk_dims)
+ }
+ } else {
+ names <- varnames
+ colz <- RColorBrewer::brewer.pal(length(names), "Set2")
+ }
+ years <- timerange[1]:timerange[2]
+ if (leg_only) {
+ graphics::plot(NA, ylim = c(yrange[1], yrange[2]), cex.axis = 1,
+ axes = FALSE, xlab = "", ylab = "")
+
+ graphics::legend("center", legend = names, fill = colz, border = colz)
+ } else {
+ graphics::plot(NA, xlim = timerange, ylim = c(yrange[1], yrange[2]),
+ cex.axis = 1, xlab = "", ylab = "")
+ for (i in 1:ecorisk_dims) {
+ if (i == 1) {
+ lines(x = years, y = data[i, 2, ], col = colz[i], lwd = 4)
+ } else {
+ lines(x = years, y = data[i, 2, ], col = colz[i], lwd = 2)
+ }
+ }
+ if (leg_yes) graphics::legend("topleft", legend = names, fill = colz)
+ }
+}
+
+#' Plot timeline of EcoRisk variables as panel to file with 4/16 biomes
+#'
+#' Function to plot a panel of 4/16 timelines per biome aggregated EcoRisk
+#' values [0-1]
+#' to file
+#'
+#' @param data EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+#' 3[min,mean,max])
+#' @param biome_names names of biomes
+#' @param file to write into
+#' @param yrange range for y axis (default c(0,1))
+#' @param timerange of the data input
+#' @param eps write as eps or png
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_over_time_panel <- function(data, # nolint
+ biome_names,
+ file,
+ yrange = c(0, 1),
+ timerange,
+ eps = FALSE,
+ varnames = NULL) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ if (length(which(data < 0 | data > 1)) > 0) {
+ print("Warning: values in data outside the expected EcoRisk range [0..1].")
+ }
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file,
+ horizontal = FALSE, onefile = FALSE, width = 15,
+ height = 10, paper = "special"
+ )
+
+ } else {
+ grDevices::png(file,
+ width = 5.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo"
+ )
+ }
+
+ d <- length(data[, 1, 1, 1])
+ graphics::par(oma = c(0, 0, 0, 0), mar = c(3, 2, 0.5, 0))
+ if (d == 16 | d == 4) {
+ k <- sqrt(d)
+ xs <- seq(0, 0.8, length.out = k + 1)
+ ys <- seq(0.98, 0, length.out = k + 1)
+
+ for (x in 1:k) {
+ for (y in 1:k) {
+ if (x == 1 & y == 1) {
+ graphics::par(
+ fig = c(xs[x], xs[x + 1], ys[y + 1], ys[y]),
+ xpd = TRUE
+ )
+ } else {
+ graphics::par(fig = c(xs[x], xs[x + 1], ys[y + 1], ys[y]), xpd = TRUE,
+ new = TRUE)
+ }
+ plot_overtime_to_screen(
+ data = data[(x - 1) * k + y, , , ],
+ timerange = timerange, yrange = yrange,
+ leg_yes = FALSE, varnames = varnames
+ )
+ graphics::mtext(
+ text = biome_names[(x - 1) * k + y], side = 3,
+ line = 0, cex = 1, font = 2
+ )
+ }
+ }
+ } else {
+ stop(paste("Unknown number of biomes: ", length(data[, 1, 1, 1])))
+ }
+ # legend
+
+ graphics::par(fig = c(0.8, 1, 0.5, 1.0), new = TRUE, oma = c(0, 0, 0, 0),
+ mar = c(0, 0, 0, 0))
+ graphics::plot(NA, axes = FALSE, ylim = c(0, 1), xlim = c(0, 1))
+ if (d == 16) {
+ graphics::text(
+ x = 0.1,
+ y = seq(0.95, 0.05, length.out = length(get_biome_names(1))),
+ labels = paste0(get_biome_names(1), " : ", get_biome_names(2)),
+ cex = 0.7, adj = 0
+ )
+ }
+ graphics::par(fig = c(0.8, 1, 0.0, 0.5), new = TRUE, oma = c(0, 0, 0, 0),
+ mar = c(0, 0, 0, 0))
+
+ if (is.null(varnames)) {
+ plot_overtime_to_screen(data = data[1, , , ], timerange = timerange,
+ leg_yes = FALSE, leg_only = TRUE)
+
+ } else {
+ graphics::plot(NA, axes = FALSE, ylim = c(0, 1), xlim = c(0, 1))
+ colz <- RColorBrewer::brewer.pal(length(varnames), "Set2")
+ graphics::legend("center", legend = varnames, fill = colz, cex = 1)
+ }
+ grDevices::dev.off()
+}
+
+
+#' Plot radial EcoRisk panel to file with 4/16 biomes
+#'
+#' Function to plot an aggregated radial status of EcoRisk values [0-1]
+#' for the different sub-categories to file
+#'
+#' @param data EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+#' 3[min,mean,max])
+#' @param biome_names names of biomes
+#' @param file to write into
+#' @param use_quantile is it quantiles or minmeanmax data? - text for whiskers
+#' @param eps write as eps or png
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_radial_panel <- function(data,
+ biome_names,
+ file,
+ use_quantile = TRUE,
+ eps = FALSE) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ if (length(which(data < 0 | data > 1)) > 0) {
+ print("Warning: values in data outside the expected EcoRisk range [0..1].")
+ }
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file,
+ horizontal = FALSE, onefile = FALSE, width = 15,
+ height = 10, paper = "special"
+ )
+
+ } else {
+ grDevices::png(file,
+ width = 5.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo"
+ )
+ }
+
+ d <- length(data[, 1, 1])
+ if (d == 16 | d == 4) {
+ k <- sqrt(d)
+ xs <- seq(0, 0.6, length.out = k + 1)
+ ys <- seq(0.98, 0, length.out = k + 1)
+ for (x in 1:k) {
+ for (y in 1:k) {
+ if (x == 1 & y == 1) {
+ graphics::par(
+ fig = c(xs[x], xs[x + 1], ys[y + 1], ys[y]),
+ xpd = TRUE, oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0)
+ )
+ } else {
+ graphics::par(fig = c(xs[x], xs[x + 1], ys[y + 1], ys[y]), xpd = TRUE,
+ new = TRUE)
+ }
+ plot_ecorisk_radial_to_screen(
+ data = data[(x - 1) * k + y, , ],
+ title = "", zoom = 1.0, type = "regular"
+ )
+ graphics::mtext(
+ text = biome_names[(x - 1) * k + y], side = 3,
+ line = -0.5, cex = 1, font = 2
+ )
+ }
+ }
+ } else {
+ stop(paste("Unknown number of biomes: ", length(data[, 1, 1])))
+ }
+
+ # legend
+ graphics::par(fig = c(0.6, 1, 0.1, 0.6), new = TRUE)
+ plot_ecorisk_radial_to_screen(
+ data = data[1, , ], title = "",
+ zoom = 1.5, type = "legend1"
+ )
+
+ graphics::par(fig = c(0.6, 1, 0.5, 1.0), new = TRUE)
+ plot_ecorisk_radial_to_screen(
+ data = data[1, , ], title = "legend", zoom = 1.5,
+ type = "legend2", title_size = 1, use_quantile = use_quantile
+ )
+
+ grDevices::dev.off()
+}
+
+
+#' Plot biomes
+#'
+#' Function to plot biome classification
+#'
+#' @param biome_ids biome id as given by classify_biomes
+#' @param biome_name_length length of biome names in legend: 1 - abbreviation,
+#' 2 - short name, 3 - full biome name
+#' @param order legend order: either "plants" to first have forests, then
+#' grasslands, then tundra ..., or "zones" to go from north to south
+#' (default: "plants")
+#' @param title character string title for plot, default empty
+#' @param title_size size of title in cex units (defaukt: 2)
+#' @param leg_yes whether to plot legend (default: True)
+#' @param leg_scale size of legend in cex units (default 0.5)
+#'
+#' @return None
+#'
+#' @export
+plot_biomes_to_screen <- function(biome_ids,
+ biome_name_length = 1,
+ order_legend = "plants",
+ title = "",
+ title_size = 2,
+ leg_yes = TRUE,
+ leg_scale = 0.5) {
+
+ # setting up colors and biome names
+ colz <- c(
+ # warm
+ rev(RColorBrewer::brewer.pal(6, "YlOrBr")),
+ rev(RColorBrewer::brewer.pal(9, "YlGn")[c(3, 5, 7, 9)]),
+ # cold below forest
+ rev(RColorBrewer::brewer.pal(9, "GnBu"))[c(2:4, 6, 8, 9)],
+ # "lightblue" # Water
+ "white",
+ # Rocks & Ice
+ "lightgrey",
+ # montane Tundra/Grassland
+ "pink3"
+ )
+
+ if (order_legend == "plants") {
+ order_legend <- 1:19
+
+ } else if (order_legend == "zones") {
+ order_legend <- c(
+ 1, 2, 9, 10, 11, 3, 4, 5, 6, 12, 13, 14, 7, 8, 15, 16, 17, 18, 19
+ )
+
+ } else {
+ stop("Unknown value for parameter order_legend (plants or zones) - ",
+ "was given as: ", order_legend)
+ }
+ biome_class_cols <- (
+ colz[c(1, 2, 7, 8, 9, 10, 13, 12, 3, 4, 5, 14, 15, 16, 19, 11, 6, 17, 18)]
+ )
+ biome_class_names <- get_biome_names(biome_name_length)
+
+ if (!(length(biome_class_names) == length(biome_class_cols))) {
+ stop("Size of biome class names and colors do not match -- should be 18.")
+ }
+
+ # plotting
+ brks <- seq(min(biome_ids, na.rm = TRUE) - 0.5,
+ max(biome_ids, na.rm = TRUE) + 0.5,
+ 1)
+ ra <- raster::raster(ncols = 720, nrows = 360)
+ range <- range(biome_ids)
+ ra[raster::cellFromXY(ra, cbind(lon, lat))] <- biome_ids
+ extent <- raster::extent(c(-180, 180, -60, 90))
+ graphics::par(mar = c(0, 0, 0, 0), oma = c(0, 0, 0, 0), bty = "n")
+ raster::plot(ra, ext = extent, breaks = brks, col = biome_class_cols,
+ main = "", legend = FALSE, axes = FALSE)
+ graphics::title(main = title, line = -2, cex.main = title_size)
+ if (leg_yes) {
+ graphics::legend(x = -180, y = 27, legend = biome_class_names[order_legend],
+ fill = biome_class_cols[order_legend],
+ col = biome_class_cols[order_legend],
+ cex = leg_scale, bg = "white", bty = "o")
+ }
+ maps::map("world", add = TRUE, res = 0.4, lwd = 0.25, ylim = c(-60, 90))
+}
+
+
+#' Plot biomes to file
+#'
+#' Function to plot biome classification to file
+#'
+#' @param biome_ids biome id as given by classify_biomes
+#' @param biome_name_length length of biome names in legend: 1 - abbreviation,
+#' 2 - short name, 3 - full biome name
+#' @param order_legend legend order: either "plants" to first have forests, then
+#' grasslands, then tundra ..., or "zones" to go from north to south
+#' (default: "plants")
+#' @param file to write into
+#' @param title character string title for plot, default empty
+#' @param title_size size of title in cex units (defaukt: 2)
+#' @param leg_yes whether to plot legend (default: True)
+#' @param leg_scale size of legend in cex units (default 0.5)
+#' @param eps write as eps, replacing png in filename (default: True)
+#'
+#' @return None
+#'
+#' @export
+plot_biomes <- function(biome_ids,
+ biome_name_length = 1,
+ order_legend = "plants",
+ file,
+ title = "",
+ title_size = 2,
+ leg_yes = TRUE,
+ leg_scale = 1,
+ eps = FALSE) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+ } else {
+ grDevices::png(file, width = 7.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+ plot_biomes_to_screen(biome_ids = biome_ids,
+ biome_name_length = biome_name_length,
+ order_legend = order_legend,
+ title = title,
+ title_size = title_size,
+ leg_yes = leg_yes,
+ leg_scale = leg_scale)
+ grDevices::dev.off()
+}
+
+
+#' Plot radial EcoRisk plot to file with 4/16 biomes
+#'
+#' Function to plot an aggregated radial status of EcoRisk values [0-1]
+#' for the different sub-categories to file
+#'
+#' @param data input data with dimension c(nbiome_classes,3) -- Q10,Q50,Q90 each
+#' @param biome_class_names to write into
+#' @param title character string title for plot, default empty
+#' @param title_size character string title for plot
+#' @param leg_scale character string title for plot
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_biome_averages_to_screen <- function(
+ data,
+ biome_class_names,
+ title = "",
+ title_size = 2,
+ leg_scale = 0.5,
+ palette = NULL) {
+
+ # setting up colors and biome names
+ brks <- seq(0, 1, 0.1)
+ data[data < brks[1]] <- brks[1]
+ data[data > brks[length(brks)]] <- brks[length(brks)]
+
+ if (is.null(palette)) {
+ palette <- c(
+ "white", "steelblue1", "royalblue", RColorBrewer::brewer.pal(7, "YlOrRd")
+ )
+ }
+ col_index <- floor(data[, 2] * 10) + 1
+
+ if (!(length(biome_class_names) == dim(data)[1])) {
+ stop("Size of biome class names and data input do not match.")
+ }
+
+ # plotting
+ graphics::plot(NA, xlim = c(0, 1), ylim = c(0, 1), main = title, axes = FALSE,
+ cex.main = title_size, xlab = "", ylab = "")
+ graphics::legend(x = 0, y = 1, legend = biome_class_names,
+ fill = palette[col_index], col = palette[col_index],
+ border = palette[col_index], cex = leg_scale,
+ bg = "white", bty = "o")
+}
+
+#' Plot radial EcoRisk plot to file with 4/16 biomes
+#'
+#' Function to plot an aggregated radial status of EcoRisk values [0-1]
+#' for the different sub-categories to file
+#'
+#' @param data EcoRisk data array c(4[biomes],[nEcoRiskcomponents],
+#' 3[min,median,max])
+#' @param file to write into
+#' @param biome_class_names to write into
+#' @param title character string title for plot, default empty
+#' @param title_size character string title for plot
+#' @param leg_scale character string title for plot
+#' @param eps write as eps, replacing png in filename (default: True)
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_biome_averages <- function(data,
+ file,
+ biome_class_names,
+ title = "",
+ title_size = 2,
+ leg_scale = 1,
+ eps = FALSE,
+ palette = NULL) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+ } else {
+ grDevices::png(file, width = 4, height = 3, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+ plot_biome_averages_to_screen(
+ data = data, biome_class_names = biome_class_names,
+ title = title, title_size = title_size,
+ leg_scale = leg_scale, palette = palette
+ )
+ grDevices::dev.off()
+}
+
+#' Plot crosstable showing (dis-)similarity between average biome pixels
+#'
+#' Function to plot a crosstable showing (dis-)similarity between average
+#' biome pixels based on EcoRisk (former gamma) metric from LPJmL simulations
+#'
+#' @param data crosstable data as array with [nbiomes,nbiomes] and row/colnames
+#' @param lmar left margin for plot in lines (default: 3)
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_cross_table_to_screen <- function( # nolint
+ data,
+ lmar = 3,
+ palette = NULL
+) {
+ # data prep
+ data <- round(data, digits = 2)
+ x <- 1:ncol(data)
+ y <- 1:nrow(data)
+ centers <- expand.grid(y, x)
+ # coloring
+ if (is.null(palette)) {
+ palette <- c(
+ "white", "steelblue1", "royalblue", RColorBrewer::brewer.pal(7, "YlOrRd")
+ )
+ }
+ brks <- seq(0, 1, 0.1)
+
+ # plot margins
+ graphics::par(mar = c(0, lmar, 2, 0)) # bltr
+
+ graphics::image(x, y, t(data),
+ col = palette,
+ breaks = brks,
+ xaxt = "n",
+ yaxt = "n",
+ xlab = "",
+ ylab = "",
+ ylim = c(max(y) + 0.5, min(y) - 0.5)
+ )
+ graphics::text(centers[, 2], centers[, 1], c(data), col = "black")
+
+ # add margin text
+ graphics::mtext(attributes(data)$dimnames[[2]],
+ at = 1:ncol(data),
+ padj = -1)
+ graphics::mtext(attributes(data)$dimnames[[1]],
+ at = 1:nrow(data),
+ side = 2,
+ las = 1,
+ adj = 1,
+ line = 1)
+
+ # add black lines
+ graphics::abline(h = y + 0.5)
+ graphics::abline(v = x + 0.5)
+}
+
+
+#' Plot crosstable to file showing (dis-)similarity between average biome pixels
+#'
+#' Function to plot to file a crosstable showing (dis-)similarity between
+#' average biome pixels based on EcoRisk (former Gamma) metric from LPJmL
+#' simulations
+#'
+#' @param data crosstable data as array with [nbiomes,nbiomes] and row/colnames
+#' @param file to write into
+#' @param lmar left margin for plot in lines (default: 3)
+#' @param eps write as eps or png
+#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
+#' color scheme white-blue-yellow-red
+#'
+#' @return None
+#'
+#' @export
+plot_ecorisk_cross_table <- function(data,
+ file,
+ lmar = 3,
+ eps = FALSE,
+ palette = NULL) {
+ path_write <- dirname(file)
+ dir.create(file.path(path_write), showWarnings = FALSE)
+
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+
+ } else {
+ grDevices::png(file, width = 6, height = 3, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+
+ plot_ecorisk_cross_table_to_screen(data = data,
+ lmar = lmar,
+ palette = palette)
+ grDevices::dev.off()
+}
diff --git a/R/plot_biomes.R b/R/plot_biomes.R
new file mode 100755
index 0000000000000000000000000000000000000000..152c71a1f3cf17feec307b51708d5f41e2d3d955
--- /dev/null
+++ b/R/plot_biomes.R
@@ -0,0 +1,158 @@
+#' Plot global distribution of lpjml simulated biomes
+#'
+#' Plots a map with the biome distribution as derived from a lpjml run based
+#' on the "classify_biomes" function
+#'
+#' @param biome_data output (list) from classify_biomes()
+#'
+#' @param file_name directory for saving the plot (character string)
+#' @param display_area boolean, adding occupied area per biome (default FALSE)
+#' @param to_robinson logical to define if robinson projection should be used
+#' for plotting
+#' @param order_legend in which order the biomes should be displayed
+#' default: c(1,2,9,10,11,3,4,5,12,13,14,6,7,8,15,16,17,18,19)
+#'
+#' @param bg_col character, specify background possible (`NA` for transparent)
+#'
+#' @examples
+#' \dontrun{
+#' plot_biomes(biome_data = biomes,
+#' file_name ="/p/projects/open/Johanna/R/biomes.pfd")
+#' }
+#'
+#' @md
+#' @export
+
+plot_biomes <- function(biome_data,
+ file_name = NULL,
+ display_area = FALSE,
+ to_robinson = TRUE,
+ cellarea = NULL,
+ order_legend = c(1, 2, 9, 10, 11, 3, 4, 5, 12, 13, 14,
+ 6, 7, 8, 15, 16, 17, 18, 19),
+ bg_col = "white") {
+
+ # load required data: bbox, countries
+ lpjml_extent <- c(-180, 180, -60, 85)
+
+ bounding_box <- system.file("extdata", "ne_110m_wgs84_bounding_box.shp",
+ package = "biospheremetrics") %>%
+ rgdal::readOGR(layer = "ne_110m_wgs84_bounding_box", verbose = FALSE) %>%
+ { if(to_robinson) sp::spTransform(., sp::CRS("+proj=robin")) else . } # nolint
+
+ countries <- system.file("extdata", "ne_110m_admin_0_countries.shp",
+ package = "biospheremetrics") %>%
+ rgdal::readOGR(layer = "ne_110m_admin_0_countries", verbose = FALSE) %>%
+ raster::crop(., lpjml_extent) %>%
+ { if(to_robinson) sp::spTransform(., sp::CRS("+proj=robin")) else . } # nolint
+
+ biome_cols <- c("#993404", "#D95F0E", "#004529", "#238443",
+ "#D9F0A3", "#4EB3D3", "#2B8CBE", "#c4e2f4",
+ "#FE9929", "#FEC44F", "#FEE391", "#A8DDB5",
+ "#E0F3DB", "#F7FCF0", "#c79999", "#0868AC",
+ "#FFFFD4", "white", "#dad4d4")
+
+ biome_mapping <- system.file("extdata", "biomes.csv",
+ package = "biospheremetrics") %>%
+ readr::read_delim(delim = ";", col_types = readr::cols())
+ names(biome_cols) <- biome_mapping$short_name
+
+ biome_cols_legend <- biome_cols[order_legend]
+
+ biome_names_legend <- biome_mapping$short_name[order_legend]
+
+ biomes_lpjml <- to_raster(lpjml_array = biome_data$biome_id,
+ boundary_box = bounding_box,
+ ext = lpjml_extent,
+ to_robinson = to_robinson)
+
+ if (!is.null(file_name)) {
+ file_extension <- strsplit(file_name, split = "\\.")[[1]][-1]
+ switch(file_extension,
+ `png` = {
+ grDevices::png(file_name,
+ width = 8 * 1.8,
+ height = 4 * 2,
+ units = "cm",
+ res = 600,
+ pointsize = 7
+ )
+ },
+ `pdf` = {
+ grDevices::pdf(file_name,
+ width = 8 * 1.8 / 2.54,
+ height = (4 * 2) / 2.54,
+ pointsize = 7
+ )
+ }, {
+ stop("File extension ", dQuote(file_extension), " not supported.")
+ }
+ )
+ }
+ brk <- seq(min(biome_mapping$id) - 0.5,
+ max(biome_mapping$id, na.rm = TRUE) + 0.5, 1)
+ graphics::par(mar = c(4, 0, 0, 0), xpd = TRUE, bg = bg_col)
+
+ graphics::image(biomes_lpjml, asp = 1, xaxt = "n", yaxt = "n",
+ xlab = "", ylab = "", col = biome_cols, breaks = brk,
+ lwd = 0.1, bty = "n")
+ raster::plot(countries, add = TRUE, lwd = 0.3,
+ border = "#5c565667", usePolypath = FALSE)
+
+ if (to_robinson == TRUE) {
+ ypoint <- (-6736039)
+ } else {
+ ypoint <- (-67)
+ }
+ legend_text <- biome_names_legend[1:19]
+
+ if (display_area) {
+ if (is.null(cellarea)) stop("Cellarea needs to be supplied for displaying.")
+ biome_area <- rep(0, length(order_legend))
+ names(biome_area) <- biome_mapping$short_name
+
+ for (i in seq_along(order_legend)) {
+ biome_area[i] <- sum(cellarea[which(biome_data$biome_id == i)])
+ }
+
+ biome_area <- round(biome_area / sum(cellarea) * 100, 3)
+ legend_text <- paste(legend_text, paste0("(", biome_area, " %)"))
+ }
+
+ graphics::legend(0, y = ypoint, xjust = 0.45, yjust = 1, cex = 0.8,
+ legend_text,
+ fill = biome_cols_legend[1:19],
+ horiz = FALSE, border = NULL, bty = "o", box.col = "white",
+ bg = bg_col, ncol = 4)
+ if (!is.null(file_name)) grDevices::dev.off()
+}
+
+# convert lpjml vector to raster and change projection to robinson
+to_raster <- function(lpjml_array,
+ boundary_box,
+ ext,
+ to_robinson) {
+
+ crs_init <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"
+ lpj_ras <- raster::raster(res = 0.5, crs = crs_init)
+ lpj_ras[raster::cellFromXY(lpj_ras, cbind(lon, lat))] <- lpjml_array
+
+ if (to_robinson) {
+ ras_to <- raster::raster(xmn = -18000000,
+ xmx = 18000000,
+ ymn = -9000000,
+ ymx = 9000000,
+ crs = "+proj=robin",
+ nrows = 2 * 360,
+ ncols = 2 * 720)
+
+ out_ras <- raster::crop(lpj_ras, ext) %>%
+ raster::projectRaster(to = ras_to, crs = "+proj=robin",
+ na.rm = TRUE, method = "ngb") %>%
+ raster::mask(boundary_box) %>%
+ suppressWarnings()
+ } else {
+ out_ras <- raster::crop(lpj_ras, ext)
+ }
+ return(out_ras)
+}
diff --git a/R/plot_global.R b/R/plot_global.R
new file mode 100755
index 0000000000000000000000000000000000000000..63877abbe07ab47b8085b845958cef26163f6fc5
--- /dev/null
+++ b/R/plot_global.R
@@ -0,0 +1,223 @@
+#' Plot global LPJmL array
+#'
+#' Creates a PNG/eps with a plot of a global LPJmL array
+#' Data is plotted in range: c(-2^pow2max,-2^-pow2min,0,2^-pow2min,2^pow2max)
+#' colors for pos and neg values can be given, default is Blues for the
+#' positive and Reds for the negative numbers 0-range (from 2^-pow2min to
+#' 2^pow2min) is white.
+#' The negatives can be omitted by setting only_pos=TRUE, in case there are
+#' only pos values.
+#'
+#' @param data array with data to plot in LPJmL specific array c(67420)
+#' @param file character string for location/file to save plot to
+#' @param title character string title for plot
+#' @param pow2max for exponential legend: upper (positive) end of data range to
+#' plot (2^pow2max)
+#' @param pow2min for exponential legend: smallest positive number to be
+#' distinguished from 0 (2^-pow2min)
+#' @param max for linear legend: upper end of data range to plot (0 is placed
+#' symmetrically between min and max, if onlypos = FALSE)
+#' @param min for linear legend: lower end of data range to plot (0 is placed
+#' symmetrically between min and max, if onlypos = FALSE)
+#' @param col_pos color palette for the positives
+#' @param col_neg color palette for the negatives
+#' @param type string indicating whether to plot exponential (exp) or
+#' linear (lin) legend (default: exp)
+#' @param legendtitle character string legend title
+#' @param leg_yes boolean whether to show legend (default: TRUE)
+#' @param only_pos boolean to show only positive half of legend (default: FALSE)
+#' @param eps boolean whether to write eps file instead of PNG (default: FALSE)
+#'
+#' @return None
+#'
+#' @examples
+#' \dontrun{
+#' plot_global(
+#' data = irrigation2006,
+#' file = paste("~/", "mwateramount_2005_06.png", sep = ""),
+#' title = paste("irrigation amount 2006 in mm/yr", sep = ""),
+#' pow2max = 15,
+#' pow2min = 0,
+#' legendtitle = "legendtitle",
+#' leg_yes = TRUE,
+#' eps = FALSE
+#' )
+#' }
+#'
+#' @export
+plot_global <- function(data,
+ file,
+ title = "",
+ pow2max = NULL,
+ pow2min = NULL,
+ min = NULL,
+ max = NULL,
+ col_pos = "GnBu",
+ type = "exp",
+ col_neg = "YlOrRd",
+ legendtitle = "",
+ leg_yes = TRUE,
+ only_pos = FALSE,
+ eps = FALSE) {
+ if (eps) {
+ file <- strsplit(file, ".", fixed = TRUE)[[1]]
+ file <- paste(c(file[1:(length(file) - 1)], "eps"), collapse = ".")
+
+ grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
+ grDevices::postscript(file, horizontal = FALSE, onefile = FALSE, width = 22,
+ height = 8.5, paper = "special")
+
+ } else {
+ grDevices::png(file, width = 7.25, height = 3.5, units = "in", res = 300,
+ pointsize = 6, type = "cairo")
+ }
+
+ plot_global_to_screen(
+ data = data, title = title, pow2max = pow2max, type = type,
+ pow2min = pow2min, min = min, max = max, col_pos = col_pos,
+ col_neg = col_neg, legendtitle = legendtitle, leg_yes = leg_yes,
+ only_pos = only_pos
+ )
+ grDevices::dev.off()
+}
+
+
+#' Plot global LPJmL array
+#'
+#' Plot of a global LPJmL array inside RStudio
+#' Data is plotted in range: c(-2^pow2max,-2^-pow2min,0,2^-pow2min,2^pow2max)
+#' where the positive values are colored green to blue,
+#' 0-range is white,
+#' and the negative ones red to yellow
+#'
+#' @param data array with data to plot in LPJmL specific array c(67420)
+#' @param file character string for location/file to save plot to
+#' @param title character string title for plot
+#' @param pow2max for exponential legend: upper (positive) end of data range to
+#' plot (2^pow2max)
+#' @param pow2min for exponential legend: smallest positive number to be
+#' distinguished from 0 (2^-pow2min)
+#' @param max for linear legend: upper end of data range to plot (0 is placed
+#' symmetrically between min and max, if onlypos = FALSE)
+#' @param min for linear legend: lower end of data range to plot (0 is placed
+#' symmetrically between min and max, if onlypos = FALSE)
+#' @param col_pos color palette for the positives
+#' @param col_neg color palette for the negatives
+#' @param type string indicating whether to plot exponential (exp) or
+#' linear (lin) legend (default: exp)
+#' @param legendtitle character string legend title
+#' @param leg_yes boolean whether to show legend (default: TRUE)
+#' @param only_pos boolean to show only positive half of legend (default: FALSE)
+#' @param eps boolean whether to write eps file instead of PNG (default: FALSE)
+#'
+#' @return None
+#
+#' @examples
+#' \dontrun{
+#' plot_global_to_screen(
+#' data = irrigation2006,
+#' title = paste("irrigation amount 2006 in mm/yr", sep = ""),
+#' pow2max = 15,
+#' pow2min = 0,
+#' "legendtitle",
+#' leg_yes = TRUE
+#' )
+#' }
+#'
+#' @export
+plot_global_to_screen <- function(data,
+ title = "",
+ pow2max = NULL,
+ pow2min = NULL,
+ min = NULL,
+ max = NULL,
+ col_pos = "GnBu",
+ type = "exp",
+ col_neg = "YlOrRd",
+ legendtitle = "",
+ leg_yes = TRUE,
+ only_pos = FALSE) {
+ if (only_pos) {
+ if (type == "exp") {
+ if (is.null(pow2max) | is.null(pow2min)) {
+ stop("For exponental legend, pow2min and pow2max need to be specified.")
+ }
+ # actual brks and ticks
+ legendticks <- c(0, 2^seq(pow2min, pow2max, 1))
+ # just for displaying an equally sized legend
+ brks <- c(seq(pow2min, pow2max, length.out = length(legendticks)))
+
+ } else if (type == "lin") {
+ if (is.null(max) | is.null(min)) {
+ stop("For linear legend, min and max need to be specified.")
+ }
+ legendticks <- seq(min, max, length.out = 10)
+ brks <- legendticks
+ }
+ palette <- c(
+ "white",
+ grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, col_pos))(length(legendticks) - 2) # nolint
+ )
+
+ } else {
+ if (type == "exp") {
+ if (is.null(pow2max) | is.null(pow2min)) {
+ stop("For exponental legend, pow2min and pow2max need to be specified.")
+ }
+ legendticks <- c(
+ -(2^seq(pow2max, pow2min, -1)), 2^seq(pow2min, pow2max, 1)
+ )
+ brks <- seq(-pow2max, pow2max, length.out = length(legendticks))
+ } else if (type == "lin") {
+ if (is.null(max) | is.null(min)) {
+ stop("For linear legend, min and max need to be specified.")
+ }
+ legendticks <- seq(min, max, length.out = 20)
+ brks <- legendticks
+ }
+ palette <- c(
+ rev(
+ grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, col_neg))(length(legendticks) / 2 - 1) # nolint
+ ),
+ "white",
+ grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, col_pos))(length(legendticks) / 2 - 1) # nolint
+ )
+ }
+ data[data < legendticks[1]] <- legendticks[1]
+ data[data > legendticks[length(legendticks)]] <- (
+ legendticks[length(legendticks)]
+ )
+
+ ra <- raster::raster(ncols = 720, nrows = 360)
+ range <- range(data)
+ ra[raster::cellFromXY(ra, cbind(lon, lat))] <- data
+ extent <- raster::extent(c(-180, 180, -60, 90))
+
+ if (leg_yes) {
+ graphics::par(bty = "n", oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 3),
+ xpd = TRUE)
+ } else {
+ graphics::par(bty = "n", oma = c(0, 0, 0, 0), mar = c(0, 0, 0, 0))
+ }
+ raster::plot(ra, ext = extent, breaks = legendticks, col = palette, main = "",
+ legend = FALSE, axes = FALSE)
+ title(title, line = -1)
+ if (leg_yes) {
+ if (type == "exp") {
+ fields::image.plot(
+ legend.only = TRUE, zlim = c(-pow2max, pow2max), col = palette,
+ useRaster = FALSE, breaks = brks, lab.breaks = round(legendticks, 2),
+ legend.shrink = 0.8,
+ legend.args = list(legendtitle, side = 3, font = 2, line = 1)
+ )
+ } else { # linear plotting
+ fields::image.plot(
+ legend.only = TRUE, zlim = c(min, max), col = palette,
+ useRaster = FALSE, breaks = brks, lab.breaks = round(legendticks, 2),
+ legend.shrink = 0.8,
+ legend.args = list(legendtitle, side = 3, font = 2, line = 1)
+ )
+ }
+ }
+ maps::map("world", add = TRUE, res = 0.4, lwd = 0.25, ylim = c(-60, 90))
+}
diff --git a/R/utils.R b/R/utils.R
new file mode 100644
index 0000000000000000000000000000000000000000..cbb523d9784c7b1ef3b2920b8ac8571c0962f3d8
--- /dev/null
+++ b/R/utils.R
@@ -0,0 +1,240 @@
+# function to get file extension
+get_file_ext <- function(path) {
+ # Get all files in path
+ all_files <- list.files(
+ path,
+ full.names = TRUE
+ )
+
+ # Get file extensions
+ all_file_types <- all_files %>%
+ strsplit("/") %>%
+ sapply(utils::tail, 1) %>%
+ strsplit("^([^\\.]+)") %>%
+ sapply(function(x) {
+ y <- x[2]
+ return(y)
+ }) %>%
+ substr(2, nchar(.))
+
+ # Get most frequent file types
+ #TODO not yet working
+ most_frequent <- all_file_types %>%
+ factor() %>%
+ table() %>%
+ names() %>%
+ .[1:5]
+
+ # 5 exemplaric files to detect type
+ files_to_check <- sapply(
+ most_frequent,
+ function(x, y, z) {
+ y[which(z == x)[1]]
+ },
+ y = all_files,
+ z = all_file_types)
+
+ # Detect actual LPJmL data type
+ types <- sapply(
+ files_to_check,
+ lpjmlkit:::detect_io_type
+ ) %>%
+ stats::setNames(names(.), .)
+
+ # Assign file type after ranking which is available
+ # first preferable: "meta", second: "clm", last: "raw"
+ if ("meta" %in% names(types)) {
+ file_type <- types["meta"]
+ } else if ("clm" %in% names(types)) {
+ file_type <- types["clm"]
+ } else if ("raw" %in% names(types)) {
+ file_type <- types["raw"]
+ }
+ return(file_type)
+}
+
+
+# function to get absolute file names
+get_filenames <- function(path, # nolint
+ output_files,
+ diff_output_files,
+ input_files,
+ file_ext) {
+
+ file_names <- list()
+ # Iterate over required outputs
+ for (ofile in names(output_files)) {
+
+ # Get required max. temporal resolution and convert to nstep
+ resolution <- output_files[[ofile]]$resolution
+ nstep <- switch(
+ resolution,
+ annual = 1,
+ monthly = 12,
+ daily = 365,
+ stop(paste0("Not supported time resolution: ", dQuote(nstep), "."))
+ )
+
+ # If input file supplied use it as first priority
+ if (ofile %in% names(input_files)) {
+ file_name <- input_files[[ofile]]
+
+ } else if (ofile %in% names(diff_output_files)) {
+
+ # If different output file should be used - as second priority
+ file_name <- paste0(
+ path, "/",
+ diff_output_files[[ofile]], ".",
+ file_ext
+ )
+ } else {
+ file_name <- NULL
+ }
+
+ if (!is.null(file_name)) {
+
+ # Check if data could be read in
+ meta <- lpjmlkit::read_meta(file_name)
+
+ # Then check if temporal resultion of file matches required nstep
+ if (nstep != meta$nstep && nstep != meta$nbands) {
+ stop(
+ paste0(
+ "Required temporal resolution (nstep = ", nstep, ") ",
+ "not supported by file ", dQuote(file_name),
+ " (", meta$nstep, ")"
+ )
+ )
+ }
+
+ # If nothing specified try to read required files from provided path
+ } else {
+
+ # Iterate over different used file name options (e.g. runoff, mrunoff, ...) # nolint
+ for (cfile in seq_along(output_files[[ofile]]$file_name)) {
+ file_name <- paste0(
+ path, "/",
+ output_files[[ofile]]$file_name[cfile], ".",
+ file_ext
+ )
+
+ # Check if file exists and if so check required temporal resolution
+ # else next
+ if (file.exists(file_name)) {
+ meta <- lpjmlkit::read_meta(file_name)
+ if (nstep <= meta$nstep || nstep == meta$nbands) {
+ # Matching file found, break and use current file_name
+ break
+ }
+ }
+
+ # At end of iteraton raise error that no matching file_name was found
+ if (cfile == length(output_files[[ofile]]$file_name) &&
+ !output_files[[ofile]]$optional) {
+ stop(
+ paste0(
+ "No matching output for ", dQuote(ofile),
+ " with required temporal resolution (nstep = ", nstep, ") ",
+ "found at path ", dQuote(path), "."
+ )
+ )
+ }
+ }
+ }
+ file_names[[ofile]] <- file_name
+ }
+ file_names
+}
+
+
+# list required output files
+list_outputs <- function(metric = "all",
+ only_first_filename = TRUE) {
+
+ metric <- process_metric(metric = metric)
+
+ system.file(
+ "extdata",
+ "metric_files.yml",
+ package = "biospheremetrics"
+ ) %>%
+ yaml::read_yaml() %>%
+ get_outputs(metric, only_first_filename)
+
+}
+
+
+# Translate metric options into internal metric names
+process_metric <- function(metric = "all") {
+ all_metrics <- c(
+ "meco", "meco_nitrogen", "mcol", "biome", "nitrogen", "lsc",
+ "bluewater", "greenwater", "water", "biosphere"
+ )
+
+ if ("all" %in% metric) {
+ metric <- all_metrics
+ }
+
+ if ("benchmark" %in% metric) {
+ metric <- "benchmark"
+ }
+
+ metric <- match.arg(
+ arg = metric,
+ choices = all_metrics,
+ several.ok = TRUE
+ )
+
+ metric
+}
+
+
+# for input list a, all duplicate keys are unified, taking the value with
+# highest temporal resolution (daily>monthly>annual)
+get_outputs <- function(x, metric_name, only_first_filename) { # nolint
+
+ outputs <- list()
+ # Iterate over all metrics
+ for (metric in x$metric[metric_name]) {
+
+ # Iterate over all unique keys
+ for (item in names(metric$output)) {
+
+ # Check if output is already in list or if it has higher resolution
+ if (!item %in% names(outputs) ||
+ (item %in% names(outputs) &&
+ higher_res(metric$output[[item]]$resolution,
+ outputs[[item]]$resolution))
+ ) {
+ # Assign output resolution from metric file
+ outputs[[item]]$resolution <- metric$output[[item]]$resolution
+ outputs[[item]]$optional <- metric$output[[item]]$optional
+ # Assign output file name from metric file
+ if (only_first_filename) {
+ outputs[[item]]$file_name <- x$file_name[[item]][1]
+ } else {
+ outputs[[item]]$file_name <- x$file_name[[item]]
+ }
+ }
+ }
+ }
+ outputs
+}
+
+
+# Check if resolution of x is higher than resolution of y
+higher_res <- function(x, y) {
+ levels <- c("annual", "monthly", "daily")
+ resolution_x <- match(match.arg(x, levels), levels)
+ resolution_y <- match(match.arg(y, levels), levels)
+
+ if (resolution_x > resolution_y) {
+ return(TRUE)
+ } else {
+ return(FALSE)
+ }
+}
+
+
+# Avoid note for "."...
+utils::globalVariables(".") # nolint:undesirable_function_linter
diff --git a/README.md b/README.md
new file mode 100755
index 0000000000000000000000000000000000000000..9dc3092781952424f552b501bf3de32c7693ffa9
--- /dev/null
+++ b/README.md
@@ -0,0 +1,418 @@
+# biospheremetrics
+
+
+*The goal of biospheremetrics is to provide functions to calculate and plot
+the biosphere integrity metrics M-ECO and M-ECO in an R package based on
+outputs of [LPJmL](https://gitlab.pik-potsdam.de/lpjml/LPJmL_internal).
+biospheremetrics utilizes the read functions of the
+[lpjmlkit package](https://gitlab.pik-potsdam.de/lpjml/lpjmlkit).*
+
+## Installation
+
+You can install `biospheremetrics` by git cloning this repository:
+
+```bash
+git clone https://gitlab.pik-potsdam.de/stenzel/biospheremetrics.git <path_to_biospheremetrics>
+```
+
+and install via [`devtools`](https://rawgit.com/rstudio/cheatsheets/master/package-development.pdf):
+
+```R
+devtools::install("<path_to_biospheremetrics>")
+library("biospheremetrics")
+```
+
+alternatively, you can also load it from source:
+
+```R
+devtools::load_all("/p/projects/open/Fabian/LPJbox/biospheremetrics_paper/")
+```
+
+## Example
+
+The `./scripts` folder contains scripts to be used on the PIK cluster to
+compute longer timeseries with higher RAM demand.
+
+## Example
+
+The following application example calculates the metrics BioCol and EcoRisk:
+
+```R
+library(devtools)
+library(lpjmlkit)
+library(sf)
+library(terra)
+
+devtools::load_all("/p/projects/open/Fabian/LPJbox/biospheremetrics_paper/")
+
+run_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/lu_1500_2014/"
+pnv_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/"
+out_folder <- "/p/projects/open/Fabian/Metrics/"
+lpj_input <- "/p/projects/lpjml/input/historical/"
+
+# read grid
+grid <- lpjmlkit::read_io(paste0(run_folder,"grid.bin.json"))
+# calculate cell area
+lat <- grid[, , 2]
+lon <- grid[, , 1]
+cellarea <- lpjmlkit::calc_cellarea(grid)
+
+################# calculate BioCol ################
+# 16GB of RAM are enough to calculate BioCol for a smaller analysis window (~40 years)
+# for longer spans (500 years) - use separate script ("read_in_BioCol_data.R")
+# and submit as cluster job using "sbatch R_read_in_BioCol_data.sh" - analysis for "biocol overtime" below
+vars_biocol <- data.frame(
+ row.names = c("grid", "npp", "pft_npp", "pft_harvest", "pft_rharvest",
+ "firec", "timber_harvest", "cftfrac", "fpc"),
+ outname = c("grid.bin.json", "mnpp.bin.json", "pft_npp.bin.json",
+ "pft_harvest.pft.bin.json","pft_rharvest.pft.bin.json",
+ "firec.bin.json","timber_harvestc.bin.json","cftfrac.bin.json",
+ "fpc.bin.json")
+)
+
+biocol <- calc_biocol(
+ path_lu = run_folder,
+ path_pnv = pnv_folder,
+ gridbased = TRUE,
+ start_year = 1980,
+ stop_year = 2014,
+ reference_npp_time_span = 1510:1539,
+ reference_npp_file = "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/mnpp.bin.json",
+ read_saved_data = FALSE,
+ save_data = TRUE,
+ npp_threshold = 20,
+ data_file = "/p/projects/open/Fabian/Metrics/BioCol_202306.RData",
+ external_fire = FALSE,
+ external_wood_harvest = TRUE,
+ external_fire_file = "/p/projects/open/Fabian/LPJbox/human_ignition_fraction.RData",
+ external_wood_harvest_file = "/p/projects/open/LanduseData/LUH2_v2h/wood_harvest_biomass_sum_1500-2014_67420.RData",
+ varnames = vars_biocol,
+ grass_scaling = FALSE,
+ include_fire = FALSE
+)
+
+plot_biocol(
+ biocol_data = biocol,
+ path_write = paste0(out_folder,"BioCol/"),
+ plotyears = c(1980,2014),
+ min_val = 0,
+ max_val = 90,
+ legendpos = "left",
+ start_year = 1980,
+ mapyear = 2000,
+ highlightyear = 2000,
+ eps = FALSE
+)
+
+############## analyse and plot biocol overtime #################
+# first submit `R_read_BioCol_data.sh` to cluster via slurm to read in and process the input files, a lot of memory is required for this
+# then here only read the preprocessed data file (read_saved_data = TRUE)
+biocol_overtime <- calc_biocol(
+ path_lu = run_folder,
+ path_pnv = pnv_folder,
+ gridbased = TRUE,
+ start_year = 1500,
+ stop_year = 2014,
+ reference_npp_time_span = 1550:1579,
+ reference_npp_file = "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/mnpp.bin.json",
+ read_saved_data = TRUE,
+ save_data = FALSE,
+ npp_threshold = 20,
+ data_file = "/p/projects/open/Fabian/Metrics/data/BioCol_202306_overtime.RData",
+ external_fire = FALSE,
+ external_wood_harvest = TRUE,
+ external_fire_file = "/p/projects/open/Fabian/LPJbox/human_ignition_fraction.RData",
+ external_wood_harvest_file = "/p/projects/open/LanduseData/LUH2_v2h/wood_harvest_biomass_sum_1500-2014_67420.RData",
+ varnames = vars_biocol,
+ grass_scaling = FALSE,
+ include_fire = FALSE
+)
+
+plot_biocol(
+ biocol_data = biocol_overtime,
+ path_write = paste0(out_folder,"BioCol/"),
+ plotyears = c(1550,2014),
+ min_val = 0,
+ max_val = 90,
+ legendpos = list(x=1550,y=23),
+ start_year = 1500,
+ mapyear = 2000,
+ highlightyear = 2000,
+ eps = FALSE
+)
+
+################# compute EcoRisk ################
+vars_ecorisk <- data.frame(
+ row.names = c("grid","fpc", "fpc_bft", "cftfrac", "firec", "npp", "runoff",
+ "transp", "vegc", "firef", "rh", "harvestc", "rharvestc",
+ "pft_harvestc", "pft_rharvestc", "evap", "interc", "discharge",
+ "soilc", "litc", "swc", "vegn", "soilnh4", "soilno3",
+ "leaching", "n2o_denit", "n2o_nit", "n2_emis", "bnf",
+ "n_volatilization"),
+ outname = c("grid.bin.json", "fpc.bin.json", "fpc_bft.bin.json",
+ "cftfrac.bin.json", "firec.bin.json", "mnpp.bin.json",
+ "mrunoff.bin.json", "mtransp.bin.json", "vegc.bin.json",
+ "firef.bin.json", "mrh.bin.json", "flux_harvest.bin.json",
+ "flux_rharvest.bin.json", "pft_harvest.pft.bin.json",
+ "pft_rharvest.pft.bin.json", "mevap.bin.json",
+ "minterc.bin.json", "mdischarge.bin.json", "soilc.bin.json",
+ "litc.bin.json", "mswc.bin.json", "vegn.bin.json",
+ "soilnh4.bin.json", "soilno3.bin.json", "mleaching.bin.json",
+ "mn2o_denit.bin.json", "mn2o_nit.bin.json", "mn2_emis.bin.json",
+ "mbnf.bin.json", "mn_volatilization.bin.json")
+)
+
+ecorisk <- ecorisk_wrapper(
+ path_ref = pnv_folder,
+ path_scen = run_folder,
+ read_saved_data = TRUE,
+ nitrogen = TRUE,
+ varnames = vars_ecorisk,
+ weighting = "equal",
+ save_data = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_data.RData",
+ save_ecorisk = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_gamma.RData",
+ time_span_reference = c(1550:1579),
+ time_span_scenario = c(1985:2014),
+ dimensions_only_local = FALSE
+)
+
+# plot ecorisk
+plot_ecorisk_map(
+ ecorisk$ecorisk_total,
+ file = paste0(out_folder,"EcoRisk/ecorisk.png"),
+ title="ecorisk"
+)
+
+plot_ecorisk_map(
+ ecorisk$vegetation_structure_change,
+ file = paste0(out_folder, "EcoRisk/vs.png"),
+ title = "vegetation structure change"
+)
+
+plot_ecorisk_map(
+ ecorisk$local_change,
+ file = paste0(out_folder, "EcoRisk/lc.png"),
+ title = "local change"
+)
+
+plot_ecorisk_map(
+ ecorisk$global_importance,
+ file = paste0(out_folder, "EcoRisk/gi.png"),
+ title = "global importance"
+)
+
+plot_ecorisk_map(
+ ecorisk$ecosystem_balance,
+ file = paste0(out_folder, "EcoRisk/eb.png"),
+ title = "ecosystem balance")
+
+plot_ecorisk_map(
+ ecorisk$carbon_stocks,
+ file = paste0(out_folder, "EcoRisk/cs.png"),
+ title = "carbon_stocks"
+)
+
+plot_ecorisk_map(
+ ecorisk$carbon_fluxes,
+ file = paste0(out_folder, "EcoRisk/cf.png"),
+ title = "carbon_fluxes"
+)
+
+plot_ecorisk_map(
+ ecorisk$water_stocks,
+ file = paste0(out_folder, "EcoRisk/ws.png"),
+ title = " water_stocks"
+)
+
+plot_ecorisk_map(
+ ecorisk$water_fluxes,
+ file = paste0(out_folder, "EcoRisk/wf.png"),
+ title = " water_fluxes"
+)
+
+plot_ecorisk_map(
+ ecorisk$nitrogen_stocks,
+ file = paste0(out_folder, "EcoRisk/ns.png"),
+ title = " nitrogen_stocks"
+)
+
+plot_ecorisk_map(
+ ecorisk$nitrogen_fluxes,
+ file = paste0(out_folder, "EcoRisk/nf.png"),
+ title = " nitrogen_fluxes"
+)
+
+################# ecorisk biomes ################
+
+biome_classes <- classify_biomes(
+ path_reference = pnv_folder,
+ files_reference = list(
+ grid = paste0(pnv_folder,"grid.bin.json"),
+ fpc = paste0(pnv_folder,"fpc.bin.json"),
+ vegc = paste0(pnv_folder,"vegc.bin.json"),
+ pft_lai = paste0(pnv_folder,"pft_lai.bin.json"),
+ temp = "/p/projects/lpjml/input/historical/GSWP3-W5E5/tas_gswp3-w5e5_1901-2016.clm",
+ elevation = "/p/projects/lpjml/input/historical/input_VERSION2/elevation.bin"
+ ),
+ time_span_reference = as.character(1985:2014),
+ savanna_proxy = list(pft_lai = 6),
+ montane_arctic_proxy = list(elevation = 1000)
+)
+
+biome_classes_pi <- classify_biomes(
+ path_reference = pnv_folder,
+ files_reference = list(
+ grid = paste0(pnv_folder,"grid.bin.json"),
+ fpc = paste0(pnv_folder,"fpc.bin.json"),
+ vegc = paste0(pnv_folder,"vegc.bin.json"),
+ pft_lai = paste0(pnv_folder,"pft_lai.bin.json"),
+ temp = "/p/projects/lpjml/input/historical/GSWP3-W5E5/tas_gswp3-w5e5_1901-2016.clm",
+ elevation = "/p/projects/lpjml/input/historical/input_VERSION2/elevation.bin"
+ ),
+ time_span_reference = as.character(1901:1910),
+ savanna_proxy = list(pft_lai = 6),
+ montane_arctic_proxy = list(elevation = 1000)
+)
+
+plot_biomes(biome_data = biome_classes,
+ display_area = TRUE,
+ cellarea = cellarea,
+ file_name = paste0(out_folder,"EcoRisk/biomes_2005-2014.png"),
+ order_legend = 1:19,
+ to_robinson = FALSE)
+plot_biomes(biome_data=biome_classes_pi,
+ display_area = TRUE,
+ cellarea = cellarea,
+ file_name = paste0(out_folder,"EcoRisk/biomes_1901-1910.png"),
+ order_legend = 1:19,
+ to_robinson = FALSE)
+
+# compute median ecorisk values for biomes/large worldregions
+ecorisk_disaggregated_full <- disaggregate_into_biomes(
+ data = ecorisk,
+ biome_class = biome_classes,
+ type = "quantile",
+ classes = "allbiomes"
+)
+ecorisk_disaggregated_full[is.na(meco_disaggregated_full)] <- 0
+
+ecorisk_disaggregated_4regions <- disaggregate_into_biomes(
+ data = ecorisk,
+ biome_class = biome_classes,
+ type = "quantile",
+ classes = "4biomes"
+)
+
+plot_ecorisk_radial_panel(
+ data = ecorisk_disaggregated_full[-c(17,18,19),,],
+ biomeNames = get_biome_names(1)[-c(17,18,19)],
+ file = paste0(out_folder,"EcoRisk/EcoRisk_panel_1564_vs_2002.png"),
+ quantile = TRUE,
+ eps = TRUE
+)
+
+plot_ecorisk_radial_panel(
+ data = ecorisk_disaggregated_4regions[,,],
+ biomeNames = c("tropics","temperate","boreal","arctic"),
+ file = paste0(out_folder,"EcoRisk/EcoRisk_4regions_1564_vs_2002.png"),
+ quantile = TRUE,
+ eps = TRUE
+)
+
+################# ecorisk overtime ################
+# first use the script `R_calc_ecorisk_overtime.sh` to read in and process the data
+# on the PIK cluster this takes about a day for 100 years and 80GB of memory
+
+load("/p/projects/open/Fabian/Metrics/data/ecorisk_202306_overtime_gamma.RData")
+
+ecorisk_overtime_allbiomes <- disaggregate_into_biomes(
+ ecorisk = ecorisk,
+ biome_class = biome_classes,
+ type = "quantile",
+ classes = "allbiomes"
+)
+
+plot_ecorisk_over_time_panel(
+ data = ecorisk_overtime_allbiomes,
+ timerange = c(1916,2003),
+ biomeNames = c("tropic","temperate","boreal","arctic"),
+ file = paste0(out_folder,"overtime_panel.png"),
+ eps=TRUE
+)
+
+ecorisk_overtime_biome16 <- disaggregate_into_biomes(
+ data = ecorisk,
+ biome_class = biome_classes,
+ type = "quantile",
+ classes = "allbiomes"
+)
+
+plot_ecorisk_over_time_panel(
+ data = ecorisk_overtime_biome16[-c(3,17,18),,,],
+ timerange = c(1916,2003),
+ biomeNames = get_biome_names(1)[-c(3,17,18)],
+ file = paste0(out_folder,"overtime_panel_16.png"),
+ eps=TRUE
+)
+
+
+
+################# compare to average PI biome cell #################
+intra_biome_distrib_PI <- calculate_within_biome_diffs(
+ biome_classes = biome_classes_pi,
+ intra_biome_distrib_file = "/p/projects/open/Fabian/Metrics/data/ecorisk_PNV_intra_biome_distrib_file_202306.RData",
+ dataFile_base = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_data.RData",
+ create = TRUE, plotting = TRUE, res = 0.02, vars_ecorisk = vars_ecorisk,
+ plot_folder = out_folder, time_span_reference = as.character(1891:1920))
+
+plot_biome_internal_distribution(
+ data = intra_biome_distrib_PI[,"ecorisk_total",],
+ file = paste0(out_folder,"EcoRisk_newCol/distribution_PI_within_biome_differences.png"),
+ biomes_abbrv = get_biome_names(1),
+ scale = 4,
+ eps=TRUE,
+ palette = paletteNew
+)
+
+################# cross table average biomes today #################
+
+dataFile_base = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_data.RData"
+data_file = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_crosstable_data.RData"
+ecoriskFile = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_crosstable_gamma.RData"
+
+ecorisk_cross_table(dataFileIn = dataFile_base,
+ dataFileOut = data_file,
+ biome_classes_in = biome_classes) #pickCells = pickcells)
+
+nbiomes <- length(biome_classes$biome_names)
+ecorisk_crosstable_today <- ecorisk_wrapper(
+ path_ref = NULL,
+ path_scen = NULL,
+ read_saved_data = TRUE,
+ save_data = data_file,
+ save_ecorisk = ecoriskFile,
+ varnames = vars_ecorisk,
+ time_span_reference = as.character(1985:2014),
+ time_span_scenario = as.character(1985:2014)
+ #ncells = nbiomes^2
+)
+
+# if written previously, load crosstable data
+if (FALSE) {
+ load(ecoriskFile)
+ ecorisk_crosstable_today <- ecorisk
+}
+
+crosstable <- ecorisk_crosstable_today$ecorisk_total
+dim(crosstable) <- c(nbiomes,nbiomes)
+colnames(crosstable) <- get_biome_names(1)
+rownames(crosstable) <- get_biome_names(2)
+
+plot_ecorisk_cross_table(
+ data = crosstable[-c(3,8,18,19),-c(3,8,18,19)],
+ file = paste0(out_folder,"/EcoRisk_newCol/crosstable_today.png"),
+ lmar=12,
+ palette = paletteNew
+)
+
+```
diff --git a/biospheremetrics.Rproj b/biospheremetrics.Rproj
new file mode 100755
index 0000000000000000000000000000000000000000..1788e686604202ce4f5e12f188c7359e752cf950
--- /dev/null
+++ b/biospheremetrics.Rproj
@@ -0,0 +1,18 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace,vignette
diff --git a/inst/extdata/biomes.csv b/inst/extdata/biomes.csv
new file mode 100755
index 0000000000000000000000000000000000000000..c9d8088866fca29aa624e557238ecb6c851a29e3
--- /dev/null
+++ b/inst/extdata/biomes.csv
@@ -0,0 +1,20 @@
+id;name;short_name;abbreviation;category_forest;zone_tropical;zone_temperate;zone_boreal
+1;Tropical Rainforest;Tropical Rain.;TrRF;1;1;0;0
+2;Tropical Seasonal & Deciduous Forest;Tropical Decid. Forest;TrDF;1;1;0;0
+3;Temperate Broadleaved Evergreen Forest;Temp. Broad. Ever. Forest;TeBE;1;0;1;0
+4;Temperate Broadleaved Deciduous Forest;Temp. Broad. Decid. Forest;TeBD;1;0;1;0
+5;Temperate Needleleaved Evergreen Forest;Temp. Needle. Ever. Forest;TeNE;1;0;1;0
+6;Boreal Needleleaved Evergreen Forest;Bor. Needle. Ever. Forest;BoNE;1;0;0;1
+7;Boreal Broadleaved Deciduous Forest;Bor. Broad. Decid. Forest;BoBD;1;0;0;1
+8;Boreal Needleleaved Deciduous Forest;Bor. Needle. Decid. Forest;BoND;1;0;0;1
+9;Warm Woody Savanna, Woodland & Shrubland;Warm Woodland;WaWo;0;1;0;0
+10;Warm Savanna & Open Shrubland;Warm Savanna;WaSa;0;1;0;0
+11;Warm Grassland;Warm Grassland;WaGr;0;1;0;0
+12;Temperate Woody Savanna, Woodland & Shrubland;Temp. Woodland;TeWo;0;0;1;0
+13;Temperate Savanna & Open Shrubland;Temp. Savanna;TeSa;0;0;1;0
+14;Temperate Grassland;Temp. Grassland;TeGr;0;0;1;0
+15;Montane Grassland;Montane Grassland;MoGr;0;0;0;1
+16;Arctic Tundra;Arctic Tundra;ArTu;0;0;0;1
+17;Desert;Desert;Des;0;0;0;0
+18;Rocks and Ice;Rocks and Ice;RoIc;0;0;0;0
+19;Water;Water;Wat;0;0;0;0
diff --git a/inst/extdata/metric_files.yml b/inst/extdata/metric_files.yml
new file mode 100644
index 0000000000000000000000000000000000000000..c2713dec3da94f5166ed97c22405ab5da02be28f
--- /dev/null
+++ b/inst/extdata/metric_files.yml
@@ -0,0 +1,577 @@
+# ---------------------------------------------------------------------------- #
+# Metrics required LPJmL outputs and boundaries functions
+# ---------------------------------------------------------------------------- #
+metric:
+ # Biome classification
+ biome:
+ # LPJmL output IDs with required resolution
+ output: &biome_output
+ grid:
+ resolution: "annual"
+ optional: false
+ fpc:
+ resolution: "annual"
+ optional: false
+ vegc:
+ resolution: "annual"
+ optional: true
+ pft_lai:
+ resolution: "annual"
+ optional: true
+ temp:
+ resolution: "annual"
+ optional: true
+ # Called boundaries functions
+ fun: &biome_fun
+ - classify_biomes
+
+ # Calculate bluewater boundary
+ bluewater: &bluewater
+ # LPJmL output IDs with required resolution
+ output:
+ grid:
+ resolution: "annual"
+ optional: false
+ discharge:
+ resolution: "monthly"
+ optional: false
+ irrig:
+ resolution: "monthly"
+ optional: true
+ # Called boundaries functions
+ fun:
+ - calc_bluewater_status
+
+ # Calculate greenwater boundary
+ greenwater: &greenwater
+ # LPJmL output IDs with required resolution
+ output:
+ grid:
+ resolution: "annual"
+ optional: false
+ rootmoist:
+ resolution: "monthly"
+ optional: false
+ swc:
+ resolution: "monthly"
+ optional: true
+ # Called boundaries functions
+ fun:
+ - calc_greenwater_status
+
+ # Calculate nitrogen boundary
+ nitrogen: &nitrogen
+ # LPJmL output IDs with required resolution
+ output:
+ grid:
+ resolution: "annual"
+ optional: false
+ runoff:
+ resolution: "monthly"
+ optional: false
+ leaching:
+ resolution: "monthly"
+ optional: false
+ pet:
+ resolution: "monthly"
+ optional: false
+ prec:
+ resolution: "monthly"
+ optional: true
+ # Called boundaries functions
+ fun: &nitrogen_fun
+ - calc_nitrogen_status
+
+ # Calculate lsc boundary
+ lsc: &lsc
+ # LPJmL output IDs with required resolution
+ output:
+ <<: *biome_output
+ fun:
+ - *biome_fun
+ - calc_lsc_status
+
+
+ # Calculate meco
+ meco:
+ # LPJmL output IDs with required resolution
+ output: &meco_output
+ grid:
+ resolution: "annual"
+ optional: false
+ fpc:
+ resolution: "annual"
+ optional: false
+ fpc_bft:
+ resolution: "annual"
+ optional: false
+ cftfrac:
+ resolution: "annual"
+ optional: false
+ firec:
+ resolution: "annual"
+ optional: false
+ npp:
+ resolution: "annual"
+ optional: false
+ runoff:
+ resolution: "annual"
+ optional: false
+ transp:
+ resolution: "annual"
+ optional: false
+ vegc:
+ resolution: "annual"
+ optional: false
+ firef:
+ resolution: "annual"
+ optional: false
+ rh:
+ resolution: "annual"
+ optional: false
+ harvestc:
+ resolution: "annual"
+ optional: false
+ evap:
+ resolution: "annual"
+ optional: false
+ interc:
+ resolution: "annual"
+ optional: false
+ soilc:
+ resolution: "annual"
+ optional: false
+ litc:
+ resolution: "annual"
+ optional: false
+ swc:
+ resolution: "annual"
+ optional: false
+ # Called boundaries functions
+ fun: &meco_output
+ []
+
+ # Calculate meco_nitrogen
+ meco_nitrogen:
+ # LPJmL output IDs with required resolution
+ output:
+ <<: *meco_output
+ vegn:
+ resolution: "annual"
+ optional: false
+ soilnh4:
+ resolution: "annual"
+ optional: false
+ soilno3:
+ resolution: "annual"
+ optional: false
+ leaching:
+ resolution: "annual"
+ optional: false
+ n2o_denit:
+ resolution: "annual"
+ optional: false
+ n2o_nit:
+ resolution: "annual"
+ optional: false
+ n2_emis:
+ resolution: "annual"
+ optional: false
+ bnf:
+ resolution: "annual"
+ optional: false
+ n_volatilization:
+ resolution: "annual"
+ optional: false
+ # Called boundaries functions
+ fun:
+ []
+
+ # Calculate mcol
+ mcol:
+ # LPJmL output IDs with required resolution
+ output:
+ grid:
+ resolution: "annual"
+ optional: false
+ npp:
+ resolution: "annual"
+ optional: false
+ pft_npp:
+ resolution: "annual"
+ optional: false
+ pft_harvestc:
+ resolution: "annual"
+ optional: false
+ pft_rharvestc:
+ resolution: "annual"
+ optional: false
+ firec:
+ resolution: "annual"
+ optional: false
+ timber_harvestc:
+ resolution: "annual"
+ optional: false
+ cftfrac:
+ resolution: "annual"
+ optional: false
+ fpc:
+ resolution: "annual"
+ optional: false
+ # Called boundaries functions
+ fun:
+ []
+
+ benchmark:
+ grid:
+ resolution: "annual"
+ optional: false
+ fpc:
+ resolution: "annual"
+ optional: false
+ globalflux:
+ resolution: "annual"
+ optional: false
+ npp:
+ resolution: "annual"
+ optional: false
+ gpp:
+ resolution: "annual"
+ optional: false
+ rh:
+ resolution: "annual"
+ optional: false
+ fapar:
+ resolution: "annual"
+ optional: false
+ transp:
+ resolution: "annual"
+ optional: false
+ runoff:
+ resolution: "annual"
+ optional: false
+ evap:
+ resolution: "annual"
+ optional: false
+ interc:
+ resolution: "annual"
+ optional: false
+ swc1:
+ resolution: "annual"
+ optional: false
+ swc2:
+ resolution: "annual"
+ optional: false
+ firef:
+ resolution: "annual"
+ optional: false
+ vegc:
+ resolution: "annual"
+ optional: false
+ soilc:
+ resolution: "annual"
+ optional: false
+ litc:
+ resolution: "annual"
+ optional: false
+ flux_estabc:
+ resolution: "annual"
+ optional: false
+ pft_vegc:
+ resolution: "annual"
+ optional: false
+ phen_tmin:
+ resolution: "annual"
+ optional: false
+ phen_tmax:
+ resolution: "annual"
+ optional: false
+ phen_light:
+ resolution: "annual"
+ optional: false
+ phen_water:
+ resolution: "annual"
+ optional: false
+ vegn:
+ resolution: "annual"
+ optional: false
+ soiln:
+ resolution: "annual"
+ optional: false
+ litn:
+ resolution: "annual"
+ optional: false
+ soiln_layer:
+ resolution: "annual"
+ optional: false
+ soilno3_layer:
+ resolution: "annual"
+ optional: false
+ soilnh4_layer:
+ resolution: "annual"
+ optional: false
+ soiln_slow:
+ resolution: "annual"
+ optional: false
+ soilnh4:
+ resolution: "annual"
+ optional: false
+ soilno3:
+ resolution: "annual"
+ optional: false
+ pft_nuptake:
+ resolution: "annual"
+ optional: false
+ nuptake:
+ resolution: "annual"
+ optional: false
+ leaching:
+ resolution: "annual"
+ optional: false
+ n2o_denit:
+ resolution: "annual"
+ optional: false
+ n2o_nit:
+ resolution: "annual"
+ optional: false
+ n2_emis:
+ resolution: "annual"
+ optional: false
+ bnf:
+ resolution: "annual"
+ optional: false
+ n_immo:
+ resolution: "annual"
+ optional: false
+ pft_ndemand:
+ resolution: "annual"
+ optional: false
+ firen:
+ resolution: "annual"
+ optional: false
+ n_mineralization:
+ resolution: "annual"
+ optional: false
+ n_volatilization:
+ resolution: "annual"
+ optional: false
+ pft_nlimit:
+ resolution: "annual"
+ optional: false
+ pft_vegn:
+ resolution: "annual"
+ optional: false
+ pft_cleaf:
+ resolution: "annual"
+ optional: false
+ pft_nleaf:
+ resolution: "annual"
+ optional: false
+ pft_laimax:
+ resolution: "annual"
+ optional: false
+ pft_croot:
+ resolution: "annual"
+ optional: false
+ pft_nroot:
+ resolution: "annual"
+ optional: false
+ pft_csapw:
+ resolution: "annual"
+ optional: false
+ pft_nsapw:
+ resolution: "annual"
+ optional: false
+ pft_chawo:
+ resolution: "annual"
+ optional: false
+ pft_nhawo:
+ resolution: "annual"
+ optional: false
+ firec:
+ resolution: "annual"
+ optional: false
+ discharge:
+ resolution: "annual"
+ optional: false
+ wateramount:
+ resolution: "annual"
+ optional: false
+ harvestc:
+ resolution: "annual"
+ optional: false
+ sdate:
+ resolution: "annual"
+ optional: false
+ pft_harvestc:
+ resolution: "annual"
+ optional: false
+ pft_rharvestc:
+ resolution: "annual"
+ optional: false
+ cftfrac:
+ resolution: "annual"
+ optional: false
+ seasonality:
+ resolution: "annual"
+ optional: false
+ pet:
+ resolution: "annual"
+ optional: false
+ albedo:
+ resolution: "annual"
+ optional: false
+ maxthaw_depth:
+ resolution: "annual"
+ optional: false
+ perc:
+ resolution: "annual"
+ optional: false
+ soiltemp1:
+ resolution: "annual"
+ optional: false
+ soiltemp2:
+ resolution: "annual"
+ optional: false
+ soiltemp3:
+ resolution: "annual"
+ optional: false
+ soilc_layer:
+ resolution: "annual"
+ optional: false
+ agb:
+ resolution: "annual"
+ optional: false
+ agb_tree:
+ resolution: "annual"
+ optional: false
+ return_flow_b:
+ resolution: "annual"
+ optional: false
+ transp_b:
+ resolution: "annual"
+ optional: false
+ evap_b:
+ resolution: "annual"
+ optional: false
+ interc_b:
+ resolution: "annual"
+ optional: false
+ prod_turnover:
+ resolution: "annual"
+ optional: false
+ deforest_emis:
+ resolution: "annual"
+ optional: false
+ conv_loss_evap:
+ resolution: "annual"
+ optional: false
+ conv_loss_drain:
+ resolution: "annual"
+ optional: false
+ irrig:
+ resolution: "annual"
+ optional: false
+ harvestn:
+ resolution: "annual"
+ optional: false
+ pft_harvestn:
+ resolution: "annual"
+ optional: false
+ pft_rharvestn:
+ resolution: "annual"
+ optional: false
+ bnf_agr:
+ resolution: "annual"
+ optional: false
+ nfert_agr:
+ resolution: "annual"
+ optional: false
+ nmanure_agr:
+ resolution: "annual"
+ optional: false
+ ndepo_agr:
+ resolution: "annual"
+ optional: false
+ nmineralization_agr:
+ resolution: "annual"
+ optional: false
+ nimmobilization_agr:
+ resolution: "annual"
+ optional: false
+ nuptake_agr:
+ resolution: "annual"
+ optional: false
+ nleaching_agr:
+ resolution: "annual"
+ optional: false
+ n2o_denit_agr:
+ resolution: "annual"
+ optional: false
+ n2o_nit_agr:
+ resolution: "annual"
+ optional: false
+ nh3_agr:
+ resolution: "annual"
+ optional: false
+ n2_agr:
+ resolution: "annual"
+ optional: false
+ harvestn_agr:
+ resolution: "annual"
+ optional: false
+ harvestc_agr:
+ resolution: "annual"
+ optional: false
+ seedn_agr:
+ resolution: "annual"
+ optional: false
+ cellfrac_agr:
+ resolution: "annual"
+ optional: false
+ litfalln_agr:
+ resolution: "annual"
+ optional: false
+
+
+# ---------------------------------------------------------------------------- #
+# Allowed output file names for LPJmL output IDs
+# ---------------------------------------------------------------------------- #
+file_name:
+ grid: ["grid"]
+ discharge: ["discharge", "mdischarge"]
+ irrig: ["irrig", "mirrig"]
+ rootmoist: ["rootmoist", "mrootmoist"]
+ swc: ["swc", "mswc"]
+ fpc: ["fpc"]
+ fpc_bft: ["fpc_bft"]
+ cftfrac: ["cftfrac"]
+ firec: ["firec", "mfirec"]
+ npp: ["npp", "mnpp"]
+ runoff: ["runoff", "mrunoff"]
+ transp: ["transp", "mtransp"]
+ vegc: ["vegc"]
+ firef: ["firef", "mfiref"]
+ rh: ["rh"]
+ harvestc: ["harvestc"]
+ evap: ["evap", "mevap"]
+ interc: ["interc", "minterc"]
+ soilc: ["soilc"]
+ litc: ["litc"]
+ vegn: ["vegn"]
+ soilnh4: ["soilnh4"]
+ soilno3: ["soilno3"]
+ leaching: ["leaching", "mleaching"]
+ n2o_denit: ["n2o_denit", "mn2o_denit"]
+ n2o_nit: ["n2o_nit", "mn2o_nit"]
+ n2_emis: ["n2_emis", "mn2_emis"]
+ bnf: ["bnf", "mbnf"]
+ n_volatilization: ["n_volatilization", "mn_volatilization"]
+ pft_npp: ["pft_npp"]
+ pft_harvestc: ["pft_harvestc"]
+ pft_rharvestc: ["pft_rharvestc"]
+ timber_harvestc: ["timber_harvestc"]
+ pft_lai: ["pft_lai", "mpft_lai"]
+ temp: ["temp", "mtemp"]
+ pet: ["pet", "mpet"]
+ prec: ["prec","mprec"]
diff --git a/inst/extdata/ne_110m_admin_0_countries.README.html b/inst/extdata/ne_110m_admin_0_countries.README.html
new file mode 100755
index 0000000000000000000000000000000000000000..80cc39fccca6299c7c09fe941f3b332d5c18e652
--- /dev/null
+++ b/inst/extdata/ne_110m_admin_0_countries.README.html
@@ -0,0 +1,404 @@
+
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
+
+<head profile="http://gmpg.org/xfn/11">
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
+
+<title>Admin 0 – Countries | Natural Earth</title>
+
+<link rel="shortcut icon" href="favicon.ico" type="image/x-icon">
+<link rel="alternate" type="application/rss+xml" title="Natural Earth RSS Feed" href="https://www.naturalearthdata.com/feed/" />
+<link rel="pingback" href="http://www.naturalearthdata.com/xmlrpc.php" />
+<script type="text/javascript" src="http://www.naturalearthdata.com/wp-content/themes/NEV/includes/js/suckerfish.js"></script>
+<!--[if lt IE 7]>
+ <script src="http://ie7-js.googlecode.com/svn/version/2.0(beta3)/IE7.js" type="text/javascript"></script>
+ <script defer="defer" type="text/javascript" src="http://www.naturalearthdata.com/wp-content/themes/NEV/includes/js/pngfix.js"></script>
+<![endif]-->
+<link rel="stylesheet" href="http://www.naturalearthdata.com/wp-content/themes/NEV/style.css" type="text/css" media="screen" />
+
+
+<!-- All in One SEO Pack 2.3.2.3 by Michael Torbert of Semper Fi Web Designob_start_detected [-1,-1] -->
+<meta name="description" content="There are 247 countries in the world. Greenland as separate from Denmark. About Countries distinguish between metropolitan (homeland)" />
+
+<link rel="canonical" href="https://www.naturalearthdata.com/downloads/110m-cultural-vectors/110m-admin-0-countries/" />
+<!-- /all in one seo pack -->
+<link rel="alternate" type="application/rss+xml" title="Natural Earth » Admin 0 – Countries Comments Feed" href="https://www.naturalearthdata.com/downloads/110m-cultural-vectors/110m-admin-0-countries/feed/" />
+ <script type="text/javascript">
+ window._wpemojiSettings = {"baseUrl":"https:\/\/s.w.org\/images\/core\/emoji\/72x72\/","ext":".png","source":{"concatemoji":"http:\/\/www.naturalearthdata.com\/wp-includes\/js\/wp-emoji-release.min.js?ver=4.4.15"}};
+ !function(a,b,c){function d(a){var c,d,e,f=b.createElement("canvas"),g=f.getContext&&f.getContext("2d"),h=String.fromCharCode;return g&&g.fillText?(g.textBaseline="top",g.font="600 32px Arial","flag"===a?(g.fillText(h(55356,56806,55356,56826),0,0),f.toDataURL().length>3e3):"diversity"===a?(g.fillText(h(55356,57221),0,0),c=g.getImageData(16,16,1,1).data,g.fillText(h(55356,57221,55356,57343),0,0),c=g.getImageData(16,16,1,1).data,e=c[0]+","+c[1]+","+c[2]+","+c[3],d!==e):("simple"===a?g.fillText(h(55357,56835),0,0):g.fillText(h(55356,57135),0,0),0!==g.getImageData(16,16,1,1).data[0])):!1}function e(a){var c=b.createElement("script");c.src=a,c.type="text/javascript",b.getElementsByTagName("head")[0].appendChild(c)}var f,g;c.supports={simple:d("simple"),flag:d("flag"),unicode8:d("unicode8"),diversity:d("diversity")},c.DOMReady=!1,c.readyCallback=function(){c.DOMReady=!0},c.supports.simple&&c.supports.flag&&c.supports.unicode8&&c.supports.diversity||(g=function(){c.readyCallback()},b.addEventListener?(b.addEventListener("DOMContentLoaded",g,!1),a.addEventListener("load",g,!1)):(a.attachEvent("onload",g),b.attachEvent("onreadystatechange",function(){"complete"===b.readyState&&c.readyCallback()})),f=c.source||{},f.concatemoji?e(f.concatemoji):f.wpemoji&&f.twemoji&&(e(f.twemoji),e(f.wpemoji)))}(window,document,window._wpemojiSettings);
+ </script>
+ <style type="text/css">
+img.wp-smiley,
+img.emoji {
+ display: inline !important;
+ border: none !important;
+ box-shadow: none !important;
+ height: 1em !important;
+ width: 1em !important;
+ margin: 0 .07em !important;
+ vertical-align: -0.1em !important;
+ background: none !important;
+ padding: 0 !important;
+}
+</style>
+<link rel='stylesheet' id='bbp-child-bbpress-css' href='http://www.naturalearthdata.com/wp-content/themes/NEV/css/bbpress.css?ver=2.5.8-5815' type='text/css' media='screen' />
+<!-- This site uses the Google Analytics by Yoast plugin v5.4.6 - Universal enabled - https://yoast.com/wordpress/plugins/google-analytics/ -->
+<script type="text/javascript">
+ (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+ (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+ m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+ })(window,document,'script','//www.google-analytics.com/analytics.js','__gaTracker');
+
+ __gaTracker('create', 'UA-10168306-1', 'auto');
+ __gaTracker('set', 'forceSSL', true);
+ __gaTracker('send','pageview');
+
+</script>
+<!-- / Google Analytics by Yoast -->
+<link rel='https://api.w.org/' href='https://www.naturalearthdata.com/wp-json/' />
+<link rel="EditURI" type="application/rsd+xml" title="RSD" href="https://www.naturalearthdata.com/xmlrpc.php?rsd" />
+<link rel="wlwmanifest" type="application/wlwmanifest+xml" href="http://www.naturalearthdata.com/wp-includes/wlwmanifest.xml" />
+<link rel='prev' title='Admin 0 – Details' href='https://www.naturalearthdata.com/downloads/110m-cultural-vectors/110m-admin-0-details/' />
+<link rel='next' title='Rivers, Lake Centerlines' href='https://www.naturalearthdata.com/downloads/110m-physical-vectors/110m-rivers-lake-centerlines/' />
+<meta name="generator" content="WordPress 4.4.15" />
+<link rel='shortlink' href='https://www.naturalearthdata.com/?p=1556' />
+<link rel="alternate" type="application/json+oembed" href="https://www.naturalearthdata.com/wp-json/oembed/1.0/embed?url=https%3A%2F%2Fwww.naturalearthdata.com%2Fdownloads%2F110m-cultural-vectors%2F110m-admin-0-countries%2F" />
+<link rel="alternate" type="text/xml+oembed" href="https://www.naturalearthdata.com/wp-json/oembed/1.0/embed?url=https%3A%2F%2Fwww.naturalearthdata.com%2Fdownloads%2F110m-cultural-vectors%2F110m-admin-0-countries%2F&format=xml" />
+
+ <script type="text/javascript">
+ /* <![CDATA[ */
+ var ajaxurl = 'https://www.naturalearthdata.com/wp-admin/admin-ajax.php';
+
+ /* ]]> */
+ </script>
+
+
+ <!-- begin gallery scripts -->
+ <link rel="stylesheet" href="http://www.naturalearthdata.com/wp-content/plugins/featured-content-gallery/css/jd.gallery.css.php" type="text/css" media="screen" charset="utf-8"/>
+ <link rel="stylesheet" href="http://www.naturalearthdata.com/wp-content/plugins/featured-content-gallery/css/jd.gallery.css" type="text/css" media="screen" charset="utf-8"/>
+ <script type="text/javascript" src="http://www.naturalearthdata.com/wp-content/plugins/featured-content-gallery/scripts/mootools.v1.11.js"></script>
+ <script type="text/javascript" src="http://www.naturalearthdata.com/wp-content/plugins/featured-content-gallery/scripts/jd.gallery.js.php"></script>
+ <script type="text/javascript" src="http://www.naturalearthdata.com/wp-content/plugins/featured-content-gallery/scripts/jd.gallery.transitions.js"></script>
+ <!-- end gallery scripts -->
+<script type="text/javascript">
+ window._se_plugin_version = '8.1.4';
+</script>
+<link href="http://www.naturalearthdata.com/wp-content/themes/NEV/css/default.css" rel="stylesheet" type="text/css" />
+ <style type="text/css">.recentcomments a{display:inline !important;padding:0 !important;margin:0 !important;}</style>
+ <style type="text/css">.broken_link, a.broken_link {
+ text-decoration: line-through;
+}</style><!--[if lte IE 7]>
+<link rel="stylesheet" type="text/css" href="http://www.naturalearthdata.com/wp-content/themes/NEV/ie.css" />
+<![endif]-->
+<script src="http://www.naturalearthdata.com/wp-content/themes/NEV/js/jquery-1.2.6.min.js" type="text/javascript" charset="utf-8"></script>
+<script>
+ jQuery.noConflict();
+</script>
+<script type="text/javascript" charset="utf-8">
+ $(function(){
+ var tabContainers = $('div#maintabdiv > div');
+ tabContainers.hide().filter('#comments').show();
+
+ $('div#maintabdiv ul#tabnav a').click(function () {
+ tabContainers.hide();
+ tabContainers.filter(this.hash).show();
+ $('div#maintabdiv ul#tabnav a').removeClass('current');
+ $(this).addClass('current');
+ return false;
+ }).filter('#comments').click();
+
+
+ });
+</script>
+
+ <script type="text/javascript" language="javascript" src="http://www.naturalearthdata.com/dataTables/media/js/jquery.dataTables.js"></script>
+ <script type="text/javascript" charset="utf-8">
+ $(document).ready(function() {
+ $('#ne_table').dataTable();
+ } );
+ </script>
+
+</head>
+<body>
+<div id="page">
+<div id="header">
+ <div id="headerimg">
+ <h1><a href="https://www.naturalearthdata.com/"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/nev_logo.png" alt="Natural Earth title="Natural Earth" /></a></h1>
+ <div class="description">Free vector and raster map data at 1:10m, 1:50m, and 1:110m scales</div>
+ <div class="header_search"><form method="get" id="searchform" action="https://www.naturalearthdata.com/">
+<label class="hidden" for="s">Search for:</label>
+<div><input type="text" value="" name="s" id="s" />
+<input type="submit" id="searchsubmit" value="Search" />
+</div>
+</form>
+</div>
+<!--<div class="translate_panel" style="align:top; margin-left:650px; top:50px;">
+<div id="google_translate_element" style="float:left;"></div>
+<script>
+function googleTranslateElementInit() {
+ new google.translate.TranslateElement({
+ pageLanguage: 'en'
+ }, 'google_translate_element');
+}
+</script>
+<script src="http://translate.google.com/translate_a/element.js?cb=googleTranslateElementInit"></script>
+</div>-->
+ </div>
+
+</div>
+
+<div id="pagemenu" style="align:bottom;">
+ <ul id="page-list" class="clearfix"><li class="page_item page-item-4"><a href="https://www.naturalearthdata.com/">Home</a></li>
+<li class="page_item page-item-10"><a href="https://www.naturalearthdata.com/features/">Features</a></li>
+<li class="page_item page-item-12 page_item_has_children"><a href="https://www.naturalearthdata.com/downloads/">Downloads</a></li>
+<li class="page_item page-item-6 current_page_parent"><a href="https://www.naturalearthdata.com/blog/">Blog</a></li>
+<li class="page_item page-item-14"><a href="https://www.naturalearthdata.com/forums">Forums</a></li>
+<li class="page_item page-item-366"><a href="https://www.naturalearthdata.com/corrections">Corrections</a></li>
+<li class="page_item page-item-16 page_item_has_children"><a href="https://www.naturalearthdata.com/about/">About</a></li>
+</ul>
+</div>
+
+<hr /> <div id="main">
+ <div id="content" class="narrowcolumn">
+
+
+ « <a href="https://www.naturalearthdata.com/downloads/110m-cultural-vectors/">1:110m Cultural Vectors</a>
+ « <a href="https://www.naturalearthdata.com/downloads/">Downloads</a>
+ <div class="post" id="post-1556">
+ <h2>Admin 0 – Countries</h2>
+ <div class="entry">
+ <div class="downloadPromoBlock">
+<div style="float: left; width: 170px;"><img class="alignleft size-thumbnail wp-image-92" title="home_image_3" src="https://www.naturalearthdata.com/wp-content/uploads/2009/09/thumb_countries.png" alt="countries_thumb" width="150" height="97" /></div>
+<div style="float: left; width: 410px;"><em>There are 247 countries in the world. Greenland as separate from Denmark.</em></p>
+<div class="download-link-div">
+ <a href="https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip" class="download-link" rel="nofollow" title="Downloaded 112585 times (Shapefile, geoDB, or TIFF format)" onclick="if (window.urchinTracker) urchinTracker ('https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip'); __gaTracker('send', 'event', 'download', 'https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip');">Download countries</a> <span class="download-link-span">(174.89 KB) version 4.0.0</span>
+</div>
+<div class="download-link-div">
+ <a href="https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries_lakes.zip" class="download-link" rel="nofollow" title="Downloaded 13513 times (Shapefile, geoDB, or TIFF format)" onclick="if (window.urchinTracker) urchinTracker ('https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries_lakes.zip'); __gaTracker('send', 'event', 'download', 'https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries_lakes.zip');">Download without boundary lakes</a> <span class="download-link-span">(177.11 KB) version 4.0.0</span>
+</div>
+<p><span id="more-1556"></span></div>
+</div>
+<div class="downloadMainBlock">
+<p><img class="alignnone size-full wp-image-1896" title="countries_banner" src="https://www.naturalearthdata.com/wp-content/uploads/2009/09/banner_countries.png" alt="countries_banner" width="580" height="150" /></p>
+<p><strong>About</strong></p>
+<p>Countries distinguish between metropolitan (homeland) and independent and semi-independent portions of sovereign states. If you want to see the dependent overseas regions broken out (like in ISO codes, see France for example), use <a href="https://www.naturalearthdata.com/downloads/10m-political-vectors/10m-admin-0-nitty-gritty/">map units</a> instead.</p>
+<p>Each country is coded with a world region that roughly follows the <a href="http://unstats.un.org/unsd/methods/m49/m49regin.htm" onclick="__gaTracker('send', 'event', 'outbound-article', 'http://unstats.un.org/unsd/methods/m49/m49regin.htm', 'United Nations setup');">United Nations setup</a>.</p>
+<p>Includes some thematic data from the United Nations, U.S. Central Intelligence Agency, and elsewhere.</p>
+<p><strong>Disclaimer</strong></p>
+<p>Natural Earth Vector draws boundaries of countries according to defacto status. We show who actually controls the situation on the ground. Please feel free to mashup our disputed areas (link) theme to match your particular political outlook.</p>
+<p><strong>Known Problems</strong></p>
+<p>None.</p>
+<p><strong>Version History</strong></p>
+ <ul>
+ <li>
+ <a href="https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip" onclick="__gaTracker('send', 'event', 'download', 'https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip');" rel="nofollow" title="Download version 4.0.0 of ne_110m_admin_0_countries.zip">4.0.0</a>
+ </li>
+ <li>
+ <a rel="nofollow" title="Download version 2.0.0 of ne_110m_admin_0_countries.zip" href="https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip?version=2.0.0">2.0.0</a>
+ </li>
+ <li>
+ 1.4.0
+ </li>
+ <li>
+ 1.3.0
+ </li>
+ <li>
+ 1.1.0
+ </li>
+ <li>
+ 1.0.0
+ </li>
+ </ul>
+
+<p><a href="https://github.com/nvkelso/natural-earth-vector/blob/master/CHANGELOG" onclick="__gaTracker('send', 'event', 'outbound-article', 'https://github.com/nvkelso/natural-earth-vector/blob/master/CHANGELOG', 'The master changelog is available on Github »');">The master changelog is available on Github »</a>
+</div>
+
+
+ </div>
+
+ </div>
+
+
+ </div>
+
+
+ <div id="sidebar">
+ <ul><li id='text-5' class='widget widget_text'><h2 class="widgettitle">Stay up to Date</h2>
+ <div class="textwidget"> Know when a new version of Natural Earth is released by subscribing to our <a href="https://www.naturalearthdata.com/updates/" class="up-to-date-link" >announcement list</a>.</div>
+ </li></ul><ul><li id='text-2' class='widget widget_text'><h2 class="widgettitle">Find a Problem?</h2>
+ <div class="textwidget"><div>
+<div style="float:left; width:65px;"><a href="/corrections/index.php?a=add"><img class="alignleft" title="New Ticket" src="https://www.naturalearthdata.com/corrections/img/newticket.png" alt="" width="60" height="60" /></a></div><div class="textwidget" style="float:left;width:120px; font-size:1.2em; font-size-adjust:none; font-style:normal;
+font-variant:normal; font-weight:normal; line-height:normal;">Submit suggestions and bug reports via our <a href="/corrections/index.php?a=add">correction system</a> and track the progress of your edits.</div>
+</div></div>
+ </li></ul><ul><li id='text-3' class='widget widget_text'><h2 class="widgettitle">Join Our Community</h2>
+ <div class="textwidget"><div>
+<div style="float:left; width:65px;"><a href="/forums/"><img src="https://www.naturalearthdata.com/wp-content/uploads/2009/08/green_globe_chat_bubble_562e.png" alt="forums" title="Chat in the forum!" width="50" height="50" /></a></div><div class="textwidget" style="float:left;width:120px; font-size:1.2em; font-size-adjust:none; font-style:normal;
+font-variant:normal; font-weight:normal; line-height:normal;">Talk back and discuss Natural Earth in the <a href="/forums/">Forums</a>.</div>
+</div></div>
+ </li></ul><ul><li id='text-4' class='widget widget_text'><h2 class="widgettitle">Thank You</h2>
+ <div class="textwidget">Our data downloads are generously hosted by Florida State University.</div>
+ </li></ul><ul><li id='bbp_topics_widget-3' class='widget widget_display_topics'><h2 class="widgettitle">Recent Forum Topics</h2>
+
+ <ul>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/natural-earth-in-wagner-vii/">Natural Earth in Wagner VII</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/downloads-are-404ing/">Downloads are 404ing</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/disputed-territories-type-field/">Disputed Territories: "type" field</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/iso-code-confusion/">ISO code confusion</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/bad-adm1name-encoding-in-version-3-0-0-and-missing-diacritics-in-name/">Bad ADM1NAME, encoding in version 3.0.0 and missing diacritics in NAME</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/u-s-county-shape-file-2/">U.S. County Shape File</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/projection-proportion-compatibility/">Projection / Proportion / Compatibility?</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/download-urls-double-slash/">Download URLs – double slash</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/map-soft-writer-me/">map soft – writer: me</a>
+
+
+
+ </li>
+
+
+ <li>
+ <a class="bbp-forum-title" href="https://www.naturalearthdata.com/forums/topic/unicode-encoding-issue-ne_10m_lakes-dbf/">Unicode encoding issue – ne_10m_lakes.dbf</a>
+
+
+
+ </li>
+
+
+ </ul>
+
+ </li></ul><ul><li id='bbpresswptweaks_login_links_widget-3' class='widget bbpresswptweaks_login_links_widget'><h2 class="widgettitle">Forum Login</h2>
+<div class="bbp-template-notice">
+ <a href="https://www.naturalearthdata.com/wp-login.php?redirect_to=/downloads/110m-cultural-vectors/110m-admin-0-countries/" rel="nofollow">Log in</a>
+ - or -
+ <a href="https://www.naturalearthdata.com/wp-login.php?action=register" rel="nofollow">Register</a>
+ </div></li></ul> </div>
+
+</div>
+<hr />
+<div id="footer">
+<div id="footerarea">
+ <div id="footerlogos">
+ <p>Supported by:</p>
+ <div class="footer-ad-box">
+ <a href="http://www.nacis.org" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/nacis.png" alt="NACIS" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.cartotalk.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/cartotalk_ad.png" alt="Cartotalk" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.mapgiving.org" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/mapgiving.png" alt="Mapgiving" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.geography.wisc.edu/cartography/" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/wisconsin.png" alt="University of Wisconsin Madison - Cartography Dept." /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.shadedrelief.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/shaded_relief.png" alt="Shaded Relief" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.xnrproductions.com " target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/xnr.png" alt="XNR Productions" /></a>
+ </div>
+
+ <p style="clear:both;"></p>
+
+ <div class="footer-ad-box">
+ <a href="http://www.freac.fsu.edu" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/fsu.png" alt="Florida State University - FREAC" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.springercartographics.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/scllc.png" alt="Springer Cartographics LLC" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.washingtonpost.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/wpost.png" alt="Washington Post" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.redgeographics.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/redgeo.png" alt="Red Geographics" /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://kelsocartography.com/blog " target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/kelso.png" alt="Kelso Cartography" /></a>
+ </div>
+
+ <p style="clear:both;"></p>
+ <div class="footer-ad-box">
+ <a href="http://www.avenza.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/avenza.png" alt="Avenza Systems Inc." /></a>
+ </div>
+ <div class="footer-ad-box">
+ <a href="http://www.stamen.com" target="_blank"><img src="http://www.naturalearthdata.com/wp-content/themes/NEV/images/stamen_ne_logo.png" alt="Stamen Design" /></a>
+ </div>
+
+
+ </div>
+ <p style="clear:both;"></p>
+ <span id="footerleft">
+ © 2009 - 2018. Natural Earth. All rights reserved.
+ </span>
+ <span id="footerright">
+ <!-- Please help promote WordPress and simpleX. Do not remove -->
+ <div>Powered by <a href="http://wordpress.org/">WordPress</a></div>
+ <div><a href="http://www.naturalearthdata.com/wp-admin">Staff Login »</a></div>
+ </span>
+</div>
+</div>
+ <script type='text/javascript' src='http://www.naturalearthdata.com/wp-includes/js/wp-embed.min.js?ver=4.4.15'></script>
+
+</body>
+</html>
+<!--Generated by Endurance Page Cache-->
\ No newline at end of file
diff --git a/inst/extdata/ne_110m_admin_0_countries.cpg b/inst/extdata/ne_110m_admin_0_countries.cpg
new file mode 100755
index 0000000000000000000000000000000000000000..3ad133c048f2189041151425a73485649e6c32c0
--- /dev/null
+++ b/inst/extdata/ne_110m_admin_0_countries.cpg
@@ -0,0 +1 @@
+UTF-8
\ No newline at end of file
diff --git a/inst/extdata/ne_110m_admin_0_countries.dbf b/inst/extdata/ne_110m_admin_0_countries.dbf
new file mode 100755
index 0000000000000000000000000000000000000000..6c45de91904d679991628fea782a47993e260cee
Binary files /dev/null and b/inst/extdata/ne_110m_admin_0_countries.dbf differ
diff --git a/inst/extdata/ne_110m_admin_0_countries.prj b/inst/extdata/ne_110m_admin_0_countries.prj
new file mode 100755
index 0000000000000000000000000000000000000000..b13a71791932a9ecb82a81800e49b3d5b307a195
--- /dev/null
+++ b/inst/extdata/ne_110m_admin_0_countries.prj
@@ -0,0 +1 @@
+GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.017453292519943295]]
\ No newline at end of file
diff --git a/inst/extdata/ne_110m_admin_0_countries.shp b/inst/extdata/ne_110m_admin_0_countries.shp
new file mode 100755
index 0000000000000000000000000000000000000000..9318e45c7015568100ad4d7a271790fbec966876
Binary files /dev/null and b/inst/extdata/ne_110m_admin_0_countries.shp differ
diff --git a/inst/extdata/ne_110m_admin_0_countries.shx b/inst/extdata/ne_110m_admin_0_countries.shx
new file mode 100755
index 0000000000000000000000000000000000000000..c3728e0dd6d23d5dca5cf848264b023a3b7e99b5
Binary files /dev/null and b/inst/extdata/ne_110m_admin_0_countries.shx differ
diff --git a/inst/extdata/ne_110m_wgs84_bounding_box.dbf b/inst/extdata/ne_110m_wgs84_bounding_box.dbf
new file mode 100755
index 0000000000000000000000000000000000000000..e2fab7a87ca691b83e56a37faf24d5b0463996c6
Binary files /dev/null and b/inst/extdata/ne_110m_wgs84_bounding_box.dbf differ
diff --git a/inst/extdata/ne_110m_wgs84_bounding_box.prj b/inst/extdata/ne_110m_wgs84_bounding_box.prj
new file mode 100755
index 0000000000000000000000000000000000000000..b13a71791932a9ecb82a81800e49b3d5b307a195
--- /dev/null
+++ b/inst/extdata/ne_110m_wgs84_bounding_box.prj
@@ -0,0 +1 @@
+GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.017453292519943295]]
\ No newline at end of file
diff --git a/inst/extdata/ne_110m_wgs84_bounding_box.shp b/inst/extdata/ne_110m_wgs84_bounding_box.shp
new file mode 100755
index 0000000000000000000000000000000000000000..c95f07c6a7a6cbc4c9d9e186812c5968310498fb
Binary files /dev/null and b/inst/extdata/ne_110m_wgs84_bounding_box.shp differ
diff --git a/inst/extdata/ne_110m_wgs84_bounding_box.shx b/inst/extdata/ne_110m_wgs84_bounding_box.shx
new file mode 100755
index 0000000000000000000000000000000000000000..ee0ce9bd5cb6a924b9136d983e75e17146c12972
Binary files /dev/null and b/inst/extdata/ne_110m_wgs84_bounding_box.shx differ
diff --git a/inst/extdata/pft_categories.csv b/inst/extdata/pft_categories.csv
new file mode 100755
index 0000000000000000000000000000000000000000..6906d53a513fbd5f0e50ad5615072a559bc37185
--- /dev/null
+++ b/inst/extdata/pft_categories.csv
@@ -0,0 +1,28 @@
+pft;type;zone_tropical;zone_temperate;zone_boreal;category_evergreen;category_needle;category_natural;lpjml_index_npft_9;lpjml_index_npft_11;lpjml_index_npft_NA
+tropical broadleaved evergreen tree;tree;1;0;0;1;0;1;1;1;NA
+tropical broadleaved raingreen tree;tree;1;0;0;0;0;1;2;2;NA
+temperate needleleaved evergreen tree;tree;0;1;0;1;1;1;3;3;NA
+temperate broadleaved evergreen tree;tree;0;1;0;1;0;1;4;4;NA
+temperate broadleaved summergreen tree;tree;0;1;0;0;0;1;5;5;NA
+boreal needleleaved evergreen tree;tree;0;0;1;1;1;1;6;6;NA
+boreal broadleaved summergreen tree;tree;0;0;1;0;0;1;7;7;NA
+boreal needleleaved summergreen tree;tree;0;0;1;0;1;1;NA;8;NA
+tropical c4 grass;grass;1;0;0;0;0;1;8;9;NA
+temperate c3 grass;grass;0;1;0;0;0;1;9;10;NA
+polar c3 grass;grass;0;0;1;0;0;1;NA;11;NA
+temperate cereals;grass;0;1;0;0;0;0;1;1;NA
+rice;grass;1;0;0;0;0;0;2;2;NA
+maize;grass;1;0;0;0;0;0;3;3;NA
+tropical cereals;grass;1;0;0;0;0;0;4;4;NA
+pulses;grass;0.5;0.5;0;0;0;0;5;5;NA
+temperate roots;grass;1;0;0;0;0;0;6;6;NA
+tropical roots;grass;1;0;0;0;0;0;7;7;NA
+oil crops sunflower;grass;0;1;0;0;0;0;8;8;NA
+oil crops soybean;grass;0.5;0.5;0;0;0;0;9;9;NA
+oil crops groundnut;grass;1;0;0;0;0;0;10;10;NA
+oil crops rapeseed;grass;0;1;0;0;0;0;11;11;NA
+sugarcane;grass;1;0;0;0;0;0;12;12;NA
+others;grass;0.5;0.5;0;0;0;0;13;13;NA
+grassland;grass;NA;NA;0;0;0;0;14;14;NA
+biomass grass;grass;NA;NA;0;0;0;0;15;15;NA
+biomass tree;grass;NA;NA;0;0;0;0;16;16;NA
diff --git a/inst/extdata/world_continents.README b/inst/extdata/world_continents.README
new file mode 100755
index 0000000000000000000000000000000000000000..ff0299f3858ed803049d19fc460d74a0a604e7ca
--- /dev/null
+++ b/inst/extdata/world_continents.README
@@ -0,0 +1,8 @@
+World Continents
+
+World Continents represents the boundaries for the continents of the world.
+
+Attributes:
+CONTINENT: The continent name. -
+
+exported on Wed Nov 28 13:23:33 -0500 2012
\ No newline at end of file
diff --git a/inst/extdata/world_continents.dbf b/inst/extdata/world_continents.dbf
new file mode 100755
index 0000000000000000000000000000000000000000..cda083cbba6537db089e172317bdf8050a06c657
Binary files /dev/null and b/inst/extdata/world_continents.dbf differ
diff --git a/inst/extdata/world_continents.shp b/inst/extdata/world_continents.shp
new file mode 100755
index 0000000000000000000000000000000000000000..f7325fcac552a6c73fb1e3135f6de5551b3e7cc6
Binary files /dev/null and b/inst/extdata/world_continents.shp differ
diff --git a/inst/extdata/world_continents.shx b/inst/extdata/world_continents.shx
new file mode 100755
index 0000000000000000000000000000000000000000..7b6d1babad848b3773bad8a6ccb6deaf36dbb005
Binary files /dev/null and b/inst/extdata/world_continents.shx differ
diff --git a/man/average_nyear_window.Rd b/man/average_nyear_window.Rd
new file mode 100755
index 0000000000000000000000000000000000000000..8a82a5cdde9761e92ee442d99a50863939424c4f
--- /dev/null
+++ b/man/average_nyear_window.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/average_nyear_window.R
+\name{average_nyear_window}
+\alias{average_nyear_window}
+\title{Calculate averages (mean) for defined window sizes}
+\usage{
+average_nyear_window(
+ x,
+ nyear_window = NULL,
+ moving_average = FALSE,
+ interpolate = FALSE,
+ nyear_reference = NULL
+)
+}
+\arguments{
+\item{x}{LPJmL output array with \code{dim(x)=c(cell, month, year)}}
+
+\item{nyear_window}{integer, if supplied it defines the years for each window
+to be averaged over in \code{dim(x)[3]}. If \code{nyear_window == 1} values are used
+directly (instead of calculating an average). nyear_window has to be smaller
+than \code{dim(x)[3]} and \code{dim(x)[3]} is ideally a multipe of nyear_window.
+Defaults to \code{NULL}}
+
+\item{moving_average}{logical. If \code{TRUE} moving average is computed. start
+and end are interpolated using spline interpolation.}
+
+\item{interpolate}{logical. If \code{TRUE} and nyear_window is defined (with
+\code{moving_average == FALSE} years are interpolated (spline) to return array
+with same dimensions as \code{x} (mainly\code{dim(x)[3]} -> year).}
+
+\item{nyear_reference}{integer, if supplied (default NULL), it defines a
+time_span for ideally reference runs to be used as a baseline. E.g.
+\code{nyear_reference = 30} to be used for preindustrial climate reference.}
+}
+\value{
+array with same amount of cells and months as x. 3rd dimension is
+defined by nyear_window, basically \code{dim(x)[3]/nyear_window} or equal to
+dim(x)\link{3} if \code{moving_average == TRUE} or \code{interpolate == TRUE}
+}
+\description{
+Define window sizes (nyear_window) to be used to calculate averages (mean)
+for each window (\code{dim(x)[3] / nyear_window}). Instead of discrete windows,
+also moving averages can be computed as well as years inbetween interpolated.
+}
diff --git a/man/calc_biocol.Rd b/man/calc_biocol.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..46b00c9fbc9aecbb91265892161aeef091493978
--- /dev/null
+++ b/man/calc_biocol.Rd
@@ -0,0 +1,95 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/biocol.R
+\name{calc_biocol}
+\alias{calc_biocol}
+\title{Calculate BioCol}
+\usage{
+calc_biocol(
+ path_lu,
+ path_pnv,
+ start_year,
+ stop_year,
+ reference_npp_time_span = NULL,
+ reference_npp_file = NULL,
+ varnames = NULL,
+ gridbased = TRUE,
+ read_saved_data = FALSE,
+ save_data = FALSE,
+ data_file = NULL,
+ include_fire = FALSE,
+ external_fire = FALSE,
+ external_wood_harvest = FALSE,
+ grass_scaling = FALSE,
+ npp_threshold = 20,
+ grass_harvest_file = "grazing_data.RData",
+ external_fire_file = "human_ignition_fraction.RData",
+ external_wood_harvest_file = "wood_harvest_biomass_sum_1500-2014_67420.RData"
+)
+}
+\arguments{
+\item{path_lu}{folder of landuse scenario run}
+
+\item{path_pnv}{folder of pnv reference run}
+
+\item{start_year}{first year of simulations}
+
+\item{stop_year}{last year of simulations}
+
+\item{reference_npp_time_span}{time span to read reference npp from, using
+index years 10:39 from potential npp input if set to NULL (default: NULL)}
+
+\item{reference_npp_file}{file to read reference npp from, using
+potential npp input if set to NULL (default: NULL)}
+
+\item{gridbased}{logical are pft outputs gridbased or pft-based?}
+
+\item{read_saved_data}{flag whether to read previously saved data
+instead of reading it in from output files (default FALSE)}
+
+\item{save_data}{whether to save input data to file (default FALSE)}
+
+\item{data_file}{file to save/read input data to/from (default NULL)}
+
+\item{include_fire}{boolean include firec in calculation of BioCol?
+(default TRUE)}
+
+\item{external_fire}{instead of reading in firec for fire emissions, read in
+this external firec file from a separate spitfire run with disabled
+lighning. this will then include only human induced fires
+(default FALSE)}
+
+\item{external_wood_harvest}{include external wood harvest from LUH2_v2h
+(default FALSE)}
+
+\item{grass_scaling}{whether to scale pasture harvest according to
+data given via grass_harvest_file (default FALSE)}
+
+\item{npp_threshold}{lower threshold for npp (to mask out non-lu areas
+according to Haberl et al. 2007). Below BioCol will be set to 0.
+(default: 20 gC/m2)}
+
+\item{grass_harvest_file}{file containing grazing data to rescale the
+grassland harvests according to Herrero et al. 2013. File contains:
+grazing_data list object with $name and $id of 29 world regions, and
+$Herrero_2000_kgDM_by_region containing for each of these regions and
+mapping_lpj67420_to_grazing_regions array with a mapping between 67420
+LPJmL cells and the 29 regions}
+
+\item{external_fire_file}{path to external file with human induced fire
+fraction c(cell,month,year) since 1500}
+
+\item{external_wood_harvest_file}{path to R-file containing processed
+timeline of maps for LUH2_v2h woodharvest}
+}
+\value{
+list data object containing BioCol and components as arrays: biocol,
+ biocol_overtime, biocol_overtime_perc_piref, biocol_perc,
+ biocol_perc_piref, npp_potential, npp_act_overtime, npp_pot_overtime,
+ npp_eco_overtime, harvest_cft_overtime, npp_luc_overtime,
+ rharvest_cft_overtime, fire_overtime, timber_harvest_overtime,
+ harvest_cft, biocol_harvest, grassland_scaling_factor_cellwise,
+ biocol_luc, biocol_luc_piref
+}
+\description{
+Wrapper function to calculate BioCol
+}
diff --git a/man/calc_delta_v.Rd b/man/calc_delta_v.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..f487e095ca4cb9fc2b35345c3bd822c8ed5a82e5
--- /dev/null
+++ b/man/calc_delta_v.Rd
@@ -0,0 +1,53 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{calc_delta_v}
+\alias{calc_delta_v}
+\title{Calculates changes in vegetation structure (vegetation_structure_change)}
+\usage{
+calc_delta_v(
+ fpc_ref,
+ fpc_scen,
+ bft_ref,
+ bft_scen,
+ cft_ref,
+ cft_scen,
+ weighting = "equal"
+)
+}
+\arguments{
+\item{fpc_ref}{reference fpc array (dim: [ncells,npfts+1])}
+
+\item{fpc_scen}{scenario fpc array (dim: [ncells,npfts+1])}
+
+\item{bft_ref}{reference bft array (dim: [ncells,nbfts])}
+
+\item{bft_scen}{scenario bft array (dim: [ncells,nbfts])}
+
+\item{cft_ref}{reference cft array (dim: [ncells,ncfts])}
+
+\item{cft_scen}{scenario cft array (dim: [ncells,ncfts])}
+
+\item{weighting}{apply "old" (Ostberg-like), "new", or "equal" weighting of
+vegetation_structure_change weights (default "equal")}
+}
+\value{
+vegetation_structure_change array of size ncells with the
+ vegetation_structure_change value [0,1] for each cell
+}
+\description{
+Utility function to calculate changes in vegetation structure
+(vegetation_structure_change) for calculation of EcoRisk
+}
+\examples{
+\dontrun{
+vegetation_structure_change <- calc_delta_v(
+ fpc_ref = fpc_ref_mean,
+ fpc_scen = apply(fpc_scen, c(1, 2), mean),
+ bft_ref = bft_ref_mean,
+ bft_scen = apply(bft_scen, c(1, 2), mean),
+ cft_ref = cft_ref_mean,
+ cft_scen = apply(cft_scen, c(1, 2), mean),
+ weighting = "equal"
+)
+}
+}
diff --git a/man/calc_ecorisk.Rd b/man/calc_ecorisk.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..dc0effc2ca9a7d8c70506d3fb99f99a3a9450623
--- /dev/null
+++ b/man/calc_ecorisk.Rd
@@ -0,0 +1,68 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{calc_ecorisk}
+\alias{calc_ecorisk}
+\title{Calculate the ecosystem change metric EcoRisk between 2 sets of states}
+\usage{
+calc_ecorisk(
+ fpc_ref,
+ fpc_scen,
+ bft_ref,
+ bft_scen,
+ cft_ref,
+ cft_scen,
+ state_ref,
+ state_scen,
+ weighting = "equal",
+ lat,
+ lon,
+ cell_area,
+ dimensions_only_local = FALSE,
+ nitrogen = TRUE
+)
+}
+\arguments{
+\item{fpc_ref}{reference run data for fpc}
+
+\item{fpc_scen}{scenario run data for fpc}
+
+\item{bft_ref}{reference run data for fpc_bft}
+
+\item{bft_scen}{scenario run data for fpc_bft}
+
+\item{cft_ref}{reference run data for cftfrac}
+
+\item{cft_scen}{scenario run data for cftfrac}
+
+\item{state_ref}{reference run data for state variables}
+
+\item{state_scen}{scenario run data for state variables}
+
+\item{weighting}{apply "old" (Ostberg-like), "new", or "equal" weighting of
+vegetation_structure_change weights (default "equal")}
+
+\item{lat}{latitude array}
+
+\item{lon}{longitude array}
+
+\item{cell_area}{cellarea array}
+
+\item{dimensions_only_local}{flag whether to use only local change component
+for water/carbon/nitrogen fluxes and pools, or use an average of
+local change, global change and ecosystem balance (default FALSE)}
+
+\item{nitrogen}{include nitrogen outputs (default: TRUE)}
+}
+\value{
+list data object containing arrays of ecorisk_total,
+ vegetation_structure_change, local_change, global_importance,
+ ecosystem_balance, carbon_stocks, carbon_fluxes, water_fluxes
+ (+ nitrogen_stocks and nitrogen_fluxes)
+}
+\description{
+Function to calculate the ecosystem change metric EcoRisk, based on
+gamma/vegetation_structure_change
+work from Sykes (1999), Heyder (2011), and Ostberg (2015,2018).
+This is a reformulated version in R, not producing 100% similar values
+than the C/bash version from Ostberg et al. 2018, but similar the methodology
+}
diff --git a/man/calculate_within_biome_diffs.Rd b/man/calculate_within_biome_diffs.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..634e3fa033c66943b619a3faf49a9d69b78636f7
--- /dev/null
+++ b/man/calculate_within_biome_diffs.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{calculate_within_biome_diffs}
+\alias{calculate_within_biome_diffs}
+\title{Calculate ecorisk with each biomes average cell}
+\usage{
+calculate_within_biome_diffs(
+ biome_classes,
+ data_file_base,
+ intra_biome_distrib_file,
+ create = FALSE,
+ res = 0.05,
+ plotting = FALSE,
+ plot_folder,
+ time_span_reference,
+ vars_ecorisk
+)
+}
+\arguments{
+\item{biome_classes}{biome classes object as returned by classify biomes,
+calculated for data_file_base}
+
+\item{data_file_base}{base EcoRisk to compute differences with (only ref is
+relevant)}
+
+\item{intra_biome_distrib_file}{file to additionally write results to}
+
+\item{create}{create new modified files, or read already existing ones?}
+
+\item{res}{how finegrained the distribution should be (resolution)}
+
+\item{plotting}{whether plots for each biome should be created}
+
+\item{plot_folder}{folder to plot into}
+
+\item{time_span_reference}{suitable 30 year reference period (e.g.
+c(1901,1930), c(1550,1579))}
+}
+\value{
+data object with distibution - dim: c(biomes,ecorisk_variables,bins)
+}
+\description{
+Function to calculate ecorisk with each biomes average cell
+as a measure of internal variability
+}
diff --git a/man/classify_biomes.Rd b/man/classify_biomes.Rd
new file mode 100755
index 0000000000000000000000000000000000000000..5b60f2b1817cabe04daab68911e6518fe921a886
--- /dev/null
+++ b/man/classify_biomes.Rd
@@ -0,0 +1,76 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/classify_biomes.R
+\name{classify_biomes}
+\alias{classify_biomes}
+\title{Classify biomes}
+\usage{
+classify_biomes(
+ path_reference = NULL,
+ files_reference = NULL,
+ time_span_reference,
+ savanna_proxy = list(pft_lai = 6),
+ montane_arctic_proxy = list(elevation = 1000),
+ tree_cover_thresholds = list(),
+ avg_nyear_args = list(),
+ input_files = list(),
+ diff_output_files = list()
+)
+}
+\arguments{
+\item{path_reference}{path to the reference LPJmL run. If not provided,
+the path is extracted from the file paths provided in files_reference.}
+
+\item{files_reference}{list with variable names and corresponding file paths
+(character string) of the reference LPJmL run. All needed files are
+provided as key value pairs, e.g.:
+list(leaching = "/temp/leaching.bin.json"). If not needed for the
+applied method, set to NULL.}
+
+\item{time_span_reference}{time span to be used for the scenario run, defined
+as an character string, e.g. `as.character(1901:1930)`.}
+
+\item{savanna_proxy}{`list` with either pft_lai or vegc as
+key and value in m2/m2 for pft_lai (default = 6) and gC/m2 for
+vegc (default would be 7500), Set to `NULL` if no proxy should be
+used.}
+
+\item{montane_arctic_proxy}{`list` with either "elevation" or "latitude" as
+name/key and value in m for elevation (default 1000) and degree for
+latitude (default would be 55), Set to `NULL` if no proxy is used.}
+
+\item{tree_cover_thresholds}{list with minimum tree cover thresholds for
+definition of forest, woodland, savanna and grassland. Only changes to
+the default have to be included in the list, for the rest the default
+is used.
+Default values, based on the IGBP land cover classification system:
+"boreal forest" = 0.6
+"temperate forest" = 0.6
+"temperate woodland" = 0.3
+"temperate savanna" = 0.1
+"tropical forest" = 0.6
+"tropical woodland" = 0.3
+"tropical savanna" = 0.1
+In the boreal zone, there is no woodland, everything below the
+boreal forest threshold will be classified as boreal tundra.}
+
+\item{avg_nyear_args}{list of arguments to be passed to
+\link[biospheremetrics]{average_nyear_window} (see for more info).
+To be used for time series analysis}
+}
+\value{
+list object containing biome_id (main biome per grid cell [dim=c(ncells)]), # nolint
+and list of respective biome_names[dim=c(nbiomes)]
+}
+\description{
+Classify biomes based on foliage protected cover (FPC) and temperature
+LPJmL output plus either vegetation carbon or pft_lai depending on
+the savanna_proxy option and elevation if montane_arctic_proxy requires this
+}
+\examples{
+\dontrun{
+classify_biomes(
+ path_data = "/p/projects/open/Fabian/runs/Gamma/output/historic_gamma"
+ timespan = c(1982:2011))
+}
+
+}
diff --git a/man/disaggregate_into_biomes.Rd b/man/disaggregate_into_biomes.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..9e334236d0cf42661d26462646e9c2c1e7e74556
--- /dev/null
+++ b/man/disaggregate_into_biomes.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{disaggregate_into_biomes}
+\alias{disaggregate_into_biomes}
+\title{Averages EcoRisk values across regions}
+\usage{
+disaggregate_into_biomes(
+ data,
+ biome_class,
+ type = "quantile",
+ classes = "4biomes"
+)
+}
+\arguments{
+\item{data}{List object, of which every item should be disaggregated}
+
+\item{biome_class}{biome class list object as returned by classify_biomes}
+
+\item{type}{string controlling whether to return minimum, mean, maximum
+("minmeanmax") or Q10,Q50,Q90 ("quantile") - default: "quantile"}
+
+\item{classes}{string for into how many regions should be disaggregated
+"4biomes" (tropics/temperate/boreal/arctic) or "allbiomes"}
+}
+\description{
+Returns the average value across either 4 regions or all (19) biomes for
+EcoRisk and each of the subcomponents for each
+}
+\examples{
+\dontrun{
+disaggregate_into_biomes(
+ ecorisk = ecorisk,
+ biome_class = biome_classes,
+ type = "quantile", classes = "4biomes"
+)
+}
+}
diff --git a/man/ecorisk_cross_table.Rd b/man/ecorisk_cross_table.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..0d926cfce58cb4cd63a51526e4a93bd5149bc089
--- /dev/null
+++ b/man/ecorisk_cross_table.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{ecorisk_cross_table}
+\alias{ecorisk_cross_table}
+\title{Create modified EcoRisk data for crosstable}
+\usage{
+ecorisk_cross_table(
+ data_file_in,
+ data_file_out,
+ biome_classes_in,
+ pick_cells = NULL
+)
+}
+\arguments{
+\item{data_file_in}{path to input data}
+
+\item{data_file_out}{path to save modified data to}
+
+\item{biome_classes_in}{biome classes object as returned from classify_biomes}
+
+\item{pick_cells}{pick one specific cell as representative for the biome
+instead of computing the average state}
+}
+\description{
+Function to create a modified EcoRisk data file where for each biome
+the average scenario cell is compared to the average scenario cell of all
+other biomes. This can then be used to compute a crosstable with the average
+difference between each of them as in the SI of Ostberg et al. 2013
+(Critical impacts of global warming on land ecosystems)
+}
diff --git a/man/ecorisk_wrapper.Rd b/man/ecorisk_wrapper.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..3ad1e829a24a9f0e627b32350d34d02261fa84a2
--- /dev/null
+++ b/man/ecorisk_wrapper.Rd
@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{ecorisk_wrapper}
+\alias{ecorisk_wrapper}
+\title{Wrapper for calculating the ecosystem change metric EcoRisk}
+\usage{
+ecorisk_wrapper(
+ path_ref,
+ path_scen,
+ read_saved_data = FALSE,
+ save_data = NULL,
+ save_ecorisk = NULL,
+ nitrogen = TRUE,
+ weighting = "equal",
+ varnames = NULL,
+ time_span_reference,
+ time_span_scenario,
+ dimensions_only_local = FALSE,
+ overtime = FALSE,
+ window = 30,
+ debug = FALSE
+)
+}
+\arguments{
+\item{path_ref}{folder of reference run}
+
+\item{path_scen}{folder of scenario run}
+
+\item{read_saved_data}{whether to read in previously saved data
+(default: FALSE)}
+
+\item{save_data}{file to save read in data to (default NULL)}
+
+\item{save_ecorisk}{file to save EcoRisk data to (default NULL)}
+
+\item{nitrogen}{include nitrogen outputs for pools and fluxes into EcoRisk
+calculation (default FALSE)}
+
+\item{weighting}{apply "old" (Ostberg-like), "new", or "equal" weighting of
+vegetation_structure_change weights (default "equal")}
+
+\item{varnames}{data.frame with names of output files (outname) and time res.
+(timestep) -- can be specified to account for variable file names
+(default NULL -- standard names as below)}
+
+\item{time_span_reference}{vector of years to use as scenario period}
+
+\item{time_span_scenario}{vector of years to use as scenario period}
+
+\item{dimensions_only_local}{flag whether to use only local change component
+for water/carbon/nitrogen fluxes and pools, or use an average of
+local change, global change and ecosystem balance (default FALSE)}
+
+\item{overtime}{logical: calculate ecorisk as time-series? (default: FALSE)}
+
+\item{window}{integer, number of years for window length (default: 30)}
+
+\item{debug}{write out all nitrogen state variables (default FALSE)}
+}
+\value{
+list data object containing arrays of ecorisk_total,
+ vegetation_structure_change, local_change, global_importance,
+ ecosystem_balance, carbon_stocks, carbon_fluxes, water_fluxes
+ (+ nitrogen_stocks and nitrogen_fluxes)
+}
+\description{
+Function to read in data for ecorisk, and call the calculation function once,
+if overtime is FALSE, or for each timeslice of length window years, if
+overtime is TRUE
+}
diff --git a/man/get_biome_names.Rd b/man/get_biome_names.Rd
new file mode 100755
index 0000000000000000000000000000000000000000..78227be7b151e29540fed174ecf344ad73ffecee
--- /dev/null
+++ b/man/get_biome_names.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{get_biome_names}
+\alias{get_biome_names}
+\title{Get biome names}
+\usage{
+get_biome_names(biome_name_length = 2)
+}
+\arguments{
+\item{biome_name_length}{integer chose from 1,2,3 for abbreviated, short,
+or full biome names}
+}
+\description{
+Returns biome names with variable length (abbreviated, short, or full)
+}
diff --git a/man/plot_biocol.Rd b/man/plot_biocol.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..ba17dd79402f9892b524e1d1765dd1399c8390a8
--- /dev/null
+++ b/man/plot_biocol.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/biocol.R
+\name{plot_biocol}
+\alias{plot_biocol}
+\title{Plot absolute BioCol, overtime, maps, and npp into given folder}
+\usage{
+plot_biocol(
+ biocol_data,
+ path_write,
+ plotyears,
+ min_val,
+ max_val,
+ legendpos,
+ start_year,
+ mapyear,
+ mapyear_buffer = 5,
+ highlightyear,
+ eps = FALSE
+)
+}
+\arguments{
+\item{biocol_data}{biocol data list object (returned from calc_biocol)
+containing biocol, npp_eco_overtime, npp_act_overtime, npp_pot_overtime,
+npp_bioenergy_overtime, biocol_overtime, npp_harv_overtime,
+biocol_overtime_perc_piref, biocol_perc, biocol_perc_piref, npp all in GtC}
+
+\item{path_write}{folder to write into}
+
+\item{plotyears}{range of years to plot over time}
+
+\item{min_val}{y-axis minimum value for plot over time}
+
+\item{max_val}{y-axis maximum value for plot over time}
+
+\item{legendpos}{position of legend}
+
+\item{start_year}{first year of biocol_data object}
+
+\item{mapyear}{year to plot biocol map for}
+
+\item{mapyear_buffer}{+- years around mapyear to average biocol
+(make sure these years exist in biocol_data)}
+
+\item{highlightyear}{year(s) that should be highlighted in overtime plot}
+
+\item{eps}{write plots as eps, instead of png (default = FALSE)}
+}
+\value{
+none
+}
+\description{
+Wrapper function to plot absolute biocol, overtime, maps, and npp into given
+folder
+}
diff --git a/man/plot_biocol_map.Rd b/man/plot_biocol_map.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..7bbe816e90b5b66d70387d0bc104ff1a590f1c39
--- /dev/null
+++ b/man/plot_biocol_map.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/biocol.R
+\name{plot_biocol_map}
+\alias{plot_biocol_map}
+\title{Plot global map of BioCol to file}
+\usage{
+plot_biocol_map(
+ data,
+ file,
+ title = "",
+ legendtitle = "",
+ zero_threshold = 0.1,
+ eps = FALSE
+)
+}
+\arguments{
+\item{data}{array containing BioCol percentage value for each gridcell}
+
+\item{file}{character string for location/file to save plot to}
+
+\item{title}{character string title for plot}
+
+\item{legendtitle}{character string legend title}
+
+\item{zero_threshold}{smallest value to be distinguished from 0 in legend,
+both for negative and positive values (default: 0.1)}
+
+\item{eps}{write eps file instead of PNG (boolean) - (default: FALSE)}
+
+\item{plotyears}{range of years to plot over time}
+}
+\value{
+none
+}
+\description{
+Plot global map of BioCol to file with legend colors similar to
+Haberl et al. 2007
+}
diff --git a/man/plot_biocol_ts.Rd b/man/plot_biocol_ts.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..6948966307a850c65eae63cde8c3e4dd7ac4b5d4
--- /dev/null
+++ b/man/plot_biocol_ts.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/biocol.R
+\name{plot_biocol_ts}
+\alias{plot_biocol_ts}
+\title{Plot absolute BioCol, overtime, maps, and npp into given folder}
+\usage{
+plot_biocol_ts(
+ biocol_data,
+ file,
+ first_year,
+ plot_years,
+ highlight_years = 2000,
+ min_val = 0,
+ max_val = 100,
+ legendpos = "topleft",
+ ext = FALSE,
+ eps = FALSE,
+ ref = "pi"
+)
+}
+\arguments{
+\item{biocol_data}{biocol data list object (returned from calc_biocol)
+containing biocol, npp_eco_overtime, npp_act_overtime, npp_pot_overtime,
+npp_bioenergy_overtime, biocol_overtime, npp_harv_overtime,
+biocol_overtime_perc_piref, biocol_perc, biocol_perc_piref, npp
+all in GtC}
+
+\item{file}{character string for location/file to save plot to}
+
+\item{first_year}{first year of biocol object}
+
+\item{plot_years}{range of years to plot over time}
+
+\item{highlight_years}{year(s) that should be highlighted in overtime plot
+(default: 2000)}
+
+\item{min_val}{y-axis minimum value for plot over time (default: 0)}
+
+\item{max_val}{y-axis maximum value for plot over time (default: 100)}
+
+\item{legendpos}{position of legend (default: "topleft")}
+
+\item{eps}{write plots as eps, instead of png (default = FALSE)}
+
+\item{ref}{reference period for biocol ("pi" or "act"), to either use
+biocol_data$biocol_overtime_perc_piref or biocol_data$biocol_overtime}
+}
+\value{
+none
+}
+\description{
+Plot to file a comparison over time of global sums of BioCol, NPPpot, NPPeco,
+and NPPact, with legend similar to Krausmann et al. 2013
+}
diff --git a/man/plot_biome_averages.Rd b/man/plot_biome_averages.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..98dea9bdc4f9cf012431a7e989e24958a67d76e3
--- /dev/null
+++ b/man/plot_biome_averages.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_biome_averages}
+\alias{plot_biome_averages}
+\title{Plot radial EcoRisk plot to file with 4/16 biomes}
+\usage{
+plot_biome_averages(
+ data,
+ file,
+ biome_class_names,
+ title = "",
+ title_size = 2,
+ leg_scale = 1,
+ eps = FALSE,
+ palette = NULL
+)
+}
+\arguments{
+\item{data}{EcoRisk data array c(4[biomes],[nEcoRiskcomponents],
+3[min,median,max])}
+
+\item{file}{to write into}
+
+\item{biome_class_names}{to write into}
+
+\item{title}{character string title for plot, default empty}
+
+\item{title_size}{character string title for plot}
+
+\item{leg_scale}{character string title for plot}
+
+\item{eps}{write as eps, replacing png in filename (default: True)}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+}
+\value{
+None
+}
+\description{
+Function to plot an aggregated radial status of EcoRisk values [0-1]
+for the different sub-categories to file
+}
diff --git a/man/plot_biome_averages_to_screen.Rd b/man/plot_biome_averages_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..c0d448c80ef5d3080977e6334972a7c62ba54dde
--- /dev/null
+++ b/man/plot_biome_averages_to_screen.Rd
@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_biome_averages_to_screen}
+\alias{plot_biome_averages_to_screen}
+\title{Plot radial EcoRisk plot to file with 4/16 biomes}
+\usage{
+plot_biome_averages_to_screen(
+ data,
+ biome_class_names,
+ title = "",
+ title_size = 2,
+ leg_scale = 0.5,
+ palette = NULL
+)
+}
+\arguments{
+\item{data}{input data with dimension c(nbiome_classes,3) -- Q10,Q50,Q90 each}
+
+\item{biome_class_names}{to write into}
+
+\item{title}{character string title for plot, default empty}
+
+\item{title_size}{character string title for plot}
+
+\item{leg_scale}{character string title for plot}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+}
+\value{
+None
+}
+\description{
+Function to plot an aggregated radial status of EcoRisk values [0-1]
+for the different sub-categories to file
+}
diff --git a/man/plot_biome_internal_distribution.Rd b/man/plot_biome_internal_distribution.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..5ce0ca6b6acb874921ca49e26784b02ff4c23dc8
--- /dev/null
+++ b/man/plot_biome_internal_distribution.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_biome_internal_distribution}
+\alias{plot_biome_internal_distribution}
+\title{Plot to file distribution of similarity within biomes}
+\usage{
+plot_biome_internal_distribution(
+ data,
+ file,
+ biomes_abbrv,
+ scale,
+ title = "",
+ legendtitle = "",
+ eps = FALSE,
+ palette = NULL
+)
+}
+\arguments{
+\item{data}{data object with distibution - as returned by
+calculateWithInBiomeDiffs. dim: c(biomes,bins)}
+
+\item{file}{to write into}
+
+\item{biomes_abbrv}{to mask the focus_biome from}
+
+\item{scale}{scaling factor for distribution. defaults to 1}
+
+\item{title}{character string title for plot, default empty}
+
+\item{legendtitle}{character string legend title, default empty}
+
+\item{eps}{write as eps or png (default: FALSE -> png)}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+}
+\value{
+None
+}
+\description{
+Function to plot to file the distribution of similarity within biomes
+}
diff --git a/man/plot_biome_internal_distribution_to_screen.Rd b/man/plot_biome_internal_distribution_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..8b2c73c7aa1d6740f40d1fcca47e21dd5d75baf7
--- /dev/null
+++ b/man/plot_biome_internal_distribution_to_screen.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_biome_internal_distribution_to_screen}
+\alias{plot_biome_internal_distribution_to_screen}
+\title{Plot distribution of similarity within biomes}
+\usage{
+plot_biome_internal_distribution_to_screen(
+ data,
+ biomes_abbrv,
+ title = "",
+ legendtitle = "",
+ scale = 1,
+ palette = NULL
+)
+}
+\arguments{
+\item{data}{data object with distibution - as returned by
+calculateWithInBiomeDiffs for each subcategory of ecorisk.
+dim: c(biomes,bins)}
+
+\item{biomes_abbrv}{to mask the focus_biome from}
+
+\item{title}{character string title for plot, default empty}
+
+\item{legendtitle}{character string legend title, default empty}
+
+\item{scale}{scaling factor for distribution. defaults to 1}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+}
+\value{
+None
+}
+\description{
+Function to plot the distribution of similarity within biomes
+}
diff --git a/man/plot_biomes.Rd b/man/plot_biomes.Rd
new file mode 100755
index 0000000000000000000000000000000000000000..e6b431d40bfc62b8fd3765c05c36d8b45a3ada17
--- /dev/null
+++ b/man/plot_biomes.Rd
@@ -0,0 +1,74 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R, R/plot_biomes.R
+\name{plot_biomes}
+\alias{plot_biomes}
+\title{Plot biomes to file}
+\usage{
+plot_biomes(
+ biome_data,
+ file_name = NULL,
+ display_area = FALSE,
+ to_robinson = TRUE,
+ cellarea = NULL,
+ order_legend = c(1, 2, 9, 10, 11, 3, 4, 5, 12, 13, 14, 6, 7, 8, 15, 16, 17, 18, 19),
+ bg_col = "white"
+)
+
+plot_biomes(
+ biome_data,
+ file_name = NULL,
+ display_area = FALSE,
+ to_robinson = TRUE,
+ cellarea = NULL,
+ order_legend = c(1, 2, 9, 10, 11, 3, 4, 5, 12, 13, 14, 6, 7, 8, 15, 16, 17, 18, 19),
+ bg_col = "white"
+)
+}
+\arguments{
+\item{biome_data}{output (list) from classify_biomes()}
+
+\item{file_name}{directory for saving the plot (character string)}
+
+\item{display_area}{boolean, adding occupied area per biome (default FALSE)}
+
+\item{to_robinson}{logical to define if robinson projection should be used
+for plotting}
+
+\item{order_legend}{in which order the biomes should be displayed
+default: c(1,2,9,10,11,3,4,5,12,13,14,6,7,8,15,16,17,18,19)}
+
+\item{bg_col}{character, specify background possible (\code{NA} for transparent)}
+
+\item{biome_ids}{biome id as given by classify_biomes}
+
+\item{biome_name_length}{length of biome names in legend: 1 - abbreviation,
+2 - short name, 3 - full biome name}
+
+\item{file}{to write into}
+
+\item{title}{character string title for plot, default empty}
+
+\item{title_size}{size of title in cex units (defaukt: 2)}
+
+\item{leg_yes}{whether to plot legend (default: True)}
+
+\item{leg_scale}{size of legend in cex units (default 0.5)}
+
+\item{eps}{write as eps, replacing png in filename (default: True)}
+}
+\value{
+None
+}
+\description{
+Function to plot biome classification to file
+
+Plots a map with the biome distribution as derived from a lpjml run based
+on the "classify_biomes" function
+}
+\examples{
+\dontrun{
+ plot_biomes(biome_data = biomes,
+ file_name ="/p/projects/open/Johanna/R/biomes.pfd")
+}
+
+}
diff --git a/man/plot_biomes_to_screen.Rd b/man/plot_biomes_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..502a551b27fc06b481155ccfdd5f56e073be33a4
--- /dev/null
+++ b/man/plot_biomes_to_screen.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_biomes_to_screen}
+\alias{plot_biomes_to_screen}
+\title{Plot biomes}
+\usage{
+plot_biomes_to_screen(
+ biome_ids,
+ biome_name_length = 1,
+ order_legend = "plants",
+ title = "",
+ title_size = 2,
+ leg_yes = TRUE,
+ leg_scale = 0.5
+)
+}
+\arguments{
+\item{biome_ids}{biome id as given by classify_biomes}
+
+\item{biome_name_length}{length of biome names in legend: 1 - abbreviation,
+2 - short name, 3 - full biome name}
+
+\item{title}{character string title for plot, default empty}
+
+\item{title_size}{size of title in cex units (defaukt: 2)}
+
+\item{leg_yes}{whether to plot legend (default: True)}
+
+\item{leg_scale}{size of legend in cex units (default 0.5)}
+
+\item{order}{legend order: either "plants" to first have forests, then
+grasslands, then tundra ..., or "zones" to go from north to south
+(default: "plants")}
+}
+\value{
+None
+}
+\description{
+Function to plot biome classification
+}
diff --git a/man/plot_eco_riskmap_to_screen.Rd b/man/plot_eco_riskmap_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..46f5b858d824a79301b2e87c914f8ea4d1208c47
--- /dev/null
+++ b/man/plot_eco_riskmap_to_screen.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_eco_riskmap_to_screen}
+\alias{plot_eco_riskmap_to_screen}
+\title{Plot EcoRisk map to screen}
+\usage{
+plot_eco_riskmap_to_screen(
+ data,
+ focus_biome = NULL,
+ biome_classes = NULL,
+ title = "",
+ legendtitle = "",
+ title_size = 1,
+ leg_yes = TRUE,
+ palette = NULL
+)
+}
+\arguments{
+\item{data}{folder of reference run}
+
+\item{focus_biome}{highlight the biome with this id and desaturate all other
+(default NULL -- no highlight)}
+
+\item{biome_classes}{to mask the focus_biome from}
+
+\item{title}{character string title for plot, default empty}
+
+\item{legendtitle}{character string legend title}
+
+\item{leg_yes}{logical. whether to plot legend or not. defaults to TRUE}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+
+\item{leg_scale}{scaling factor for legend. defaults to 1}
+}
+\value{
+None
+}
+\description{
+Function to plot a global map of EcoRisk values [0-1] per grid cell to screen
+}
diff --git a/man/plot_ecorisk_cross_table.Rd b/man/plot_ecorisk_cross_table.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..344328e9e6a382cc85f0b4744e5cda4730c27ba0
--- /dev/null
+++ b/man/plot_ecorisk_cross_table.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_cross_table}
+\alias{plot_ecorisk_cross_table}
+\title{Plot crosstable to file showing (dis-)similarity between average biome pixels}
+\usage{
+plot_ecorisk_cross_table(data, file, lmar = 3, eps = FALSE, palette = NULL)
+}
+\arguments{
+\item{data}{crosstable data as array with [nbiomes,nbiomes] and row/colnames}
+
+\item{file}{to write into}
+
+\item{lmar}{left margin for plot in lines (default: 3)}
+
+\item{eps}{write as eps or png}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+}
+\value{
+None
+}
+\description{
+Function to plot to file a crosstable showing (dis-)similarity between
+average biome pixels based on EcoRisk (former Gamma) metric from LPJmL
+simulations
+}
diff --git a/man/plot_ecorisk_cross_table_to_screen.Rd b/man/plot_ecorisk_cross_table_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..69772903ff5ea9bf1aa8db42c165dad5e1be0898
--- /dev/null
+++ b/man/plot_ecorisk_cross_table_to_screen.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_cross_table_to_screen}
+\alias{plot_ecorisk_cross_table_to_screen}
+\title{Plot crosstable showing (dis-)similarity between average biome pixels}
+\usage{
+plot_ecorisk_cross_table_to_screen(data, lmar = 3, palette = NULL)
+}
+\arguments{
+\item{data}{crosstable data as array with [nbiomes,nbiomes] and row/colnames}
+
+\item{lmar}{left margin for plot in lines (default: 3)}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+}
+\value{
+None
+}
+\description{
+Function to plot a crosstable showing (dis-)similarity between average
+biome pixels based on EcoRisk (former gamma) metric from LPJmL simulations
+}
diff --git a/man/plot_ecorisk_map.Rd b/man/plot_ecorisk_map.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..eefbaddb3d27d8254281ec610ef31ea2db23a3f9
--- /dev/null
+++ b/man/plot_ecorisk_map.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_map}
+\alias{plot_ecorisk_map}
+\title{Plot EcoRisk map to file}
+\usage{
+plot_ecorisk_map(
+ data,
+ file,
+ focus_biome = NULL,
+ biome_classes = NULL,
+ title = "",
+ legendtitle = "",
+ eps = FALSE,
+ title_size = 1,
+ leg_yes = TRUE,
+ palette = NULL
+)
+}
+\arguments{
+\item{data}{folder of reference run}
+
+\item{file}{to write into}
+
+\item{focus_biome}{highlight the biome with this id and desaturate all other
+(default NULL -- no highlight)}
+
+\item{biome_classes}{to mask the focus_biome from}
+
+\item{title}{character string title for plot, default empty}
+
+\item{legendtitle}{character string legend title}
+
+\item{eps}{write as eps or png}
+
+\item{leg_yes}{logical. whether to plot legend or not. defaults to TRUE}
+
+\item{palette}{color palette to plot EcoRisk with, defaults to the Ostberg
+color scheme white-blue-yellow-red}
+
+\item{leg_scale}{scaling factor for legend. defaults to 1}
+}
+\value{
+None
+}
+\description{
+Function to plot a global map of EcoRisk values [0-1] per grid cell to file
+}
diff --git a/man/plot_ecorisk_over_time_panel.Rd b/man/plot_ecorisk_over_time_panel.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..a2667110c4e9674be019f49a11fec90f6e79568a
--- /dev/null
+++ b/man/plot_ecorisk_over_time_panel.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_over_time_panel}
+\alias{plot_ecorisk_over_time_panel}
+\title{Plot timeline of EcoRisk variables as panel to file with 4/16 biomes}
+\usage{
+plot_ecorisk_over_time_panel(
+ data,
+ biome_names,
+ file,
+ yrange = c(0, 1),
+ timerange,
+ eps = FALSE,
+ varnames = NULL
+)
+}
+\arguments{
+\item{data}{EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+3[min,mean,max])}
+
+\item{biome_names}{names of biomes}
+
+\item{file}{to write into}
+
+\item{yrange}{range for y axis (default c(0,1))}
+
+\item{timerange}{of the data input}
+
+\item{eps}{write as eps or png}
+}
+\value{
+None
+}
+\description{
+Function to plot a panel of 4/16 timelines per biome aggregated EcoRisk
+values [0-1]
+to file
+}
diff --git a/man/plot_ecorisk_radial.Rd b/man/plot_ecorisk_radial.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..ddc82794a41f124d75021d806db729a9edce0eb2
--- /dev/null
+++ b/man/plot_ecorisk_radial.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_radial}
+\alias{plot_ecorisk_radial}
+\title{Plot radial EcoRisk plot to file}
+\usage{
+plot_ecorisk_radial(
+ data,
+ file,
+ title = "",
+ leg_yes = TRUE,
+ eps = FALSE,
+ use_quantile = TRUE
+)
+}
+\arguments{
+\item{data}{EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+3[min,mean,max])}
+
+\item{file}{to write into}
+
+\item{title}{character string title for plot, default empty}
+
+\item{leg_yes}{logical. whether to plot legend or not. defaults to TRUE}
+
+\item{eps}{write as eps or png}
+
+\item{type}{plot type, 'legend1' for variable and color legend,
+'legend2' for value legend, or 'regular' (default setting)
+for the regular EcoRisk plot}
+}
+\value{
+None
+}
+\description{
+Function to plot an aggregated radial status of EcoRisk values [0-1]
+for the different sub-categories to file
+}
diff --git a/man/plot_ecorisk_radial_panel.Rd b/man/plot_ecorisk_radial_panel.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..411078f656da027364a6fd1be1ea234ba68a8375
--- /dev/null
+++ b/man/plot_ecorisk_radial_panel.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_radial_panel}
+\alias{plot_ecorisk_radial_panel}
+\title{Plot radial EcoRisk panel to file with 4/16 biomes}
+\usage{
+plot_ecorisk_radial_panel(
+ data,
+ biome_names,
+ file,
+ use_quantile = TRUE,
+ eps = FALSE
+)
+}
+\arguments{
+\item{data}{EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+3[min,mean,max])}
+
+\item{biome_names}{names of biomes}
+
+\item{file}{to write into}
+
+\item{use_quantile}{is it quantiles or minmeanmax data? - text for whiskers}
+
+\item{eps}{write as eps or png}
+}
+\value{
+None
+}
+\description{
+Function to plot an aggregated radial status of EcoRisk values [0-1]
+for the different sub-categories to file
+}
diff --git a/man/plot_ecorisk_radial_to_screen.Rd b/man/plot_ecorisk_radial_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..90fca14a121d1dedc93f2039836a4f743f81c939
--- /dev/null
+++ b/man/plot_ecorisk_radial_to_screen.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_ecorisk_radial_to_screen}
+\alias{plot_ecorisk_radial_to_screen}
+\title{Plot radial EcoRisk plot to screen}
+\usage{
+plot_ecorisk_radial_to_screen(
+ data,
+ title = "",
+ zoom = 1,
+ type = "regular",
+ title_size = 2,
+ titleline = -2,
+ use_quantile = TRUE
+)
+}
+\arguments{
+\item{data}{EcoRisk data array c(4/19[biomes],[nEcoRiskcomponents],
+3[min,mean,max])}
+
+\item{title}{character string title for plot, default empty}
+
+\item{zoom}{scaling factor for circle plot. defaults to 1}
+
+\item{type}{plot type, 'legend1' for variable and color legend,
+'legend2' for value legend, or 'regular' (default setting)
+for the regular EcoRisk plot}
+
+\item{title_size}{scaling factor for tile. defaults to 1}
+}
+\value{
+None
+}
+\description{
+Function to plot an aggregated radial status of EcoRisk values [0-1]
+for the different sub-categories to screen
+}
diff --git a/man/plot_global.Rd b/man/plot_global.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..fb71ac619cc7b2c5c94544218c4f117a64b7774d
--- /dev/null
+++ b/man/plot_global.Rd
@@ -0,0 +1,84 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_global.R
+\name{plot_global}
+\alias{plot_global}
+\title{Plot global LPJmL array}
+\usage{
+plot_global(
+ data,
+ file,
+ title = "",
+ pow2max = NULL,
+ pow2min = NULL,
+ min = NULL,
+ max = NULL,
+ col_pos = "GnBu",
+ type = "exp",
+ col_neg = "YlOrRd",
+ legendtitle = "",
+ leg_yes = TRUE,
+ only_pos = FALSE,
+ eps = FALSE
+)
+}
+\arguments{
+\item{data}{array with data to plot in LPJmL specific array c(67420)}
+
+\item{file}{character string for location/file to save plot to}
+
+\item{title}{character string title for plot}
+
+\item{pow2max}{for exponential legend: upper (positive) end of data range to
+plot (2^pow2max)}
+
+\item{pow2min}{for exponential legend: smallest positive number to be
+distinguished from 0 (2^-pow2min)}
+
+\item{min}{for linear legend: lower end of data range to plot (0 is placed
+symmetrically between min and max, if onlypos = FALSE)}
+
+\item{max}{for linear legend: upper end of data range to plot (0 is placed
+symmetrically between min and max, if onlypos = FALSE)}
+
+\item{col_pos}{color palette for the positives}
+
+\item{type}{string indicating whether to plot exponential (exp) or
+linear (lin) legend (default: exp)}
+
+\item{col_neg}{color palette for the negatives}
+
+\item{legendtitle}{character string legend title}
+
+\item{leg_yes}{boolean whether to show legend (default: TRUE)}
+
+\item{only_pos}{boolean to show only positive half of legend (default: FALSE)}
+
+\item{eps}{boolean whether to write eps file instead of PNG (default: FALSE)}
+}
+\value{
+None
+}
+\description{
+Creates a PNG/eps with a plot of a global LPJmL array
+ Data is plotted in range: c(-2^pow2max,-2^-pow2min,0,2^-pow2min,2^pow2max)
+ colors for pos and neg values can be given, default is Blues for the
+ positive and Reds for the negative numbers 0-range (from 2^-pow2min to
+ 2^pow2min) is white.
+ The negatives can be omitted by setting only_pos=TRUE, in case there are
+ only pos values.
+}
+\examples{
+\dontrun{
+plot_global(
+ data = irrigation2006,
+ file = paste("~/", "mwateramount_2005_06.png", sep = ""),
+ title = paste("irrigation amount 2006 in mm/yr", sep = ""),
+ pow2max = 15,
+ pow2min = 0,
+ legendtitle = "legendtitle",
+ leg_yes = TRUE,
+ eps = FALSE
+)
+}
+
+}
diff --git a/man/plot_global_to_screen.Rd b/man/plot_global_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..5b9ea731429884178cd6c9e9ccfe628288c3580b
--- /dev/null
+++ b/man/plot_global_to_screen.Rd
@@ -0,0 +1,78 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_global.R
+\name{plot_global_to_screen}
+\alias{plot_global_to_screen}
+\title{Plot global LPJmL array}
+\usage{
+plot_global_to_screen(
+ data,
+ title = "",
+ pow2max = NULL,
+ pow2min = NULL,
+ min = NULL,
+ max = NULL,
+ col_pos = "GnBu",
+ type = "exp",
+ col_neg = "YlOrRd",
+ legendtitle = "",
+ leg_yes = TRUE,
+ only_pos = FALSE
+)
+}
+\arguments{
+\item{data}{array with data to plot in LPJmL specific array c(67420)}
+
+\item{title}{character string title for plot}
+
+\item{pow2max}{for exponential legend: upper (positive) end of data range to
+plot (2^pow2max)}
+
+\item{pow2min}{for exponential legend: smallest positive number to be
+distinguished from 0 (2^-pow2min)}
+
+\item{min}{for linear legend: lower end of data range to plot (0 is placed
+symmetrically between min and max, if onlypos = FALSE)}
+
+\item{max}{for linear legend: upper end of data range to plot (0 is placed
+symmetrically between min and max, if onlypos = FALSE)}
+
+\item{col_pos}{color palette for the positives}
+
+\item{type}{string indicating whether to plot exponential (exp) or
+linear (lin) legend (default: exp)}
+
+\item{col_neg}{color palette for the negatives}
+
+\item{legendtitle}{character string legend title}
+
+\item{leg_yes}{boolean whether to show legend (default: TRUE)}
+
+\item{only_pos}{boolean to show only positive half of legend (default: FALSE)}
+
+\item{file}{character string for location/file to save plot to}
+
+\item{eps}{boolean whether to write eps file instead of PNG (default: FALSE)}
+}
+\value{
+None
+}
+\description{
+Plot of a global LPJmL array inside RStudio
+ Data is plotted in range: c(-2^pow2max,-2^-pow2min,0,2^-pow2min,2^pow2max)
+ where the positive values are colored green to blue,
+ 0-range is white,
+ and the negative ones red to yellow
+}
+\examples{
+\dontrun{
+plot_global_to_screen(
+ data = irrigation2006,
+ title = paste("irrigation amount 2006 in mm/yr", sep = ""),
+ pow2max = 15,
+ pow2min = 0,
+ "legendtitle",
+ leg_yes = TRUE
+)
+}
+
+}
diff --git a/man/plot_overtime_to_screen.Rd b/man/plot_overtime_to_screen.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..287ecc210bc5d6480ac648db35280ae35fcf1e4c
--- /dev/null
+++ b/man/plot_overtime_to_screen.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{plot_overtime_to_screen}
+\alias{plot_overtime_to_screen}
+\title{Plot timeline of EcoRisk variables to screen}
+\usage{
+plot_overtime_to_screen(
+ data,
+ timerange,
+ yrange = c(0, 1),
+ leg_yes = TRUE,
+ leg_only = FALSE,
+ varnames = NULL
+)
+}
+\arguments{
+\item{data}{EcoRisk data array
+c(4/19[biomes],8/10[nEcoRiskcomponents],3[min,mean,max],timeslices)}
+
+\item{timerange}{of the data input}
+
+\item{yrange}{range for y axis default c(0,1)}
+
+\item{leg_yes}{plot legend (default TRUE)}
+}
+\value{
+None
+}
+\description{
+Function to plot timeline of EcoRisk variables to screen
+}
diff --git a/man/read_calc_biocol.Rd b/man/read_calc_biocol.Rd
new file mode 100755
index 0000000000000000000000000000000000000000..4ac41098dc66d6ca25d43ac82fc413629e28c82d
--- /dev/null
+++ b/man/read_calc_biocol.Rd
@@ -0,0 +1,103 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/biocol.R
+\name{read_calc_biocol}
+\alias{read_calc_biocol}
+\title{Calculate BioCol based on a PNV run and LU run of LPJmL}
+\usage{
+read_calc_biocol(
+ files_scenario,
+ files_reference,
+ time_span_scenario,
+ time_span_reference = NULL,
+ reference_npp_time_span = NULL,
+ reference_npp_file = NULL,
+ gridbased = TRUE,
+ read_saved_data = FALSE,
+ save_data = FALSE,
+ data_file = NULL,
+ include_fire = FALSE,
+ external_fire = FALSE,
+ external_wood_harvest = FALSE,
+ grass_scaling = FALSE,
+ npp_threshold = 20,
+ grass_harvest_file = "grazing_data.RData",
+ external_fire_file = "human_ignition_fraction.RData",
+ external_wood_harvest_file = "wood_harvest_biomass_sum_1500-2014_67420.RData"
+)
+}
+\arguments{
+\item{files_scenario}{list with variable names and corresponding file paths
+(character string) of the scenario LPJmL run. All needed files are
+provided in XXX. E.g.: list(leaching = "/temp/leaching.bin.json")}
+
+\item{files_reference}{list with variable names and corresponding file paths
+(character string) of the reference LPJmL run. All needed files are
+provided in XXX. E.g.: list(leaching = "/temp/leaching.bin.json"). If not
+needed for the applied method, set to NULL.}
+
+\item{time_span_scenario}{time span to be used for the scenario run, defined
+as a character string, e.g. `as.character(1982:2011)` (default)}
+
+\item{time_span_reference}{time span to be used for the scenario run, defined
+as an integer vector, e.g. `as.character(1901:1930)`. Can differ in offset
+and length from `time_span_scenario`! If `NULL` value of `time_span_scenario`
+is used}
+
+\item{reference_npp_time_span}{time span to read reference npp from, using
+index years 10:39 from potential npp input if set to NULL (default: NULL)}
+
+\item{reference_npp_file}{file to read reference npp from, using
+potential npp input if set to NULL (default: NULL)}
+
+\item{gridbased}{logical are pft outputs gridbased or pft-based?}
+
+\item{read_saved_data}{flag whether to read previously saved data
+instead of reading it in from output files (default FALSE)}
+
+\item{save_data}{whether to save input data to file (default FALSE)}
+
+\item{data_file}{file to save/read input data to/from (default NULL)}
+
+\item{include_fire}{boolean include firec in calculation of BioCol?
+(default TRUE)}
+
+\item{external_fire}{instead of reading in firec for fire emissions, read in
+ this external firec file from a separate spitfire run with disabled
+ lighning. this will then include only human induced fires
+(default FALSE)}
+
+\item{external_wood_harvest}{include external wood harvest from LUH2_v2h
+(default FALSE)}
+
+\item{grass_scaling}{whether to scale pasture harvest according to
+data given via grass_harvest_file (default FALSE)}
+
+\item{npp_threshold}{lower threshold for npp (to mask out non-lu areas
+according to Haberl et al. 2007). Below BioCol will be set to 0.
+(default: 20 gC/m2)}
+
+\item{grass_harvest_file}{file containing grazing data to rescale the
+grassland harvests according to Herrero et al. 2013. File contains:
+grazing_data list object with $name and $id of 29 world regions, and
+$Herrero_2000_kgDM_by_region containing for each of these regions and
+mapping_lpj67420_to_grazing_regions array with a mapping between 67420
+LPJmL cells and the 29 regions}
+
+\item{external_fire_file}{path to external file with human induced fire
+fraction c(cell,month,year) since 1500}
+
+\item{external_wood_harvest_file}{path to R-file containing processed
+timeline of maps for LUH2_v2h woodharvest}
+}
+\value{
+list data object containing BioCol and components as arrays: biocol,
+ biocol_overtime, biocol_overtime_perc_piref, biocol_perc,
+ biocol_perc_piref, npp_potential, npp_act_overtime, npp_pot_overtime,
+ npp_eco_overtime, harvest_cft_overtime, npp_luc_overtime,
+ rharvest_cft_overtime, fire_overtime, timber_harvest_overtime,
+ harvest_cft, biocol_harvest, grassland_scaling_factor_cellwise,
+ biocol_luc, biocol_luc_piref
+}
+\description{
+Function to calculate BioCol based on a PNV run and LU run of LPJmL
+}
diff --git a/man/read_ecorisk_data.Rd b/man/read_ecorisk_data.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..94190172dd3dcb01daaacc66d8f35022ac4a019d
--- /dev/null
+++ b/man/read_ecorisk_data.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{read_ecorisk_data}
+\alias{read_ecorisk_data}
+\title{Read in output data from LPJmL to calculate the ecosystem change metric
+EcoRisk}
+\usage{
+read_ecorisk_data(
+ files_reference,
+ files_scenario,
+ save_file = NULL,
+ export = FALSE,
+ time_span_reference,
+ time_span_scenario,
+ nitrogen,
+ debug = FALSE
+)
+}
+\arguments{
+\item{files_reference}{folder of reference run}
+
+\item{files_scenario}{folder of scenario run}
+
+\item{save_file}{file to save read in data to (default NULL)}
+
+\item{export}{flag whether to export réad in data to global environment
+(default FALSE)}
+
+\item{time_span_reference}{vector of years to use as scenario period}
+
+\item{time_span_scenario}{vector of years to use as scenario period}
+
+\item{nitrogen}{include nitrogen outputs for pools and fluxes into EcoRisk
+calculation (default FALSE)}
+
+\item{debug}{write out all nitrogen state variables (default FALSE)}
+}
+\value{
+list data object containing arrays of state_ref, mean_state_ref,
+ state_scen, mean_state_scen, fpc_ref, fpc_scen, bft_ref, bft_scen,
+ cft_ref, cft_scen, lat, lon, cell_area
+}
+\description{
+Utility function to read in output data from LPJmL for calculation of EcoRisk
+}
diff --git a/man/replace_ref_data_with_average_ref_biome_cell.Rd b/man/replace_ref_data_with_average_ref_biome_cell.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..818f7366bae86cf50ff0d7bf18512b8f0bf4427c
--- /dev/null
+++ b/man/replace_ref_data_with_average_ref_biome_cell.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{replace_ref_data_with_average_ref_biome_cell}
+\alias{replace_ref_data_with_average_ref_biome_cell}
+\title{Create modified EcoRisk data file}
+\usage{
+replace_ref_data_with_average_ref_biome_cell(
+ data_file_in,
+ data_file_out,
+ biome_classes_in,
+ ref_biom
+)
+}
+\arguments{
+\item{data_file_in}{path to input data}
+
+\item{data_file_out}{path to save modified data to}
+
+\item{biome_classes_in}{biome classes object as returned from classify_biomes}
+
+\item{ref_biom}{reference biome from biome classes that all cells should
+be compared to}
+}
+\description{
+Function to create a modified EcoRisk data file where each reference cell is
+compared to the average reference biome cell. The scenario period is
+overwritten with the original reference period and all reference cells are
+set to the average cell of the prescribed reference biome ref_biom
+}
diff --git a/man/state_diff_global.Rd b/man/state_diff_global.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..d01db69578f5722fa12817a0ad29514aa5399577
--- /dev/null
+++ b/man/state_diff_global.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{state_diff_global}
+\alias{state_diff_global}
+\title{c based on Heyder 2011 eq. 10-13}
+\usage{
+state_diff_global(ref, scen, cell_area, epsilon = 10^-4)
+}
+\arguments{
+\item{ref}{mean reference state vector of dimension c(ncells,variables)}
+
+\item{scen}{mean scenario state vector of dimension c(ncells,variables)}
+
+\item{cell_area}{area of each cell as a vector of dim=c(ncells)}
+
+\item{epsilon}{threshold for variables to be treated as 0}
+}
+\value{
+the length of the difference vector for each cell
+}
+\description{
+c based on Heyder 2011 eq. 10-13
+}
diff --git a/man/state_diff_local.Rd b/man/state_diff_local.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..d4ee0f14de75cd37eaecd3d8fbab4b08531e309c
--- /dev/null
+++ b/man/state_diff_local.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ecorisk.R
+\name{state_diff_local}
+\alias{state_diff_local}
+\title{based on Heyder 2011 eq. 6-9; epsilon case handling from code
+ by Sebastian Ostberg (not documented in papers)}
+\usage{
+state_diff_local(ref, scen, epsilon = 10^-4)
+}
+\arguments{
+\item{ref}{mean reference state vector of dimension c(ncells,variables)}
+
+\item{scen}{mean scenario state vector of dimension c(ncells,variables)}
+
+\item{epsilon}{threshold for variables to be treated as 0}
+}
+\value{
+the length of the difference vector for each cell
+}
+\description{
+based on Heyder 2011 eq. 6-9; epsilon case handling from code
+ by Sebastian Ostberg (not documented in papers)
+}
diff --git a/scripts/calc_ecorisk_overtime.R b/scripts/calc_ecorisk_overtime.R
new file mode 100755
index 0000000000000000000000000000000000000000..86a8247d8b565bfea2974de9cc3dd4d569abdf7d
--- /dev/null
+++ b/scripts/calc_ecorisk_overtime.R
@@ -0,0 +1,52 @@
+library(devtools)
+library(lpjmlkit)
+library(magrittr)
+
+devtools::load_all("/p/projects/open/Fabian/LPJbox/biospheremetrics_paper/")
+
+run_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/lu_1500_2014/"
+pnv_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/"
+out_folder <- "/p/projects/open/Fabian/Metrics/"
+lpj_input <- "/p/projects/lpjml/input/historical/"
+
+# read grid
+grid <- lpjmlkit::read_io(paste0(run_folder, "grid.bin.json"))
+# calculate cell area
+lat <- grid[, , 2]
+lon <- grid[, , 1]
+cellarea <- lpjmlkit::calc_cellarea(grid)
+
+vars_ecorisk <- data.frame(
+ row.names = c("grid", "fpc", "fpc_bft", "cftfrac", "firec", "npp", "runoff",
+ "transp", "vegc", "firef", "rh", "harvestc", "rharvestc",
+ "pft_harvestc", "pft_rharvestc", "evap", "interc", "discharge",
+ "soilc", "litc", "swc", "vegn", "soilnh4", "soilno3",
+ "leaching", "n2o_denit", "n2o_nit", "n2_emis", "bnf",
+ "n_volatilization"),
+ outname = c("grid.bin.json", "fpc.bin.json", "fpc_bft.bin.json",
+ "cftfrac.bin.json", "firec.bin.json", "mnpp.bin.json",
+ "mrunoff.bin.json", "mtransp.bin.json", "vegc.bin.json",
+ "firef.bin.json", "mrh.bin.json", "flux_harvest.bin.json",
+ "flux_rharvest.bin.json", "pft_harvest.pft.bin.json",
+ "pft_rharvest.pft.bin.json", "mevap.bin.json", "minterc.bin.json",
+ "mdischarge.bin.json", "soilc.bin.json", "litc.bin.json",
+ "mswc.bin.json", "vegn.bin.json", "soilnh4.bin.json",
+ "soilno3.bin.json", "mleaching.bin.json", "mn2o_denit.bin.json",
+ "mn2o_nit.bin.json", "mn2_emis.bin.json", "mbnf.bin.json",
+ "mn_volatilization.bin.json")
+)
+
+ecorisk <- ecorisk_wrapper(
+ path_ref = pnv_folder,
+ path_scen = run_folder,
+ read_saved_data = FALSE,
+ nitrogen = TRUE,
+ varnames = vars_ecorisk,
+ weighting = "equal",
+ save_data = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_overtime_data.RData",
+ save_ecorisk = "/p/projects/open/Fabian/Metrics/data/ecorisk_202306_overtime_gamma.RData",
+ time_span_reference = c(1550:1579),
+ time_span_scenario = c(1500:2014),
+ dimensions_only_local = FALSE,
+ window = 30
+)
diff --git a/scripts/r_calc_ecorisk_overtime.sh b/scripts/r_calc_ecorisk_overtime.sh
new file mode 100755
index 0000000000000000000000000000000000000000..866fb5465775a5f46fef7e1c89f9023b3872b59d
--- /dev/null
+++ b/scripts/r_calc_ecorisk_overtime.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+#SBATCH --qos=medium
+#SBATCH --ntasks=1
+#SBATCH --mem=80000
+#SBATCH --partition=standard
+#SBATCH --account=open
+#SBATCH --job-name=R_analysis_script
+#SBATCH --workdir=/p/projects/open/Fabian/Metrics/
+#SBATCH --output=outfile.%j.out
+#SBATCH --error=outfile.%j.err
+#SBATCH --mail-type=ALL
+#SBATCH --time=2000
+
+# call R
+module load piam/1.24
+Rscript calc_ecorisk_overtime.R
diff --git a/scripts/r_read_in_biocol_data.sh b/scripts/r_read_in_biocol_data.sh
new file mode 100755
index 0000000000000000000000000000000000000000..e91f713b9d31cbe7b38939362705636a6f73fbe8
--- /dev/null
+++ b/scripts/r_read_in_biocol_data.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+#SBATCH --qos=short
+#SBATCH --ntasks=1
+#SBATCH --mem=80000
+#SBATCH --partition=standard
+#SBATCH --account=open
+#SBATCH --job-name=R_analysis_script
+#SBATCH --workdir=/p/projects/open/Fabian/Metrics/
+#SBATCH --output=outfile.%j.out
+#SBATCH --error=outfile.%j.err
+#SBATCH --mail-type=ALL
+#SBATCH --time=60
+
+# call R
+module load piam/1.24
+Rscript read_in_biocol_data.R
diff --git a/scripts/read_in_biocol_data.R b/scripts/read_in_biocol_data.R
new file mode 100755
index 0000000000000000000000000000000000000000..3214e98bdc945a02ca52a07d6a73d7c4404b1f00
--- /dev/null
+++ b/scripts/read_in_biocol_data.R
@@ -0,0 +1,46 @@
+library(devtools)
+library(magrittr)
+devtools::load_all("/p/projects/open/Fabian/LPJbox/biospheremetrics_paper/")
+
+run_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/lu_1500_2014/"
+pnv_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/"
+out_folder <- "/p/projects/open/Fabian/Metrics/"
+lpj_input <- "/p/projects/lpjml/input/historical/"
+
+# read grid
+grid <- lpjmlkit::read_io(paste0(run_folder, "grid.bin.json"))$data %>% drop()
+# calculate cell area
+lat <- grid[, 2]
+lon <- grid[, 1]
+
+################# mcol ################
+
+vars_biocol <- data.frame(
+ row.names = c("grid", "npp", "pft_npp", "pft_harvest", "pft_rharvest",
+ "firec", "timber_harvest", "cftfrac", "fpc"),
+ outname = c("grid.bin.json", "mnpp.bin.json", "pft_npp.bin.json",
+ "pft_harvest.pft.bin.json", "pft_rharvest.pft.bin.json",
+ "firec.bin.json", "timber_harvestc.bin.json",
+ "cftfrac.bin.json", "fpc.bin.json"),
+ timestep = c("Y", "M", "Y", "Y", "Y", "Y", "Y", "Y", "Y")
+)
+
+biocol <- calc_biocol(
+ path_lu = run_folder,
+ path_pnv = pnv_folder,
+ gridbased = TRUE,
+ start_year = 1500,
+ stop_year = 2014,
+ reference_npp_time_span = 1550:1579,
+ reference_npp_file = "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/mnpp.bin.json",
+ read_saved_data = FALSE,
+ save_data = TRUE,
+ npp_threshold = 20,
+ data_file = "/p/projects/open/Fabian/Metrics/data/BioCol_202306.RData",
+ external_fire = FALSE,
+ external_wood_harvest = TRUE,
+ external_fire_file = "/p/projects/open/Fabian/LPJbox/human_ignition_fraction.RData",
+ external_wood_harvest_file = "/p/projects/open/LanduseData/LUH2_v2h/wood_harvest_biomass_sum_1500-2014_67420.RData",
+ varnames = vars_biocol,
+ grass_scaling = FALSE,
+ include_fire = FALSE)
diff --git a/scripts/test_all.R b/scripts/test_all.R
new file mode 100644
index 0000000000000000000000000000000000000000..7d7c9fd0015e6de423e44db908dba581d9dc9ddd
--- /dev/null
+++ b/scripts/test_all.R
@@ -0,0 +1,165 @@
+library(devtools)
+library(lpjmlkit)
+library(sf)
+library(terra)
+
+devtools::load_all("/p/projects/open/Jannes/repos/biospheremetrics")
+
+run_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/lu_1500_2014/"
+pnv_folder <- "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/"
+out_folder <- "/p/projects/open/Jannes/tests/metrics/"
+lpj_input <- "/p/projects/lpjml/input/historical/"
+
+# read grid
+grid <- lpjmlkit::read_io(paste0(run_folder, "grid.bin.json"))
+# calculate cell area
+lat <- grid$data[, , 2]
+lon <- grid$data[, , 1]
+cellarea <- lpjmlkit::calc_cellarea(grid)
+
+################# calculate BioCol ################
+# 16GB of RAM are enough to calculate BioCol for a smaller analysis window (~40 years)
+# for longer spans (500 years) - use separate script ("read_in_BioCol_data.R")
+# and submit as cluster job using "sbatch R_read_in_BioCol_data.sh" - analysis for "biocol overtime" below
+vars_biocol <- data.frame(
+ row.names = c("grid", "npp", "pft_npp", "pft_harvest", "pft_rharvest",
+ "firec", "timber_harvest", "cftfrac", "fpc"),
+ outname = c("grid.bin.json", "mnpp.bin.json", "pft_npp.bin.json",
+ "pft_harvest.pft.bin.json", "pft_rharvest.pft.bin.json",
+ "firec.bin.json", "timber_harvestc.bin.json", "cftfrac.bin.json",
+ "fpc.bin.json")
+)
+
+biocol <- calc_biocol(
+ path_lu = run_folder,
+ path_pnv = pnv_folder,
+ gridbased = TRUE,
+ start_year = 1980,
+ stop_year = 2014,
+ reference_npp_time_span = 1510:1539,
+ reference_npp_file = "/p/projects/open/Fabian/runs/metrics_202306/output/pnv_1500_2014/mnpp.bin.json",
+ read_saved_data = FALSE,
+ save_data = TRUE,
+ npp_threshold = 20,
+ data_file = "/p/projects/open/Jannes/tests/metrics/BioCol_202306.RData",
+ external_fire = FALSE,
+ external_wood_harvest = TRUE,
+ external_fire_file = "/p/projects/open/Fabian/LPJbox/human_ignition_fraction.RData",
+ external_wood_harvest_file = "/p/projects/open/LanduseData/LUH2_v2h/wood_harvest_biomass_sum_1500-2014_67420.RData",
+ varnames = vars_biocol,
+ grass_scaling = FALSE,
+ include_fire = FALSE
+)
+
+plot_biocol(
+ biocol_data = biocol,
+ path_write = paste0(out_folder, "BioCol/"),
+ plotyears = c(1980, 2014),
+ min_val = 0,
+ max_val = 90,
+ legendpos = "left",
+ start_year = 1980,
+ mapyear = 2000,
+ highlightyear = 2000,
+ eps = FALSE
+)
+
+vars_ecorisk <- data.frame(
+ row.names = c("grid","fpc", "fpc_bft", "cftfrac", "firec", "npp", "runoff",
+ "transp", "vegc", "firef", "rh", "harvestc", "rharvestc",
+ "pft_harvestc", "pft_rharvestc", "evap", "interc", "discharge",
+ "soilc", "litc", "swc", "vegn", "soilnh4", "soilno3",
+ "leaching", "n2o_denit", "n2o_nit", "n2_emis", "bnf",
+ "n_volatilization"),
+ outname = c("grid.bin.json", "fpc.bin.json", "fpc_bft.bin.json",
+ "cftfrac.bin.json", "firec.bin.json", "mnpp.bin.json",
+ "mrunoff.bin.json", "mtransp.bin.json", "vegc.bin.json",
+ "firef.bin.json", "mrh.bin.json", "flux_harvest.bin.json",
+ "flux_rharvest.bin.json", "pft_harvest.pft.bin.json",
+ "pft_rharvest.pft.bin.json", "mevap.bin.json",
+ "minterc.bin.json", "mdischarge.bin.json", "soilc.bin.json",
+ "litc.bin.json", "mswc.bin.json", "vegn.bin.json",
+ "soilnh4.bin.json", "soilno3.bin.json", "mleaching.bin.json",
+ "mn2o_denit.bin.json", "mn2o_nit.bin.json", "mn2_emis.bin.json",
+ "mbnf.bin.json", "mn_volatilization.bin.json")
+)
+
+ecorisk <- ecorisk_wrapper(
+ path_ref = pnv_folder,
+ path_scen = run_folder,
+ read_saved_data = FALSE,
+ nitrogen = TRUE,
+ varnames = vars_ecorisk,
+ weighting = "equal",
+ save_data = "/p/projects/open/Jannes/tests/metrics/ecorisk_202306_data.RData",
+ save_ecorisk = "/p/projects/open/Jannes/tests/metrics/ecorisk_202306_gamma.RData",
+ time_span_reference = c(1550:1579),
+ time_span_scenario = c(1985:2014),
+ dimensions_only_local = FALSE
+)
+
+# plot ecorisk
+plot_ecorisk_map(
+ ecorisk$ecorisk_total,
+ file = paste0(out_folder, "EcoRisk/ecorisk.png"),
+ title = "ecorisk"
+)
+
+plot_ecorisk_map(
+ ecorisk$vegetation_structure_change,
+ file = paste0(out_folder, "EcoRisk/vs.png"),
+ title = "vegetation structure change"
+)
+
+plot_ecorisk_map(
+ ecorisk$local_change,
+ file = paste0(out_folder, "EcoRisk/lc.png"),
+ title = "local change"
+)
+
+plot_ecorisk_map(
+ ecorisk$global_importance,
+ file = paste0(out_folder, "EcoRisk/gi.png"),
+ title = "global importance"
+)
+
+plot_ecorisk_map(
+ ecorisk$ecosystem_balance,
+ file = paste0(out_folder, "EcoRisk/eb.png"),
+ title = "ecosystem balance")
+
+plot_ecorisk_map(
+ ecorisk$carbon_stocks,
+ file = paste0(out_folder, "EcoRisk/cs.png"),
+ title = "carbon_stocks"
+)
+
+plot_ecorisk_map(
+ ecorisk$carbon_fluxes,
+ file = paste0(out_folder, "EcoRisk/cf.png"),
+ title = "carbon_fluxes"
+)
+
+plot_ecorisk_map(
+ ecorisk$water_stocks,
+ file = paste0(out_folder, "EcoRisk/ws.png"),
+ title = " water_stocks"
+)
+
+plot_ecorisk_map(
+ ecorisk$water_fluxes,
+ file = paste0(out_folder, "EcoRisk/wf.png"),
+ title = " water_fluxes"
+)
+
+plot_ecorisk_map(
+ ecorisk$nitrogen_stocks,
+ file = paste0(out_folder, "EcoRisk/ns.png"),
+ title = " nitrogen_stocks"
+)
+
+plot_ecorisk_map(
+ ecorisk$nitrogen_fluxes,
+ file = paste0(out_folder, "EcoRisk/nf.png"),
+ title = " nitrogen_fluxes"
+)