## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.align = "center") library(climniche) case_path <- system.file("extdata/mediterranean_anchovy", package = "climniche") range_summary <- read.csv( file.path(case_path, "anchovy_climniche_time_range_summary.csv") ) departure_summary <- read.csv( file.path(case_path, "anchovy_climniche_time_departure_summary.csv") ) change_rate <- read.csv( file.path(case_path, "anchovy_climniche_time_change_rate.csv") ) ## ----series-fit, eval = FALSE------------------------------------------------- # projection_years <- c(2030, 2050, 2070, 2090) # # future_series <- list( # ssp245_2030 = climate_2030, # ssp245_2050 = climate_2050, # ssp245_2070 = climate_2070, # ssp245_2090 = climate_2090 # ) # # # Project each period into the same fitted climatic niche. # series <- fit_climniche_series( # current = current_climate, # future = future_series, # time = projection_years, # scenario = "SSP2-4.5", # occupied = anchovy_suitability, # occupied_threshold = sdm_threshold, # domain = mediterranean_sea_mask, # sensitivity = climatic_weights # ) ## ----range-code, eval = FALSE------------------------------------------------- # range_summary <- climniche_range_summary( # series, # scope = "current", # area_weight = TRUE # ) # # subset( # range_summary, # select = c( # time, # exposed_fraction, # conditional_relative_exceedance, # range_wide_relative_exceedance # ) # ) ## ----range-table, echo = FALSE------------------------------------------------ range_table <- data.frame( `Projection year` = range_summary[["time"]], `Weighted boundary exceedance fraction` = paste0( round(100 * range_summary[["exposed_fraction"]], 1), "%" ), `Conditional relative Niche Boundary Exceedance` = paste0( round(100 * range_summary[["conditional_relative_exceedance"]], 1), "%" ), `Range mean relative Niche Boundary Exceedance` = paste0( round(100 * range_summary[["range_wide_relative_exceedance"]], 1), "%" ), check.names = FALSE ) knitr::kable(range_table, row.names = FALSE) ## ----range-figure-code, eval = FALSE------------------------------------------ # extent_plot <- plot_climniche_time( # series, # metric = "exposed_fraction", # scope = "current", # area_weight = TRUE, # show_models = FALSE # ) # # conditional_plot <- plot_climniche_time( # series, # metric = "conditional_relative_exceedance", # scope = "current", # area_weight = TRUE, # show_models = FALSE # ) # # range_plot <- plot_climniche_time( # series, # metric = "range_wide_relative_exceedance", # scope = "current", # area_weight = TRUE, # show_models = FALSE # ) # # patchwork::wrap_plots( # extent_plot, # conditional_plot, # range_plot, # nrow = 1 # ) ## ----range-figure-output, echo = FALSE, out.width = "100%"-------------------- knitr::include_graphics("figures/anchovy-climniche-through-time.png") ## ----departure-code, eval = FALSE--------------------------------------------- # departure <- climniche_departure( # series, # scope = "current" # ) # # rate <- climniche_change_rate( # series, # metric = "range_wide_relative_exceedance", # scope = "current", # area_weight = TRUE # ) ## ----departure-summary, echo = FALSE------------------------------------------ departure_table <- data.frame( `Boundary exceedance fraction` = paste0( round( 100 * departure_summary[["proportion_with_boundary_exceedance"]], 1 ), "%" ), `Median first exceedance` = departure_summary[["median_first_boundary_exceedance"]], `Mean projection fraction` = paste0( round( 100 * departure_summary[[ "mean_boundary_exceedance_projection_fraction" ]], 1 ), "%" ), check.names = FALSE ) knitr::kable(departure_table, row.names = FALSE) ## ----departure-map-code, eval = FALSE----------------------------------------- # onset_map <- plot_climniche_departure_map( # series, # metric = "first_boundary_exceedance", # scope = "current", # scenario = "SSP2-4.5", # study_region = mediterranean_boundary, # degree_labels = "hemisphere" # ) # # frequency_map <- plot_climniche_departure_map( # series, # metric = "boundary_exceedance_projection_fraction", # scope = "current", # scenario = "SSP2-4.5", # study_region = mediterranean_boundary, # degree_labels = "hemisphere" # ) # # patchwork::wrap_plots(onset_map, frequency_map, nrow = 1) ## ----departure-map-output, echo = FALSE, out.width = "100%"------------------- knitr::include_graphics("figures/anchovy-climniche-time-maps.png") ## ----rate-table, echo = FALSE------------------------------------------------- rate_row <- subset( change_rate, metric == "range_wide_relative_exceedance" ) rate_table <- data.frame( `Interval start` = rate_row[["interval_start"]], `Interval end` = rate_row[["interval_end"]], `Increase in range mean relative exceedance` = paste0( round(100 * rate_row[["maximum_interval_increase"]], 1), " percentage points" ), check.names = FALSE ) knitr::kable(rate_table, row.names = FALSE) ## ----series-report, eval = FALSE---------------------------------------------- # series_report <- climniche_series_report( # series, # species = "European anchovy", # scope = "current", # area_weight = TRUE # ) # # series_report # write_climniche_series_report( # series_report, # "anchovy-exposure-through-time.md" # )