# Run as a R file or knitr notebook (submitted as .txt to match HAL requirements) ## ----Setup------------------------------------------------------------------------------------------------------------------------------ library(data.table) library(knitr) library(ggplot2) library(cowplot) library(colorspace) #devtools::install_github("ricardo-bion/ggradar", # dependencies = TRUE) library(ggradar) set.seed(101) # set up global R options options(digits = 2) # set up knitr global chunk options knitr::opts_chunk$set(tidy = 'formatR', collapse = TRUE, warning = FALSE, message = FALSE) figures_folder = 'Figures/' ## ----Setup supply data------------------------------------------------------------------------------------------------------------------ rep = c(20,20,20) Supply_indicators = data.table(Forest_type = rep(c('Coniferous', 'Mixed', 'Swamp'), times = rep), Replicate = 1:sum(rep), # C sequestration rates in soil, t.C/ha/yr Climate_seq_soil = c(rnorm(rep[1], 0.3, 0.1), rnorm(rep[2], 0.4, 0.1), rnorm(rep[3], -1, 0.1)), # C sequestration rates in vegetation, t.C/ha/yr Climate_seq_trees = c(rnorm(rep[1], 2, 1), rnorm(rep[2],3, 1), rnorm(rep[3], 0, 0.1)), # Timber volume increment, m3/ha/yr Timber_prod = c(rnorm(rep[1], 13, 1), rnorm(rep[2],7,1), rnorm(rep[3], 0.3, 0.1)), # % of open canopy Aesthetic_open = c(rnorm(rep[1], 20, 3), rnorm(rep[2], 40, 3), rnorm(rep[3], 50, 3)), # # of tree species present Aesthetic_diversity = c(rnorm(rep[1], 1, 0.5), rnorm(rep[2], 6, 0.5), rnorm(rep[3], 7, 0.5)), # Abundance of disease vectors Health_risk_disease = c(rnorm(rep[1], 3, 0.5), rnorm(rep[2], 3, 0.5), rnorm(rep[3], 20, 0.5))) kable(Supply_indicators[, lapply(.SD, mean), .SDcols = c('Climate_seq_soil', 'Climate_seq_trees', 'Timber_prod', 'Aesthetic_open', 'Aesthetic_diversity', 'Health_risk_disease'), by = Forest_type], caption = 'Average indicator values per forest type') ## ----Setup priority and access data, echo=FALSE---------------------------------------------------------------------------------------- Priority_points = data.table(NCP = c('Climate', 'Timber', 'Aesthetic', 'Health risk'), Landowners = c(2, 2, 2, 2), Foresters = c(1, 6, 1, 1), Locals = c(2, 0, 5, 3)) kable(Priority_points, caption = 'Priority points per stakeholder group') ## ----Relative priority scores, message = FALSE------------------------------------------------------------------------------------------ Priority_relative = Priority_points[, list(NCP = NCP, Landowners = Landowners/(sum(Landowners)), Foresters = Foresters/(sum(Foresters)), Locals = Locals/(sum(Locals)))] Priority_long = melt.data.table(Priority_relative, id.vars = 'NCP', variable.name = "Group", value.name = "Priority") Priority_relative_plot = dcast(melt(Priority_relative, id.vars = "NCP", variable.name = 'Group'), Group ~ NCP) ggPriority = ggradar(Priority_relative_plot, fill = TRUE, grid.max = 0.8, grid.mid = 0.4, values.radar = c("0%", "40%", "80%"), axis.labels = c('','','',''), legend.position="none", group.point.size = 3, axis.label.size = 3,grid.label.size = 3, gridline.min.colour = "grey", gridline.mid.colour = "grey", gridline.max.colour = "grey",) + facet_wrap(~Group) + xlab('') + ylab('')+ theme(plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg axis.text.y=element_blank(), #remove y axis labels strip.text.x = element_text(size = 10)) Priority_long[, NCP := factor(NCP, levels = c('Climate','Timber','Aesthetic', 'Health risk'))] ggPriority = ggplot(Priority_long, aes(x = NCP, y = Priority, fill = NCP)) + geom_col(width = 0.7) + scale_fill_brewer(palette = "Oranges", name ='NCP', breaks = c('Climate','Timber','Aesthetic', 'Health risk')) + coord_polar(start = 0.78) + facet_wrap(~Group) + scale_y_log10()+ ylim(0,0.7) + theme_minimal(base_size = 8) + xlab('') + ylab('')+ theme(axis.text.x=element_blank(), #remove x axis labels axis.ticks.x=element_blank(), #remove x axis ticks plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg strip.text.x = element_text(size = 10), legend.position="bottom") + ggtitle('Priority scores') #ggsave(plot = ggPriority + ggtitle(''), paste(figures_folder, 'ggPriority.pdf', sep = ''), width = 6) ggPriority ## ----Setup SB/D relationshps------------------------------------------------------------------------------------------------------------ # This function takes as input the observed supply, the name of the single NCP, the expected shape of the SB relationship, the theoretical minimum and maximum supply of the single NCP, and if needed the threshold SB_relationship = function(supply_obs, names = NA, shape, supply_min, supply_max, threshold = NA){ supply_was_na = FALSE if (all(is.na(supply_obs))){ # If no supply is provided, a sequence is generated between the min and max supply supply_obs = seq(supply_min, supply_max, length.out = 50) supply_was_na = TRUE } if ( (min(supply_obs) < supply_min | max(supply_obs) > supply_max)) { print("Warning: S should be in range (between min and max)") } if (!is.na(threshold)){ if (threshold <= supply_min | threshold >= supply_max ) { print( "Warning: the threshold should be higher than the minimum and lower than the maximum supply" )}} if (shape == "linear_benefits") { # E.g. aesthetics follow a linear positive SB relationship benefit_obs = (supply_obs - supply_min)/(supply_max - supply_min) } if (shape == "linear_detriments") { # E.g. health risks follow a linear negative SB relationship benefit_obs = -(supply_obs - supply_min)/(supply_max - supply_min) } if (shape == "threshold_cubic_benefits") {# Production needs to reach a threshold before becoming profitable, then increasing return. Eg: timber production benefit_obs = ifelse(supply_obs < threshold, 0, (supply_obs^3 - supply_min^3)/(supply_max^3 - supply_min^3)) } if (shape == "detriments_threshold_benefits") {# E.g. carbon sequestration benefit_obs = ifelse(supply_obs < threshold, (supply_obs - threshold) / (supply_max - threshold), (supply_obs - threshold)/(supply_max- threshold)) } return(list(benefit_obs = benefit_obs)) } # This function applies SB relationship to a data table, taking as input the data table, NCP names as well as min, max and threshold values for each NCP apply_SB = function(DATA, ncp_names, supply_min, supply_max, shapes, thresholds = NA){ for (ncp in ncp_names){ DATA[NCP == ncp, Benefits := SB_relationship(supply_obs = NCP_supply_realised, supply_min = supply_min[ncp], supply_max = supply_max[ncp], shape = shapes[ncp], threshold = thresholds[ncp])] } return(DATA) } # This function plot the SB relationships based on given supply values plot_SB = function(DATA, ncp_names, supply_min, supply_max, shapes, thresholds, breaks = 100){ # Create sequential data SBdata = data.table(NCP = rep(ncp_names, each = breaks)) SBdata = SBdata[, NCP_supply_realised := seq(from = supply_min[NCP], to = supply_max[NCP], length.out = breaks), by = NCP] apply_SB(SBdata, ncp_names, supply_min, supply_max, shapes, thresholds) SBdata[Benefits >= 0, c('ribbon_max', 'ribbon_min') := list(Benefits, 0)] SBdata[Benefits < 0, c('ribbon_max', 'ribbon_min') := list(0, Benefits)] SBplot = ggplot(SBdata, aes(x = NCP_supply_realised, y = Benefits, fill = Benefits>0, ymax = ribbon_max, ymin = ribbon_min)) + facet_wrap(~NCP, , scales = "free") + geom_ribbon(alpha = 0.3) + scale_fill_manual(values = c('#FDAE61', '#ABDDA4'), labels = c('Detriments', 'Benefits'), name = '')+ xlab('Supply') + ylab('Benefit') + theme_bw() # if supply data is provided, calculate corresponding benefits if (!is.null(DATA) & !all(is.na(DATA$NCP_supply_realised))){ apply_SB(DATA, ncp_names, supply_min, supply_max, shapes, thresholds) SBplot = SBplot + geom_segment(data = DATA, aes(x = -Inf, xend = NCP_supply_realised, yend = Benefits, y = Benefits), inherit.aes = F) + geom_segment(data = DATA, aes(x = NCP_supply_realised, xend = NCP_supply_realised, yend = Benefits, y = -Inf), inherit.aes = F) +xlab('Supply') + ylab('Detriments - Benefits') } return(SBplot) } # This function scales values between 0 (min) and 1 (max) scale01 = function(x){ y = x/abs(max(x)) } ## ----Indicators to NCP supply----------------------------------------------------------------------------------------------------------- Supply_NCP = Supply_indicators[, list(Forest_type = Forest_type, Replicate = Replicate, Climate = scale01(Climate_seq_soil + Climate_seq_trees), Timber = scale01(Timber_prod), Aesthetic = (scale01(Aesthetic_open) + scale01(Aesthetic_diversity))/2, `Health risk` = scale01(Health_risk_disease))] ## ----Potential supply by land use------------------------------------------------------------------------------------------------------- Supply_NCP_mean = Supply_NCP[, lapply(.SD, mean), by = Forest_type, .SDcols = c('Climate', 'Timber', 'Aesthetic', 'Health risk')] Supply_NCP_mean = melt.data.table(Supply_NCP_mean, id.vars = 'Forest_type', value.name = 'NCP_supply_potential', variable.name = 'NCP') Supply_NCP_mean[, NCP := factor(NCP, levels = c('Climate','Timber','Aesthetic', 'Health risk'))] ggSupply = ggplot(Supply_NCP_mean, aes(x = NCP, y = NCP_supply_potential, fill = NCP)) + geom_col(width = 0.7) + scale_fill_brewer(palette = "Oranges", name ='NCP', breaks = c('Climate','Timber','Aesthetic', 'Health risk')) + coord_polar(start = 0.78) + facet_wrap(~Forest_type) + theme_minimal(base_size = 8) + xlab('') + ylab('Supply')+ theme(axis.text.x=element_blank(), #remove x axis labels axis.ticks.x=element_blank(), #remove x axis ticks plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg strip.text.x = element_text(size = 10), legend.position="bottom") + ggtitle('NCP supply scores') #ggsave(plot = ggSupply + ggtitle(''), paste(figures_folder, 'ggSupply.pdf', sep = ''), width = 6) ggSupply ## ----Stakeholder priority--------------------------------------------------------------------------------------------------------------- # Add stakeholders in NCP_demand_priority = merge.data.table(Supply_NCP_mean, Priority_long, by = 'NCP', allow.cartesian=TRUE) ## ----Building land use scenarios-------------------------------------------------------------------------------------------------------- #### Building the access and land use scenarios Scenarios = data.table(expand.grid(Group = c('Landowners', 'Foresters', 'Locals'), Scenarios = c(1, 2, 3, 4), Forest_type = c('Coniferous', 'Mixed', 'Swamp'))) # Setting the proportion of each land use in the landscape Scenarios[Scenarios %in% c(1, 3, 4), Prop_landscape := ifelse(Forest_type == 'Coniferous', 0.55, ifelse(Forest_type == 'Mixed', 0.35, 0.1)), by = Group] Scenarios[Scenarios ==2, Prop_landscape := ifelse(Forest_type == 'Coniferous', 0.35, ifelse(Forest_type == 'Mixed', 0.55, 0.1)), by = Group] # Setting the ACCESSIBLE proportion of each land use in the landscape, depending on the stakeholder group (only locals have access restriction: no swamp, half the forest) Scenarios[, Prop_landscape_accessible := Prop_landscape] Scenarios[Scenarios %in% c(1, 2) & Group == 'Locals', Prop_landscape_accessible := ifelse(Forest_type == 'Swamp', 0, Prop_landscape/2)] ## ----Realised NCP supply---------------------------------------------------------------------------------------------------------------- Supply_access_NCP = merge.data.table(Supply_NCP_mean, Scenarios, by = c('Forest_type'), allow.cartesian=TRUE) Supply_access_NCP[NCP == 'Climate', NCP_supply_realised := NCP_supply_potential*Prop_landscape] Supply_access_NCP[NCP != 'Climate', NCP_supply_realised := NCP_supply_potential*Prop_landscape_accessible] Supply_realised_landscape = Supply_access_NCP[, list(NCP_supply_realised = sum(NCP_supply_realised)), by = list(NCP, Group, Scenarios)] ## ----Applying SB/D relationships-------------------------------------------------------------------------------------------------------- # Parameters to apply SB/D relationships: determine minimal and maximal theoretical values ncp_names = c('Climate','Timber', 'Aesthetic', 'Health risk') supply_min = c(Climate = -1, Timber = 0, Aesthetic = 0, `Health risk` = 0) supply_max = c(Climate = 1, Timber = 1, Aesthetic = 1, `Health risk` = 1) shapes = c(Climate = 'detriments_threshold_benefits', Timber = 'threshold_cubic_benefits', Aesthetic = 'linear_benefits', `Health risk` = 'linear_detriments') thresholds = c(Climate = 0, Timber = 0.5, Aesthetic = NA, `Health risk` = NA) apply_SB(Supply_realised_landscape, ncp_names, supply_min, supply_max, shapes, thresholds) ## ----Plot SB/D relationships------------------------------------------------------------------------------------------------------------ plotSB = plot_SB(Supply_NCP_mean[, NCP_supply_realised := NCP_supply_potential], ncp_names, supply_min, supply_max, shapes, thresholds) + geom_segment(data = Supply_NCP_mean, aes(x = -Inf, xend = NCP_supply_realised, yend = Benefits, y = Benefits), color = 'grey30', inherit.aes = F) + geom_segment(data = Supply_NCP_mean, aes(x = NCP_supply_realised, xend = NCP_supply_realised, yend = Benefits, y = -Inf),color = 'grey30', inherit.aes = F) + theme_classic(base_size = 8) + ylim(-1, 1)+ theme(#axis.text.x=element_blank(), #remove x axis labels axis.ticks.x=element_blank(), #remove x axis ticks panel.grid.minor = element_blank(), plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg #axis.text.y=element_blank(), #remove y axis labels axis.ticks.y=element_blank(), #remove y axis ticks strip.text.x = element_text(size = 10, color = NA), strip.background = element_rect(colour="NA", fill="NA"), legend.position="bottom") + geom_hline(yintercept = 0, size = 0.1)+ geom_vline(xintercept = 0, size = 0.1)+ ggtitle('Supply-benefit relationships') #ggsave(plot = plotSB + ggtitle(''), paste(figures_folder, 'plotSB.pdf', sep = ''), width = 6, height = 6) plotSB ## ----Integrate priorities--------------------------------------------------------------------------------------------------------------- Supply_access_priority = merge.data.table(Priority_long, Supply_realised_landscape, by = c('NCP','Group' )) Supply_access_priority[Scenarios == 4 & NCP == 'Health risk', Priority := 0] Supply_access_priority[Scenarios == 4, Priority := Priority/sum(Priority), by = Group] Supply_access_priority[, Weighted_scores := Benefits * Priority] ## ----Calculate netNCP------------------------------------------------------------------------------------------------------------------- netNCP_bygroup = Supply_access_priority[, list(netNCP = sum(Weighted_scores)), by = list(Group, Scenarios)] netNCP_overall = netNCP_bygroup[, list(netNCP = mean(netNCP), equity = 1/sd(netNCP)), by = Scenarios] ggnetNCP = ggplot(Supply_access_priority, aes(x = Group, y = Weighted_scores, fill = NCP)) + ggtitle('NetNCP across scenarios and stakeholder groups (full red lines) or whole community (red dashed lines) ') + geom_col(width = 0.8) + scale_fill_brewer(palette = "Oranges", name ='NCP', breaks = c('Climate','Timber','Aesthetic', 'Health risk')) + facet_wrap(~Scenarios, nrow = 1) + theme_minimal(base_size = 8) + xlab('') + ylab('netNCP')+ theme(axis.text.x=element_text(angle = 45, vjust = 0.5), axis.ticks.x=element_blank(), #remove x axis ticks plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg legend.position="bottom", axis.line = element_line(colour = "black", linewidth = 0.5), panel.spacing = unit(3.5, "lines"), strip.text.x = element_text(size = 10, color = NA), strip.background = element_rect(colour="NA", fill="NA")) + geom_errorbar(data = netNCP_bygroup, aes(x = Group, y=netNCP,ymin=netNCP,ymax=netNCP), color = 'darkred', size = 0.4 , inherit.aes = FALSE) + geom_hline(data = netNCP_overall, aes(yintercept = netNCP), color = 'darkred', size = 0.7, linetype = "longdash") + geom_hline(aes(yintercept = 0), color = 'black', size = 0.3) #ggsave(plot = ggnetNCP+ ggtitle('') + theme(legend.position = 'none'), paste(figures_folder, 'ggnetNCP.pdf', sep = ''), width = 6, height = 2) ggnetNCP