###-------------------------------------------------------------------------------------------------------###

###Evaluating density-weighted connectivity of black bears (Ursus americanus) in Glacier National Park with spatial   capture-recapture models
### Movement Ecology DOI: 10.1186/s40462-023-00445-7
### Sarah L. Carroll, Greta M. Schmidt, John S. Waller, Tabitha Graves

Additional file 3: R code used to calculate density-weighted connectivity 
###-------------------------------------------------------------------------------------------------------###

### MALE BLACK BEARS EXAMPLE
#### Preliminaries
rm(list = ls())

#install oSCR directly from github
#install.packages("githubinstall")
#install.packages("devtools")

# load packages needed for github install 
library(githubinstall)
library(devtools)

#install.packages("dplyr")
#install_github("jaroyle/oSCR")

# load oSCR package and helper packages 
library(oSCR)
library(dplyr)
library(ggplot2)
library(gdistance)
library(dplyr)
library(RColorBrewer)
 
# run oSCR ecological distance model example 
# construct best model as list using OSCR data objects 
# note that asu is the formula for ecological cost distance models in oSCR 
asu.final.males<- list(D~ tree_cover + griz_density, p0 ~ Hair+ BE + Cover + Jul +Jul2 + ER +EH + Curv,  
		      sig~1, asu ~ dist2drain + transport corridor + tree_cover -1) 
# NOTE must include the -1 at the end of cost covariates to remove intercept and make estimates identifiable! 


# FIT THE MODEL 
# NOTE: a vector of starting values are required for speed and convergence supplied on the link scale, in order, for each model parameter included in the model list above.
# (e.g.)
starts<- c(-7.7,  1.56, -0.02, 1.34, 0.15,  5.0, -1.93, 0.15, 3.60, -0.22,-1.10,  0.31, -0.14,1.9,2.1,-0.1, 0.3)

# Now FIT 
asu.final.males.fit<-oSCR.fit(model =asu.final.males, scrFrame = Males.scrf, ssDF = ssdf, costDF = costdf, # requires the cost data frame, state space data frame, also recommend setting the trimS parameter 
                       distmet= 'ecol', start.vals = starts, trimS=76)


### To calculate realized density and connectivity load:
### - best supported SCR ecological distance model object
### - male SCR frame, state space, and cost space

# Load oSCR data objects:
# fitted ecological distance oSCR model. This object contains the fitted model, the ssdf, and the tdf. 

# View model
asu.final.males.fit 

###-------------------------------------------------------------------------------------------------------###
### CALCULATE REALIZED DENSITY ESTIMATES 
### note this calculate takes about 4 minutes with this dataset on a standard laptop)
###-------------------------------------------------------------------------------------------------------###

# Default projection is correct one for Glacier NP. 
# If override.trim =T, trimS value from the scr.fit object is used, default is = F so predictions are made for entire state-space.
Density.pred.M<- predict.oSCR(asu.final.males, scrFrame = BB.males.scrf, ssDF = ssdf.glacier, costDF = csdf.glacier, override.trim=F)

# Realized density raster 
pDens_males<- (Density.pred.M$r[[1]])
# N hat estimate 
cellStats(pDens_males, sum)

# plot  
plot(pDens_males, main= "realized density: male black bears 2004")
 

### Project density raster to real scale coordinates (WGS 84 UTM 12N)
# now load terra - to avoid conflicts with gdistance 
library(terra)
# Project and replace NA values with zero
pDens_males.dat <-as.data.frame(pDens_males, xy=TRUE)
pDens_males.dat<- pDens_males.dat %>% mutate(x= x*1000,y = y*1000)
pDens_males.r<- rast(pDens_males.dat,type="xyz")
crs(pDens_males.r)<-'+init=epsg:32612'
 

###### Make template raster from CSDF and check 
csdf <-csdf.glacier[[1]] %>% dplyr::select(X,Y) %>% mutate(X= X*1000,Y = Y*1000)
csdf$val <- 1:nrow(csdf) 
csdf.r<- rast(csdf,type="xyz")
crs(csdf.r) <-'+init=epsg:32612'
plot(csdf.r, main= "check connectivity space", col = "grey")
 

