#Appendix S1. R code for landscape simulation modelling # The first section details the global variables, writes functions for the modelling and runs an initial MaxEnt model on the 'current' data' # Load required packages library(raster) library(dismo) library(ROCR) library(sp) # Set current directory as "work" work <- getwd() # Create variable for projection (British National Grid) BNG <- CRS("+init=epsg:27700") # Set the number of runs for each scenario models <- 30 # Set the number of iterations for new habitat growth iterations <- 50 # Set the probability of transition from old to new habitat for each cell p.trans <- 0.25 # Set the number of starting points for each simulation n.points <- 20 # Function to calculate probability of transition (x is the number of nearby cells with value > 0) f.prob <- function(x, p.trans){ x*p.trans } # Function to produce 0 or 1 based on the probability of transition f.bin <- function(x){ if(!is.na(x)) x <- rbinom(1,1,x) else x <- NA } # Function to correct values > 1 f.correct <- function(x){ if(!is.na(x) && x > 1) x <- 1 else x } ### Function to grow new habitat f.Exp <- function(map, base.map, p.trans){ # set the starting points map, "map", as the intial habitat and create matrix mat.0 <- as.matrix(map) # calculate the number of cells with value > 0 around each cell map.t <- focal(map, w=matrix(1, nr=3, nc=3),sum, na.rm=T, pad=T) # Create transition matrix using the original habitat, "base map", and "map" map.t <- map.t + base.map mat.t <- as.matrix(map.t) # Calculate probability of transition for each cell mat.prob <- apply(mat.t, c(1,2), f.prob, p.trans=p.trans) mat.cor <- mat.0 + mat.prob # Apply habitat change based on probability of transition mat.cor <- apply(mat.cor, c(1,2), f.correct) # Correct any values above 1 mat.new <- apply(mat.cor, c(1,2), f.bin) # Create new raster of habitat patches map.new <- raster(mat.new, xmn=xmin(map), xmx=xmax(map), ymn=ymin(map), ymx=ymax(map), crs=paste(projection(map))) } # Model of black grouse habitat suitability in 1994 # Read in black grouse presence locations BK.pres <- read.csv("BK_pres.csv") # Read and 'stack' environmental layers env.l.base <- stack(raster(paste(getwd(), "Proportion/hab_1.asc", sep="/"), crs=BNG), raster(paste(getwd(), "Proportion/hab_2.asc", sep="/"), crs=BNG), raster(paste(getwd(), "Proportion/hab_3.asc", sep="/"), crs=BNG), raster(paste(getwd(), "Proportion/hab_4.asc", sep="/"), crs=BNG), raster(paste(getwd(), "Proportion/hab_5.asc", sep="/"), crs=BNG), raster(paste(getwd(), "Proportion/hab_6.asc", sep="/"), crs=BNG), raster("studyareadem.asc", crs=BNG)) # Run MaxEnt model on locations and environmental layers max_base <- maxent(env.l.base, BK.pres, args = c('outputgrids=true','betamultiplier=7')) # Project model onto environmental layers to create suitability map base.map <- predict(max_base, env.l.base) # Write map to gile writeRaster(base.map, filename=(paste(getwd(), "base_map.grd", sep="/")), overwrite=T) # Extract threshold values from MaxEnt scores BK.sp <- SpatialPoints(BK.pres, proj4string=BNG) BK.scores <- extract(base.map, BK.sp) # First quartile cutoff.1 <- summary(BK.scores)[[2]] # Median cutoff.med <- summary(BK.scores)[[3]] # Third quartile cutoff.3 <- summary(BK.scores)[[5]] # Reclass relative suitability map to binary maps rcl.1 <- matrix(c(0, cutoff.1-0.0001, 0, cutoff.1, 1, 1), nrow=3, ncol=3, byrow=T) rcl.med <- matrix(c(0, cutoff.med-0.0001, 0, cutoff.med, 1, 1), nrow=3, ncol=3, byrow=T) rcl.3 <- matrix(c(0, cutoff.3-0.0001, 0, cutoff.3, 1, 1), nrow=3, ncol=3, byrow=T) pa.1 <- reclass(base.map, rcl.1) pa.med <- reclass(base.map, rcl.med) pa.3 <- reclass(base.map, rcl.3) rm(base.map) # Write thresholds and proportions of study area predictred as present to file max_scores <- data.frame("Model"=c("1st", "Median", "3rd"),"Proportion"=numeric(3), "Cutoff"=numeric(3)) max_scores[1,3] <- cutoff.1 max_scores[2,3] <- cutoff.med max_scores[3,3] <- cutoff.3 max_scores[1,2] <- cellStats(pa.1, mean) max_scores[2,2] <- cellStats(pa.med, mean) max_scores[3,2] <- cellStats(pa.3, mean) rm(pa) write.csv(max_scores, "max_models.csv", row.names=F) #### The following code runs a landscape simulation model #### # Set output directory for scenario output <- paste(getwd(), "Scenario_1", sep="/") # Declare data frame to store results from the three different thresholds pres.abs <- data.frame("1st"=numeric(models), "Median"=numeric(models), "3rd"=numeric(models)) # Create loop to run the number of replicates for(j in 1:models){ # Read in potential land-use change layer (i.e. habitat to be changed) potential <- raster(paste(getwd(), "Binary/bin_2.asc", sep="/"), crs=BNG) # Reclass potential layer to allow selection of start points rcl <- matrix(c(-1,0.7,NA,0.8,1.2,0), nrow=2, ncol=3, byrow=T) potential.0 <- reclass(potential, rcl) # Create 20 random start points within the potential layer rnd.pts <- randomPoints(potential.0, 20) # Convert start points to raster rnd.pts <- as.data.frame(rnd.pts) potential.pts <- rasterize(rnd.pts, potential, background=0) potential.pts <- potential.0 + potential.pts projection(potential.pts) <- BNG rm(potential) # Run the cellular function to grow new habitat one to get a stating map new.hab <- f.Exp(potential.pts, potential.pts, p.trans) # Run the function for the set number of iterations as long as the area affected is less than or equal to the proportion of habitat to be changed for(i in 1:iterations){ if(cellStats(new.hab, sum) <= <<<***10% of habitat extent in cells***>>>) new.hab.1 <- f.Exp(new.hab, potential.pts, p.trans) else new.hab <- new.hab } # Create an output directory for maps dir.create(paste(getwd(), "/Scenario_1/run_", j, sep="")) # Reclass habitat map so it can be combined with current habitat (change NA to 0) rcl.na <- matrix(c(NA, NA, 0), nrow=1, ncol=3, byrow=T) new.hab <- reclass(new.hab, rcl.na) # Read in current habitat layer current.hab <- raster(paste(getwd(), "Binary/bin_3.asc", sep="/")) # Add new habitat co current habitat combined.hab<- current.hab + new.hab # Reclass combined habitat map to remove NAs combined.hab <- reclass(combined.hab, rcl.na) # Set projection of combined map projection(combined.hab) <- BNG # Calculate proportion of habitat per 2 km squared combined.hab <- focal(combined.hab, w=71, mean, na.rm=T, pad=T) # Write raster map of new (current plus new patches) habitat to output directory setwd(output) writeRaster(combined.hab, paste(paste(getwd(), "/run_", j, sep=""), "/combined.hab.asc", sep=""), overwrite=T) rm(current.hab, combined.hab) # Return to working directory setwd(work) # Read in old layer of habitat which has been changed old.hab <- raster(paste(getwd(), "Binary/bin_2.asc", sep="/")) # Remove converted patches from habitat layer hab.change <- old.hab - new.hab # Reclass to remove NAs hab.change<- reclass(hab.change, rcl.na) # Set projection of layer projection(hab.change) <- BNG # Calculate proportion of habitat per 2 km squared hab.change <- focal(hab.change, w=71, mean, na.rm=T, pad=T) # Write altered layer to output directory setwd(output) writeRaster(hab.change, paste(paste(getwd(), "/run_", j, sep=""), "/ hab.change.asc", sep=""), overwrite=T) rm(old.hab, hab.change) setwd(work) gc() # Read stack of raster layer representing new habitat. The maps from the above simulation is read from the output directory, the others from the original habitat layers env.l.new <- stack(raster(paste(getwd(), "Proportion/hab_1.asc", sep="/"), crs=BNG), raster(paste(getwd(), paste("Scenario_1/run_", j, sep=""), "hab.change", sep="/"), crs=BNG), raster(paste(getwd(), paste("Scenario_1/run_", j, sep=""), "combined.hab.asc", sep="/"), crs=BNG), raster(paste(getwd(), raster(paste(getwd(), "Proportion/hab_4.asc", sep="/"), crs=BNG), crs=BNG), raster(paste(getwd(), "Proportion/hab_5.asc", sep="/"), crs=BNG), raster(paste(getwd(), "Proportion/hab_6.asc", sep="/"), crs=BNG), raster("studyareadem.asc", crs=BNG)) # Project MaxEnt model onto new environmental layers pred <- predict(max_base, env.l.new) Output prediction map as raster writeRaster(pred, filename=(paste(getwd(), "Scenario_1", paste("pred_map", j, ".grd", sep= ""), sep="/")), overwrite=T) rm(env.l.new) gc() # Calculate proportion of study area predicted present at three thresholds # First quartile pa <- reclass(pred, rcl.1) pres.abs[j,1] <- cellStats(pa, mean) # Median pa <- reclass(pred, rcl.med) pres.abs[j,2] <- cellStats(pa, mean) # Third quartile pa <- reclass(pred, rcl.3) pres.abs[j,3] <- cellStats(pa, mean) rm(pa) } # Write results to file write.csv(pres.abs, "Scenario.csv", row.names=F)