#### Scale density values to cost surface resolution from 4km2 to 250m2
#Resample 
pDens_males.res = terra::resample(pDens_males.r,csdf.r,method = "near") # finer raster

# divide values by the original resolution
pDens_males.res = pDens_males.res*(prod(res(pDens_males.res)/res(pDens_males.r))) 
res(pDens_males.res) #check res 

# Check that total (S) Nhat estimate is the same after resampling 
sum(pDens_males.res[], na.rm = T) # All good 

# convert raster to dataframe 
pDens_males.dat.250 <-as.data.frame(pDens_males.res, xy=TRUE)

 
###-------------------------------------------------------------------------------------------------------###
### CALCULATE COST SURFACE FOR MALES BASED ON COST SPACE COVARIATES
###-------------------------------------------------------------------------------------------------------###

# Create covariate surface rasters for each supported connectivity covariate 
xy.draindist <-csdf.glacier[[1]] %>% dplyr::select(X,Y,dist2drain_norm) %>% mutate(X= X*1000,Y = Y*1000)
xy.draindist.r <- rast(xy.draindist,type="xyz")
crs(xy.draindist.r) <-'+init=epsg:32612'

# Forest cover 
xy.forestcover <-csdf.glacier[[1]] %>% dplyr::select(X,Y,TreeCov_norm) %>% mutate(X= X*1000,Y = Y*1000)
xy.forestcover.r <- rast(xy.forestcover,type="xyz")
crs(xy.forestcover.r) <-'+init=epsg:32612'


# Transportation corridor
xy.trans.cor <-csdf.glacier[[1]] %>% dplyr::select(X,Y,Trans) %>% mutate(X= X*1000,Y = Y*1000)
xy.trans.cor.r <- rast(xy.trans.cor,type="xyz")
crs(xy.trans.cor.r) <-'+init=epsg:32612'


Blues <- brewer.pal(n = 9, name = "Blues")
Greens<- brewer.pal(n = 9, name = "Greens")
Reds<- brewer.pal(n = 9, name = "Reds")
# Check by plot 
par(mfrow= c(1,3))
plot(xy.draindist.r,main = "dist to drains", col = rev(Blues))
plot(xy.forestcover.r, main = "forest cover", col = Greens)
plot(xy.trans.cor.r, main = "tansport corridor", col = Reds)
 

#### Calculate cost surfaces from resistance coefficients
# Cost calculation from coefficients 
#c.beta.dist2drain_norm    1.504 0.453  
#c.beta.Trans              2.201 0.301   
#c.beta.TreeCov_norm      -0.848 0.286  
Cost.males= exp(1.504 * xy.draindist.r) + exp(-0.848 * xy.forestcover.r) + exp(2.201 * xy.trans.cor.r)

# Convert to raster for gdistance function (does not accept terra objects)
par(mfrow= c(1,1))
Cost.males<- raster::raster(Cost.males)
plot(Cost.males, main = "Cost surface males")
 

###-------------------------------------------------------------------------------------------------------###
### Assign scaled density values to correct pixels in connectivity space
###-------------------------------------------------------------------------------------------------------###
# Turn pixel centroids into points 
library(raster)
costPts<-rasterToPoints(Cost.males,spatial=TRUE)
csdf.xy= costPts@coords

# Extract density values 
pDens_males.res<- raster(pDens_males.res)
costPts$M_Dens<-raster::extract(pDens_males.res, costPts)
cost.Data<- costPts@data
cost.Data<- cbind(csdf.xy, cost.Data)
sum(cost.Data$M_Dens, na.rm = T)

# Check for remaining NA values and replace with essentially zeros 
# (extremely low prob(density)), actuall 0's are not acceptable in the cost function
# this is so DWC calculations are not tripped up
cost.Data <- cost.Data %>% mutate(M_Dens = ifelse(is.na(M_Dens), 1e-17, M_Dens))

# Now create a new density raster to subset with the 0's corrected
M_Dens.r<-cost.Data %>% dplyr::select(x,y,M_Dens)
M_Dens.r<-rasterFromXYZ(M_Dens.r)
 

# Set-up for cost-distance calculation with gdistance and calculate geocorrected transition matrix
# Transition matrix for female cost surface 
# Inverse because needs conductance values, geo-correction needed because using WGS datum fixes diagonal distances
tr.mat.M <- transition(Cost.males, transitionFunction=function(x)1/mean(x), directions=8)
tr.mat.M <- geoCorrection(tr.mat.M,type="c",multpl=F,scl=F)
plot(raster(tr.mat.M), main= "transition matrix")

 
#### Calculate constants for calculating connectivity from coefficients
# Sigma spatial scaling parameter 
sigma.raw<-asu.final.males$rawOutput$estimate[2] # coefficient 
M.sigma.sc<-exp(sigma.raw)*1000 # Exp transform then *1000 to get meters (scale of csdf)

# calculate alpha 1
# Controls the function shape (sigma)
alpha1= -(1/(2*M.sigma.sc*M.sigma.sc)) 

# Create Density vector
M.Dens<- as.matrix(cost.Data$M_Dens)

# Coordinates for csdf 
csdf.xy<-costPts@coords
csdf.xy<-as.matrix(csdf.xy)

#### Create a template raster to subset the cost space 
Xmin <- 280500
Xmax <- 301900
Ymin <- 5360500
Ymax <- 5380500
aspectRatio <- (Ymax-Ymin)/(Xmax-Xmin)
cellSize <- 250
NCOLS <- as.integer((Xmax-Xmin)/cellSize)
NROWS <- as.integer(NCOLS * aspectRatio)
templateRas <- raster(ncol=NCOLS, nrow=NROWS, 
                    xmn=Xmin, xmx=Xmax, ymn=Ymin, ymx=Ymax,
                    vals=1, crs=crs(Cost.males))

# Now crop the cost and density rasters 
cost.subset<- raster::crop(Cost.males, extent(templateRas))
density.subset<- raster::crop(M_Dens.r, extent(templateRas))

#### Subset transition matrix 
tr.mat.M <- transition(cost.subset, transitionFunction=function(x)1/mean(x), directions=8)
tr.mat.M <- geoCorrection(tr.mat.M,type="c",multpl=F,scl=F)

par(mfrow= c(1,3))
plot(cost.subset, main = "cost space subset")
plot(raster(tr.mat.M), main= "transition matrix subset")
plot(density.subset, main = "density subset")


xy.cost<-as.matrix(raster::coordinates(cost.subset))  # pixel centroids 
density.subset <-as.matrix(as.data.frame(density.subset)) # density values 


##### detach so that gdistance isn't masked 
detach("package:gdistance", unload = TRUE) 
detach("package:raster", unload = TRUE)

library(foreach)
library(iterators)
library(doParallel)
library(gdistance)
library(raster)

###-------------------------------------------------------------------------------------------------------###
### The cost space is too large to calculate realized-density weighted connectivity for the whole 
### surface at once. We demonstrate for a subset of the study area how to calculate density-weighted 
### connectivity and include code option to iterate across the csdf.
###-------------------------------------------------------------------------------------------------------###


####### set up parallel 
no_cores <- 7 # change for appropriate machine 
cl <- makeCluster(no_cores) 
registerDoParallel(cl)   
getDoParWorkers()

###-------------------------------------------------------------------------------------------------------###
### NOTE: completing the calculation for the whole csdf takes ~ 3 hrs on a HPCC.
### to run sequentially instead of in parallel, change %dopar% to %do% 
### below is an example for the subset which this takes about 1 minute
###-------------------------------------------------------------------------------------------------------###

#####################################
# Use iterators for each vector
it <- iter(xy.cost, by = "row") # cell coordinates
itd <- iter(density.subset.dat, by = "row") # density values 
results_list<- foreach(i = it, j = itd,.packages=c("gdistance","raster"),.errorhandling='pass') %dopar%
  {
    LCP<-gdistance::costDistance(tr.mat.M,fromCoords =i, toCoords = xy.cost) # cost distance 
    LCP<-t(LCP)
    prob.use<- exp(alpha1*LCP*LCP) # cost distance to probability of use 
    DWC= prob.use %*%j # weighted by density 
  }

stopCluster(cl)
####################################

# Combine results
results<-Reduce(`+`, results_list)
result<- cbind(xy.cost,results)
library(terra)
DWC <- rast(result, type ="xyz")

plot(DWC, main= "Density-weighted connectivity subset")


###---------------------------------###   END of FILE   ###---------------------------------###