Set-up
Install necessary packages and import appropriate data
knitr::opts_chunk$set(echo = TRUE)
pacman::p_load(tidyverse, readxl, raster, vegan, tigris, sf, sjPlot, sp, spOccupancy, ggrepel, lme4, lmerTest, MuMIn, brms, MCMCvis, bayesplot, patchwork)
set.seed(97)
# Tree PCQ Data
tree_data <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/05_SharedData/Field_Data_FL_AL_MS.xlsx",
sheet = "Tree_PCQ")
# CWD Data
cwd_data <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/05_SharedData/Field_Data_FL_AL_MS.xlsx",
sheet = "CWD")
# Soil Data
fuel_data <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/05_SharedData/Field_Data_FL_AL_MS.xlsx",
sheet = "Fuel_Sampling")
# Veg Data
Veg_Cover <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/05_SharedData/Field_Data_FL_AL_MS.xlsx",
sheet = "Veg_Cover")
# Shrub Cover Data
shrub_data <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/05_SharedData/Field_Data_FL_AL_MS.xlsx",
sheet = "Shrub_Cover")
# Site Data
CameraData <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/04_Wildlife/02_Data/CameraData.xlsx")
CameraLoc <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/04_Wildlife/02_Data/CameraLoc.xlsx",
sheet = "CameraLocations")
# Add effort data
effort_matrix <- read_excel("C:/Users/DrewIvory/OneDrive - University of Florida/Desktop/School/PHD/01_Projects/04_Wildlife/02_Data/CameraLoc.xlsx",
sheet = "Effort_Matrix_Full") %>%
pivot_longer(cols = matches("^202[4-5]-"), names_to = "week", values_to = "days") %>%
filter(days == "7") %>%
dplyr::select(Plot, week)
Number of quadrats sampled per plot
# Count the total number of quadrats per plot
quadrat_count <- Veg_Cover %>%
group_by(Plot) %>%
summarize(total_quadrats = n_distinct(Quadrat), .groups = "drop")
Filter All data to only include specified species (Per PLANTS
database)
#Filter tree data to only include trees with "tree" in the growth column
tree_data <- dplyr::filter(tree_data, Growth == "Tree")
#Filter Veg Cover to exclude Shrubs and Trees
Veg_Cover <- dplyr::filter(Veg_Cover, Growth != "Shrub" & Growth != "Tree")
#Filter Shrub Cover to only include Shrubs and Trees
shrub_data <- dplyr::filter(shrub_data, Growth == "Shrub" | Growth == "Tree")
Provides the option to rarify vegetative species
# Calculate the total number of sites
total_sites <- nrow(CameraLoc)
# Function to filter data by frequency
filter_by_frequency <- function(df) {
# Group data by species and calculate the frequency
freq <- df %>%
group_by(Species) %>%
summarise(Frequency = n_distinct(Plot) / nrow(CameraLoc) * 100) %>%
filter(Frequency >= 0)
# Filter the original data to include only species with frequency >= XX%
filtered_df <- df %>%
filter(Species %in% freq$Species)
return(filtered_df)
}
# Filter tree data by frequency
tree_data <- filter_by_frequency(tree_data)
# Filter Veg Cover data by frequency
Veg_Cover <- filter_by_frequency(Veg_Cover)
# Filter Shrub Cover data by frequency
shrub_data <- filter_by_frequency(shrub_data)
Shrub Cover Conversion
# Total length of Shrub cover at a site
shrub_cover <- shrub_data %>%
mutate(Cover = Line_End - Line_Start) %>%
group_by(Species_Name, Plot) %>%
summarise(Shrub_Total_Cover = sum(Cover, na.rm = TRUE), .groups = "drop") %>%
mutate(Shrub_Percent_Cover = Shrub_Total_Cover / 3000 * 100)
# Summed length of shrub over at a site
shrub_cover_summed <- shrub_cover %>%
group_by(Plot) %>%
summarize(total_shrub_cover = sum(Shrub_Total_Cover, na.rm = TRUE), .groups = "drop")
Herbacous Cover Conversion
# Combine Plot and Quadrat columns
Veg_Cover <- Veg_Cover %>%
mutate(Plot_Quadrat = paste(Plot, Quadrat, sep = '_'))
# Join with CogonSites to get site information
Veg_Cover <- Veg_Cover %>%
left_join(CameraLoc, by = "Plot")
# Sum species cover across quadrats for each species at each plot
veg_cover_summed <- Veg_Cover %>%
group_by(Plot, Species_Name) %>%
summarize(total_cover = sum(Cover_Per, na.rm = TRUE), .groups = "drop")
# Calculate average herbaceous species cover
avg_species_cover <- veg_cover_summed %>%
left_join(quadrat_count, by = "Plot") %>%
mutate(avg_cover = total_cover / total_quadrats)
Merging Herb cover with Shrub
This species matrix includes herbaceous and shrub species
# Merge shrub cover with herbaceous average cover
combined_cover <- avg_species_cover %>%
full_join(
shrub_cover %>%
dplyr::select(Plot, Species_Name, Shrub_Percent_Cover),
by = c("Plot", "Species_Name")
) %>%
mutate(
overlap_flag = ifelse(!is.na(avg_cover) & !is.na(Shrub_Percent_Cover), TRUE, FALSE), # Flag overlaps
final_cover = case_when(
!is.na(avg_cover) & is.na(Shrub_Percent_Cover) ~ avg_cover, # Use herbaceous cover if no shrub data
is.na(avg_cover) & !is.na(Shrub_Percent_Cover) ~ Shrub_Percent_Cover, # Use shrub cover if no herbaceous data
TRUE ~ NA_real_ # NA where overlaps exist
)
)
# Species Matrix
species_matrix <- combined_cover %>%
dplyr::select(Plot, Species_Name, final_cover) %>%
pivot_wider(
names_from = Species_Name,
values_from = final_cover,
values_fill = 0
)
Summarize Cogongrass Cover
avg_cogongrass_cover <- species_matrix %>%
group_by(Plot) %>%
summarize(Avg_Cogongrass_Cover = sum(Imperata_cylindrica, na.rm = TRUE) / n(), .groups = "drop")
Herbacous Shannon Diversity Index
# Summarize species cover by site
site_species_cover <- Veg_Cover %>%
group_by(Plot, Species_Name) %>%
summarize(total_cover = sum(Cover_Per, na.rm = TRUE)) %>%
ungroup()
## `summarise()` has grouped output by 'Plot'. You can override using the
## `.groups` argument.
## Remove all Imperata_cylindrica_Live and Imperata_cylindrica from species
site_species_cover <- site_species_cover %>%
filter(Species_Name != "Imperata_cylindrica_Live" & Species_Name != "Imperata_cylindrica")
# Calculate Shannon diversity per site
Veg_shannon_diversity <- site_species_cover %>%
group_by(Plot) %>%
mutate(proportion = total_cover / sum(total_cover)) %>%
summarize(Veg_shannon_index = -sum(proportion * log(proportion), na.rm = TRUE))
print(Veg_shannon_diversity)
## # A tibble: 206 × 2
## Plot Veg_shannon_index
## <chr> <dbl>
## 1 BI200 2.75
## 2 BI201 2.70
## 3 BI202 2.59
## 4 BI97 1.61
## 5 BI99 2.97
## 6 BN210 2.97
## 7 BN211 2.43
## 8 BN212 2.22
## 9 BN96 3.05
## 10 BN98 2.79
## # ℹ 196 more rows
Vegetation Height
if (!is.numeric(fuel_data$Height)) {
fuel_data$Height <- as.numeric(as.character(fuel_data$Height))
}
## Warning: NAs introduced by coercion
# Calculate average vegetation height per plot
veg_height <- fuel_data %>%
group_by(Plot) %>%
summarize(avg_veg_height = mean(Height, na.rm = TRUE), .groups = "drop")
Tree Metrics
# Tree density from point-centered quarter data
if (!is.numeric(tree_data$Distance)) {
tree_data$Distance <- as.numeric(as.character(tree_data$Distance))
}
tree_density_data <- tree_data %>%
group_by(Plot) %>%
summarize(Average_Distance = mean(Distance) / 100, # Convert to meters
Tree_Density = 10000 / (Average_Distance^2)) # Convert to trees per hectare
# Average canopy cover from vegetation quadrats
tree_canopy_data <- Veg_Cover %>%
distinct(Plot, Quadrat, .keep_all = TRUE) %>% # Ensure each quadrat counts once per plot
group_by(Plot) %>%
summarize(Avg_Canopy_Cover = mean(Canopy_Cover, na.rm = TRUE), .groups = "drop") # Calculate the average canopy cover per plot
cor(tree_density_data$Tree_Density, tree_canopy_data$Avg_Canopy_Cover)
## [1] 0.2742307
CWD Clean
cwd_pa <- cwd_data %>%
group_by(Plot) %>%
summarise(
CWD_presence = as.integer(any(Line_Start > 0 & Line_End > 0)),
.groups = "drop"
)
Objective 1: Assessing if cogongrass invasion-related factors
influence wildlife presence
Add Covariates
CameraLoc <- CameraLoc %>%
left_join(cwd_pa, by = "Plot") %>%
left_join(Veg_shannon_diversity, by = "Plot") %>%
left_join(avg_cogongrass_cover, by = "Plot") %>%
left_join(shrub_cover_summed %>% dplyr::select(Plot, total_shrub_cover), by = "Plot") %>%
left_join(veg_height, by = "Plot") %>%
left_join(tree_density_data %>% dplyr::select(Plot, Tree_Density), by = "Plot") %>%
left_join(tree_canopy_data %>% dplyr::select(Plot, Avg_Canopy_Cover), by = "Plot") %>%
dplyr::select(-Authority)
Distribution of Covariates
par(mfrow = c(3, 3))
hist(CameraLoc$Cogon_Patch_Size, main = "Cogon Patch Size", xlab = "Size (m²)")
hist(CameraLoc$Veg_shannon_index, main = "Vegetation Shannon Index", xlab = "Shannon Index")
hist(CameraLoc$total_shrub_cover, main = "Total Shrub Cover", xlab = "Shrub Cover (%)")
hist(CameraLoc$Avg_Cogongrass_Cover, main = "Average Cogongrass Cover", xlab = "Cogongrass Cover (%)")
hist(CameraLoc$Tree_Density, main = "Tree Density", xlab = "Trees per ha")
hist(CameraLoc$Avg_Canopy_Cover, main = "Average Canopy Cover", xlab = "Canopy Cover (%)")
hist(CameraLoc$avg_veg_height, main = "Average Vegetation Height", xlab = "Height (cm)")
table(CameraLoc$CWD_presence)
##
## 0 1
## 25 7
par(mfrow = c(1, 1))

Subset to mammals with >10 observations
exclude_species <- c(
"Odocoileus_virginianus",
"Dasypus_novemcinctus"
)
species_counts <- CameraData %>%
filter(
(Class == "Mammalia" & !Name %in% exclude_species) |
Name == "Meleagris_gallopavo"
) %>%
group_by(Name) %>%
summarize(count = n(), .groups = "drop")
# Filter for species with count greater than 10
species_subset <- species_counts %>%
filter(count > 10) %>%
pull(Name)
# Filter CameraData to only include species with count > 10
CameraData <- CameraData %>%
filter(Name %in% species_subset)
Create Detection Matrix
# Format Data Weekly
observations_weekly <- CameraData %>%
group_by(Plot, week = format(as.Date(Date), "%Y-%U"), Name) %>%
summarise(observations = n(), .groups = 'drop')
# Merge with Effort Matrix to include only valid weeks
observations_weekly <- effort_matrix %>%
left_join(observations_weekly, by = c("Plot" = "Plot", "week")) %>%
replace_na(list(observations = 0))
# Convert to wide format
observations_species <- observations_weekly %>%
pivot_wider(names_from = Name, values_from = observations, values_fill = list(observations = 0)) %>%
dplyr::select(-"NA")
# Create detection array
site_names <- sort(unique(observations_species$Plot))
species_names <- setdiff(colnames(observations_species), c("Plot", "week"))
num_sites <- length(site_names)
num_weeks <- length(unique(observations_species$week))
num_species <- length(species_names)
detection_array <- array(0, dim = c(num_sites, num_weeks, num_species))
dimnames(detection_array) <- list(site_names, unique(observations_species$week), species_names)
for (s in seq_along(species_names)) {
species_col <- species_names[s]
for (i in seq_along(site_names)) {
site <- site_names[i]
for (j in seq_along(unique(observations_species$week))) {
week <- unique(observations_species$week)[j]
detection_array[i, j, s] <- ifelse(
any(observations_species$Plot == site & observations_species$week == week & observations_species[[species_col]] > 0),
1, 0
)
}
}
}
dim(detection_array) # Should be num_sites x num_weeks x num_species
## [1] 32 36 7
Prepare Site Covariates
# Duplicate CameraLoc to be used in Objective 2
CameraLoc_O2 <- CameraLoc
# Standardize the covariates
CameraLoc <- CameraLoc %>%
dplyr::select(-Plot, -Camera, -Lat, -Long, -Status, - Start_Date)
covariates_matrix <- as.matrix(CameraLoc)
rownames(covariates_matrix) <- site_names
# Standardizing covariates
covariates_matrix <- scale(covariates_matrix)
## Correlation
cor_mat <- cor(covariates_matrix)
# Create week matrix for covariate structure [site x week]
week_vals <- unique(observations_species$week)
week_matrix <- matrix(rep(week_vals, each = num_sites), nrow = num_sites, ncol = num_weeks, byrow = FALSE)
# Create detection covariate list
det.covs <- list(
shrub_cover = covariates_matrix[, "total_shrub_cover"],
veg_height = covariates_matrix[, "avg_veg_height"],
week = week_matrix
)
# Remove dash and convert to numeric
week_numeric <- as.numeric(gsub("-", "", det.covs$week))
## Scale and center week_numeric
week_numeric <- scale(week_numeric)
# Reshape into the original 32x36 matrix
det.covs$week <- matrix(week_numeric, nrow = 32, ncol = 36)
det.covs$Auth <- matrix(CameraLoc$Auth, nrow = 32, ncol = 36)
str(det.covs)
## List of 4
## $ shrub_cover: Named num [1:32] 1.526 0.5 -0.153 -1.003 -0.811 ...
## ..- attr(*, "names")= chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## $ veg_height : Named num [1:32] 0.466 -1.044 1.181 0.879 1.684 ...
## ..- attr(*, "names")= chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## $ week : num [1:32, 1:36] -0.613 -0.613 -0.613 -0.613 -0.613 ...
## $ Auth : num [1:32, 1:36] 1 1 2 2 2 2 2 2 2 3 ...
Combine data into a list
This requires combining the presence data and the site covariate data
into a single list. This also means that the presence data is in a 3-d
format.
# Combine into a named list
data_list <- list(
y = detection_array,
occ.covs = covariates_matrix,
det.covs = det.covs
#,
#coords = coords
)
str(data_list)
## List of 3
## $ y : num [1:32, 1:36, 1:7] 0 0 0 0 0 0 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 3
## .. ..$ : chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## .. ..$ : chr [1:36] "2024-29" "2024-30" "2024-31" "2024-32" ...
## .. ..$ : chr [1:7] "Canis_latrans" "Procyon_lotor" "Lynx_rufus" "Didelphis_virginiana" ...
## $ occ.covs: num [1:32, 1:12] -0.237 -0.446 -0.337 -0.308 0.039 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## .. ..$ : chr [1:12] "Cogon_Patch_Size" "VegetationDiversity" "PostTreatmentDensities" "Auth" ...
## ..- attr(*, "scaled:center")= Named num [1:12] 458.388 21.875 0.898 2.844 16.188 ...
## .. ..- attr(*, "names")= chr [1:12] "Cogon_Patch_Size" "VegetationDiversity" "PostTreatmentDensities" "Auth" ...
## ..- attr(*, "scaled:scale")= Named num [1:12] 1027.633 6.871 1.232 0.808 0.397 ...
## .. ..- attr(*, "names")= chr [1:12] "Cogon_Patch_Size" "VegetationDiversity" "PostTreatmentDensities" "Auth" ...
## $ det.covs:List of 4
## ..$ shrub_cover: Named num [1:32] 1.526 0.5 -0.153 -1.003 -0.811 ...
## .. ..- attr(*, "names")= chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## ..$ veg_height : Named num [1:32] 0.466 -1.044 1.181 0.879 1.684 ...
## .. ..- attr(*, "names")= chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## ..$ week : num [1:32, 1:36] -0.613 -0.613 -0.613 -0.613 -0.613 ...
## ..$ Auth : num [1:32, 1:36] 1 1 2 2 2 2 2 2 2 3 ...
Convert occupancy and detection covariates to a dataframe (from
matrix)
I am unsure why I only had an issue with total shrub cover, but this
should fix the “cannot find” issue.
# Convert occupancy and detection covariates to a dataframe
data_list[["occ.covs"]] <- as.data.frame(data_list[["occ.covs"]])
data_list[["occ.covs"]]$total_shrub_cover <- as.numeric(data_list[["occ.covs"]]$total_shrub_cover)
#data_list[["det.covs"]] <- as.data.frame(data_list[["det.covs"]])
#data_list[["det.covs"]]$total_shrub_cover <- as.numeric(data_list[["det.covs"]]$total_shrub_cover)
# Make species the first dimension
data_list$y <- aperm(data_list$y, c(3, 1, 2))
dimnames(data_list$y) <- list(species = dimnames(data_list$y)[[1]],
site = dimnames(data_list$y)[[2]],
week = dimnames(data_list$y)[[3]])
str(data_list)
## List of 3
## $ y : num [1:7, 1:32, 1:36] 0 0 0 0 0 0 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 3
## .. ..$ species: chr [1:7] "Canis_latrans" "Procyon_lotor" "Lynx_rufus" "Didelphis_virginiana" ...
## .. ..$ site : chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## .. ..$ week : chr [1:36] "2024-29" "2024-30" "2024-31" "2024-32" ...
## $ occ.covs:'data.frame': 32 obs. of 12 variables:
## ..$ Cogon_Patch_Size : num [1:32] -0.237 -0.446 -0.337 -0.308 0.039 ...
## ..$ VegetationDiversity : num [1:32] -0.273 0.455 1.619 -0.273 2.929 ...
## ..$ PostTreatmentDensities: num [1:32] 0.432 -0.729 0.432 2.169 1.13 ...
## ..$ Auth : num [1:32] -2.28 -2.28 -1.04 -1.04 -1.04 ...
## ..$ UTM_Zone : num [1:32] -0.473 -0.473 -0.473 -0.473 -0.473 ...
## ..$ CWD_presence : num [1:32] 1.86 -0.521 -0.521 -0.521 -0.521 ...
## ..$ Veg_shannon_index : num [1:32] 0.6829 0.0427 0.7279 -0.5991 1.1371 ...
## ..$ Avg_Cogongrass_Cover : num [1:32] -0.154 -0.708 0.308 2.045 1.121 ...
## ..$ total_shrub_cover : num [1:32] 1.526 0.5 -0.153 -1.003 -0.811 ...
## ..$ avg_veg_height : num [1:32] 0.466 -1.044 1.181 0.879 1.684 ...
## ..$ Tree_Density : num [1:32] -0.3629 -0.3564 -0.5111 3.5896 0.0958 ...
## ..$ Avg_Canopy_Cover : num [1:32] 0.1362 -0.0252 -0.9132 0.782 -1.9627 ...
## $ det.covs:List of 4
## ..$ shrub_cover: Named num [1:32] 1.526 0.5 -0.153 -1.003 -0.811 ...
## .. ..- attr(*, "names")= chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## ..$ veg_height : Named num [1:32] 0.466 -1.044 1.181 0.879 1.684 ...
## .. ..- attr(*, "names")= chr [1:32] "BI201" "BN211" "EI100" "EI102" ...
## ..$ week : num [1:32, 1:36] -0.613 -0.613 -0.613 -0.613 -0.613 ...
## ..$ Auth : num [1:32, 1:36] 1 1 2 2 2 2 2 2 2 3 ...
Site Covariates
# Define detection formulas
det.null <- ~ 1
det.full <- ~ shrub_cover + veg_height + week + (1 | Auth)
det.cover <- ~ shrub_cover + veg_height + (1 | Auth)
det.week <- ~ week + (1 | Auth)
det.week.quad <- ~ week + I(week^2) + (1 | Auth)
det.full.quad <- ~ shrub_cover + veg_height + week + I(week^2) + (1 | Auth)
# Define occupancy formulas
occ.null <- ~ 1
occ.full <- ~ #Cogon_Patch_Size +
Veg_shannon_index + total_shrub_cover +
Avg_Cogongrass_Cover +
#Tree_Density +
Avg_Canopy_Cover +
avg_veg_height + CWD_presence + (1 | Auth)
occ.full.quad <- ~ #Cogon_Patch_Size +
Veg_shannon_index + total_shrub_cover +
Avg_Cogongrass_Cover + I(Avg_Cogongrass_Cover^2) +
#Tree_Density +
Avg_Canopy_Cover +
avg_veg_height + CWD_presence + (1 | Auth)
occ.cover <- ~ Avg_Cogongrass_Cover + total_shrub_cover +
avg_veg_height + CWD_presence + (1 | Auth)
occ.canopy <- ~ #Tree_Density +
Avg_Canopy_Cover + Avg_Cogongrass_Cover + (1 | Auth)
occ.canopy.quad <- ~ #Tree_Density +
Avg_Canopy_Cover + Avg_Cogongrass_Cover + I(Avg_Cogongrass_Cover^2) + (1 | Auth)
occ.move <- ~ #Cogon_Patch_Size +
Avg_Cogongrass_Cover + total_shrub_cover + (1 | Auth)
occ.move.quad <- ~ #Cogon_Patch_Size +
Avg_Cogongrass_Cover + I(Avg_Cogongrass_Cover^2) +
total_shrub_cover + (1 | Auth)
occ.forage <- ~ Veg_shannon_index + Avg_Cogongrass_Cover + (1 | Auth)
occ.forage.quad <- ~ Veg_shannon_index + Avg_Cogongrass_Cover +
I(Avg_Cogongrass_Cover^2) + (1 | Auth)
occ.cogon <- ~ Avg_Cogongrass_Cover + (1 | Auth)
occ.cogon.quad <- ~ Avg_Cogongrass_Cover + I(Avg_Cogongrass_Cover^2) + (1 | Auth)
Priors
priors <- list(
# Community-level effects
beta.comm.normal = list(mean = 0, var = 2.73),
alpha.comm.normal = list(mean = 0, var = 2.73),
# Species-level variance (hierarchical shrinkage)
tau.sq.beta.ig = list(2, 1),
tau.sq.alpha.ig = list(2, 1)#,
# Spatial variance
#sigma.sq.ig = list(3, 2),
# Spatial decay
#phi.unif = list(0.05, 3) # 0.05 (5km) local & 3 (300 km) large-scale
)
Run the occupancy model
Model Comparison
waicOcc(ms_full_full, by.sp = FALSE)
## elpd pD WAIC
## -787.81224 68.29766 1712.21980
waicOcc(ms_null_null, by.sp = FALSE)
## elpd pD WAIC
## -865.74236 18.28405 1768.05283
waicOcc(ms_cover_forage, by.sp = FALSE)
## elpd pD WAIC
## -814.73265 50.89407 1731.25343
waicOcc(ms_cover_move, by.sp = FALSE)
## elpd pD WAIC
## -814.98829 51.44825 1732.87308
waicOcc(ms_cover_canopy, by.sp = FALSE)
## elpd pD WAIC
## -804.92390 48.02687 1705.90153
waicOcc(ms_cover_canopyQ, by.sp = FALSE)
## elpd pD WAIC
## -800.41612 50.66635 1702.16493
waicOcc(ms_weekQ_cogonQ, by.sp = FALSE)
## elpd pD WAIC
## -818.87153 55.18828 1748.11961
waicOcc(ms_fullQ_moveQ, by.sp = FALSE)
## elpd pD WAIC
## -798.90079 68.28726 1734.37609
waicOcc(ms_fullQ_cover, by.sp = FALSE)
## elpd pD WAIC
## -799.6046 76.7538 1752.7169
waicOcc(ms_fullQ_forage, by.sp = FALSE)
## elpd pD WAIC
## -804.19407 65.47403 1739.33620
waicOcc(ms_fullQ_fullQ, by.sp = FALSE)
## elpd pD WAIC
## -777.85040 77.10046 1709.90171
Model Validation
This test explains how well the model fits that data at the community
and species level. I believe 0.5 is the target p-value, though how far
from this number is considered adequate, I do not know yet. I believe
this is a good place to check when thinking about which species we
include in the model.
ppc_ft <- ppcOcc(
ms_cover_canopyQ,
fit.stat = "freeman-tukey",
group = 1
)
## Currently on species 1 out of 7
## Currently on species 2 out of 7
## Currently on species 3 out of 7
## Currently on species 4 out of 7
## Currently on species 5 out of 7
## Currently on species 6 out of 7
## Currently on species 7 out of 7
ppc_chisq <- ppcOcc(
ms_cover_canopyQ,
fit.stat = "chi-square",
group = 1
)
## Currently on species 1 out of 7
## Currently on species 2 out of 7
## Currently on species 3 out of 7
## Currently on species 4 out of 7
## Currently on species 5 out of 7
## Currently on species 6 out of 7
## Currently on species 7 out of 7
summary(ppc_ft)
##
## Call:
## ppcOcc(object = ms_cover_canopyQ, fit.stat = "freeman-tukey",
## group = 1)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Bayesian p-value: 0.418
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Canis_latrans Bayesian p-value: 0.5036
## Procyon_lotor Bayesian p-value: 0.125
## Lynx_rufus Bayesian p-value: 0.5651
## Didelphis_virginiana Bayesian p-value: 0.3386
## Sylvilagus_floridanus Bayesian p-value: 0.4081
## Meleagris_gallopavo Bayesian p-value: 0.6181
## Sciurus_carolinensis Bayesian p-value: 0.3673
## Fit statistic: freeman-tukey
summary(ppc_chisq)
##
## Call:
## ppcOcc(object = ms_cover_canopyQ, fit.stat = "chi-square", group = 1)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Bayesian p-value: 0.3607
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Canis_latrans Bayesian p-value: 0.3263
## Procyon_lotor Bayesian p-value: 0.0544
## Lynx_rufus Bayesian p-value: 0.5516
## Didelphis_virginiana Bayesian p-value: 0.3451
## Sylvilagus_floridanus Bayesian p-value: 0.2071
## Meleagris_gallopavo Bayesian p-value: 0.643
## Sciurus_carolinensis Bayesian p-value: 0.3974
## Fit statistic: chi-square
Posterior Checks
n.sp <- dim(data_list$y)[1]
n.weeks <- dim(data_list$y)[3]
sp.names <- dimnames(data_list$y)[[1]]
plot.names <- dimnames(data_list$y)[[2]]
# Named lookup: scientific name -> common name
common.names <- c(
"Canis_latrans" = "Coyote",
"Lynx_rufus" = "Bobcat",
"Procyon_lotor" = "Raccoon",
"Didelphis_virginiana" = "Virginia Opossum",
"Sylvilagus_floridanus" = "Eastern Cottontail Rabbit",
"Meleagris_gallopavo" = "Wild Turkey",
"Sciurus_carolinensis" = "Grey Squirrel"
)
# ── 1. Run PPC ───────────────────────────────────────────────────────────────
# group = 1: fit.y.group.quants = [5 x n.species x n.sites]
# group = 2: fit.y.group.quants = [5 x n.species x n.weeks]
ppc_ft_site <- ppcOcc(ms_cover_canopyQ, fit.stat = "freeman-tukey", group = 1)
## Currently on species 1 out of 7
## Currently on species 2 out of 7
## Currently on species 3 out of 7
## Currently on species 4 out of 7
## Currently on species 5 out of 7
## Currently on species 6 out of 7
## Currently on species 7 out of 7
ppc_ft_week <- ppcOcc(ms_cover_canopyQ, fit.stat = "freeman-tukey", group = 2)
## Currently on species 1 out of 7
## Currently on species 2 out of 7
## Currently on species 3 out of 7
## Currently on species 4 out of 7
## Currently on species 5 out of 7
## Currently on species 6 out of 7
## Currently on species 7 out of 7
ppc_chisq_site <- ppcOcc(ms_cover_canopyQ, fit.stat = "chi-square", group = 1)
## Currently on species 1 out of 7
## Currently on species 2 out of 7
## Currently on species 3 out of 7
## Currently on species 4 out of 7
## Currently on species 5 out of 7
## Currently on species 6 out of 7
## Currently on species 7 out of 7
ppc_chisq_week <- ppcOcc(ms_cover_canopyQ, fit.stat = "chi-square", group = 2)
## Currently on species 1 out of 7
## Currently on species 2 out of 7
## Currently on species 3 out of 7
## Currently on species 4 out of 7
## Currently on species 5 out of 7
## Currently on species 6 out of 7
## Currently on species 7 out of 7
summary(ppc_ft_site)
##
## Call:
## ppcOcc(object = ms_cover_canopyQ, fit.stat = "freeman-tukey",
## group = 1)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Bayesian p-value: 0.4149
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Canis_latrans Bayesian p-value: 0.4927
## Procyon_lotor Bayesian p-value: 0.1284
## Lynx_rufus Bayesian p-value: 0.5651
## Didelphis_virginiana Bayesian p-value: 0.3279
## Sylvilagus_floridanus Bayesian p-value: 0.4079
## Meleagris_gallopavo Bayesian p-value: 0.62
## Sciurus_carolinensis Bayesian p-value: 0.3622
## Fit statistic: freeman-tukey
summary(ppc_ft_week)
##
## Call:
## ppcOcc(object = ms_cover_canopyQ, fit.stat = "freeman-tukey",
## group = 2)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Bayesian p-value: 0.2746
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Canis_latrans Bayesian p-value: 0.067
## Procyon_lotor Bayesian p-value: 0.0308
## Lynx_rufus Bayesian p-value: 0.2356
## Didelphis_virginiana Bayesian p-value: 0.2917
## Sylvilagus_floridanus Bayesian p-value: 0.4231
## Meleagris_gallopavo Bayesian p-value: 0.0957
## Sciurus_carolinensis Bayesian p-value: 0.7781
## Fit statistic: freeman-tukey
summary(ppc_chisq_site)
##
## Call:
## ppcOcc(object = ms_cover_canopyQ, fit.stat = "chi-square", group = 1)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Bayesian p-value: 0.3646
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Canis_latrans Bayesian p-value: 0.3224
## Procyon_lotor Bayesian p-value: 0.0537
## Lynx_rufus Bayesian p-value: 0.5539
## Didelphis_virginiana Bayesian p-value: 0.3587
## Sylvilagus_floridanus Bayesian p-value: 0.2153
## Meleagris_gallopavo Bayesian p-value: 0.651
## Sciurus_carolinensis Bayesian p-value: 0.3971
## Fit statistic: chi-square
summary(ppc_chisq_week)
##
## Call:
## ppcOcc(object = ms_cover_canopyQ, fit.stat = "chi-square", group = 2)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Bayesian p-value: 0.35
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Canis_latrans Bayesian p-value: 0.168
## Procyon_lotor Bayesian p-value: 0.1148
## Lynx_rufus Bayesian p-value: 0.4511
## Didelphis_virginiana Bayesian p-value: 0.3417
## Sylvilagus_floridanus Bayesian p-value: 0.4773
## Meleagris_gallopavo Bayesian p-value: 0.3591
## Sciurus_carolinensis Bayesian p-value: 0.5382
## Fit statistic: chi-square
# ── 2. Scatter plot: replicated vs. observed fit statistic ───────────────────
# fit.y and fit.y.rep are [n.samples x n.species] — index species with [ , i]
# Points above the 1:1 line (salmon) = replicate fits worse than observed
# Points below the 1:1 line (blue) = replicate fits better than observed
# Bayesian p-value near 0.5 = good fit
# ── Helper to build one scatter plot ─────────────────────────────────────────
make_scatter <- function(i) {
ppc.df <- data.frame(
fit = ppc_ft_site$fit.y[ , i],
fit.rep = ppc_ft_site$fit.y.rep[ , i]
)
ppc.df$color <- ifelse(ppc.df$fit.rep > ppc.df$fit, "lightsalmon", "lightskyblue1")
ggplot(ppc.df, aes(x = fit, y = fit.rep)) +
geom_point(aes(fill = color), shape = 21, color = "grey40", size = 1.8) +
geom_abline(slope = 1, intercept = 0, color = "black") +
scale_fill_identity() +
labs(
title = common.names[sp.names[i]],
x = "True", y = "Replicate"
) +
theme_bw(base_size = 10) +
theme(plot.title = element_text(size = 9))
}
# ── Helper: site-level discrepancy ───────────────────────────────────────────
make_site_discrepancy <- function(i) {
diff.fit <- ppc_ft_site$fit.y.rep.group.quants[3, i, ] -
ppc_ft_site$fit.y.group.quants[3, i, ]
df <- data.frame(
x = seq_along(diff.fit),
diff = diff.fit,
site = plot.names
)
ggplot(df, aes(x = x, y = diff)) +
geom_point(shape = 19, size = 1.8) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
scale_x_continuous(
breaks = df$x,
labels = df$site
) +
labs(
title = common.names[sp.names[i]],
x = NULL, y = "Replicate - True Discrepancy"
) +
theme_bw(base_size = 10) +
theme(
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, size = 6),
plot.title = element_text(size = 9)
)
}
# ── Helper: week-level discrepancy ───────────────────────────────────────────
make_week_discrepancy <- function(i) {
diff.fit <- ppc_ft_week$fit.y.rep.group.quants[3, i, ] -
ppc_ft_week$fit.y.group.quants[3, i, ]
df <- data.frame(
week = 1:n.weeks,
diff = diff.fit
)
ggplot(df, aes(x = week, y = diff)) +
geom_point(shape = 19, size = 1.8) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
scale_x_continuous(breaks = 1:n.weeks) +
labs(
title = common.names[sp.names[i]],
x = "Week", y = "Replicate - True Discrepancy"
) +
theme_bw(base_size = 10) +
theme(plot.title = element_text(size = 9))
}
# ── Assemble panels with patchwork ───────────────────────────────────────────
assemble_panel <- function(plot_fn, title_label) {
plots <- lapply(seq_len(n.sp), plot_fn)
wrap_plots(plots, ncol = ceiling(n.sp / 2)) +
plot_annotation(title = title_label,
theme = theme(plot.title = element_text(size = 12, face = "bold")))
}
panel_scatter <- assemble_panel(make_scatter, "")
panel_site <- assemble_panel(make_site_discrepancy, "")
panel_week <- assemble_panel(make_week_discrepancy, "")
# ── Stack the three panels and save ──────────────────────────────────────────
ggsave(
filename = "ppc_scatter.png",
plot = panel_scatter,
width = 12,
height = 9,
dpi = 300
)
ggsave(
filename = "ppc_site_discrepancy.png",
plot = panel_site,
width = 12,
height = 9,
dpi = 300
)
ggsave(
filename = "ppc_week_discrepancy.png",
plot = panel_week,
width = 12,
height = 9,
dpi = 300
)
Proability of Direction- Occupancy
pd <- function(x) {
max(mean(x > 0), mean(x < 0))
}
pd_table <- apply(
ms_cover_canopyQ$beta.samples,
2,
pd
)
head(pd_table)
## (Intercept)-Canis_latrans (Intercept)-Procyon_lotor
## 0.7599286 0.5584286
## (Intercept)-Lynx_rufus (Intercept)-Didelphis_virginiana
## 0.7937143 0.9752857
## (Intercept)-Sylvilagus_floridanus (Intercept)-Meleagris_gallopavo
## 0.8943571 0.6436429
beta_means <- colMeans(ms_cover_canopyQ$beta.samples)
beta_samps <- ms_cover_canopyQ$beta.samples
pd_vals <- apply(beta_samps, 2, pd)
beta_means <- colMeans(beta_samps)
results_species <- data.frame(
parameter = colnames(beta_samps),
mean = beta_means,
pd = pd_vals,
pd_95 = pd_vals >= 0.95
)
head(results_species)
## parameter mean
## (Intercept)-Canis_latrans (Intercept)-Canis_latrans -0.46601118
## (Intercept)-Procyon_lotor (Intercept)-Procyon_lotor -0.08624127
## (Intercept)-Lynx_rufus (Intercept)-Lynx_rufus -0.65048614
## (Intercept)-Didelphis_virginiana (Intercept)-Didelphis_virginiana -1.40174157
## (Intercept)-Sylvilagus_floridanus (Intercept)-Sylvilagus_floridanus -0.90525959
## (Intercept)-Meleagris_gallopavo (Intercept)-Meleagris_gallopavo -0.26151715
## pd pd_95
## (Intercept)-Canis_latrans 0.7599286 FALSE
## (Intercept)-Procyon_lotor 0.5584286 FALSE
## (Intercept)-Lynx_rufus 0.7937143 FALSE
## (Intercept)-Didelphis_virginiana 0.9752857 TRUE
## (Intercept)-Sylvilagus_floridanus 0.8943571 FALSE
## (Intercept)-Meleagris_gallopavo 0.6436429 FALSE
beta_comm <- ms_cover_canopyQ$beta.comm.samples
results_comm <- data.frame(
parameter = colnames(beta_comm),
mean = colMeans(beta_comm),
pd = apply(beta_comm, 2, pd)
)
results_comm$pd_95 <- results_comm$pd >= 0.95
Probability of Direction- Detection
pd <- function(x) {
max(mean(x > 0), mean(x < 0))
}
alpha_samps <- ms_cover_canopyQ$alpha.samples
pd_vals_alpha <- apply(alpha_samps, 2, pd)
alpha_means <- colMeans(alpha_samps)
results_species_det <- data.frame(
parameter = colnames(alpha_samps),
mean = alpha_means,
pd = pd_vals_alpha,
pd_95 = pd_vals_alpha >= 0.95
)
head(results_species_det)
## parameter mean
## (Intercept)-Canis_latrans (Intercept)-Canis_latrans -2.951835
## (Intercept)-Procyon_lotor (Intercept)-Procyon_lotor -2.746050
## (Intercept)-Lynx_rufus (Intercept)-Lynx_rufus -3.785200
## (Intercept)-Didelphis_virginiana (Intercept)-Didelphis_virginiana -2.999023
## (Intercept)-Sylvilagus_floridanus (Intercept)-Sylvilagus_floridanus -3.247821
## (Intercept)-Meleagris_gallopavo (Intercept)-Meleagris_gallopavo -3.867865
## pd pd_95
## (Intercept)-Canis_latrans 1 TRUE
## (Intercept)-Procyon_lotor 1 TRUE
## (Intercept)-Lynx_rufus 1 TRUE
## (Intercept)-Didelphis_virginiana 1 TRUE
## (Intercept)-Sylvilagus_floridanus 1 TRUE
## (Intercept)-Meleagris_gallopavo 1 TRUE
alpha_comm <- ms_cover_canopyQ$alpha.comm.samples
results_comm_det <- data.frame(
parameter = colnames(alpha_comm),
mean = colMeans(alpha_comm),
pd = apply(alpha_comm, 2, pd)
)
results_comm_det$pd_95 <- results_comm_det$pd >= 0.95
results_comm_det
## parameter mean pd pd_95
## (Intercept) (Intercept) -3.149271519 1.0000000 TRUE
## shrub_cover shrub_cover -0.001781095 0.5081429 FALSE
## veg_height veg_height 0.074525352 0.6236429 FALSE
Plot Species Occupancy
Batched Parameter Estimates
summary(ms_cover_canopyQ) # Summary of parameter estimates
##
## Call:
## msPGOcc(occ.formula = occ.canopy.quad, det.formula = det.cover,
## data = data_list, priors = priors, n.samples = 10000, n.report = 1000,
## n.burn = 3000, n.thin = 2, n.chains = 4)
##
## Samples per Chain: 10000
## Burn-in: 3000
## Thinning Rate: 2
## Number of Chains: 4
## Total Posterior Samples: 14000
## Run Time (min): 1.7608
##
## ----------------------------------------
## Community Level
## ----------------------------------------
## Occurrence Means (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat ESS
## (Intercept) -0.7536 0.5482 -1.8160 -0.7607 0.3179 1.0022 2377
## Avg_Canopy_Cover 1.2419 0.4966 0.3375 1.2219 2.2796 1.0033 2435
## Avg_Cogongrass_Cover -0.3661 0.5526 -1.4687 -0.3639 0.7193 1.0108 2315
## I(Avg_Cogongrass_Cover^2) 1.0368 0.5803 0.0391 0.9827 2.3422 1.0150 837
##
## Occurrence Variances (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat ESS
## (Intercept) 0.8989 0.8265 0.2015 0.6694 2.9521 1.0054 3698
## Avg_Canopy_Cover 0.9722 0.8977 0.2156 0.7167 3.2490 1.0043 2818
## Avg_Cogongrass_Cover 0.7428 0.8185 0.1756 0.5419 2.4482 1.0693 2451
## I(Avg_Cogongrass_Cover^2) 0.8073 0.8082 0.1821 0.5739 2.8942 1.0060 2149
##
## Occurrence Random Effect Variances (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat ESS
## Auth 0.8133 1.3594 0.0481 0.4104 3.9478 1.0211 654
##
## Detection Means (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat ESS
## (Intercept) -3.1493 0.3462 -3.8426 -3.1471 -2.4757 1.0034 1212
## shrub_cover -0.0018 0.3207 -0.6154 -0.0064 0.6503 1.0014 2470
## veg_height 0.0745 0.2632 -0.4562 0.0756 0.5952 1.0006 6617
##
## Detection Variances (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat ESS
## (Intercept) 0.5310 0.3619 0.1645 0.4355 1.4787 1.0008 3699
## shrub_cover 0.5152 0.3538 0.1615 0.4247 1.4162 1.0012 4564
## veg_height 0.4104 0.2476 0.1498 0.3466 1.0448 1.0009 8406
##
## Detection Random Effect Variances (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat ESS
## Auth 0.5207 0.4037 0.0838 0.4139 1.5705 1.0148 572
##
## ----------------------------------------
## Species Level
## ----------------------------------------
## Occurrence (logit scale):
## Mean SD 2.5% 50%
## (Intercept)-Canis_latrans -0.4660 0.6912 -1.8303 -0.4752
## (Intercept)-Procyon_lotor -0.0862 0.7409 -1.5058 -0.1034
## (Intercept)-Lynx_rufus -0.6505 0.8673 -2.2651 -0.6916
## (Intercept)-Didelphis_virginiana -1.4017 0.7559 -2.9510 -1.3741
## (Intercept)-Sylvilagus_floridanus -0.9053 0.7446 -2.3799 -0.9107
## (Intercept)-Meleagris_gallopavo -0.2615 0.8654 -1.8119 -0.3103
## (Intercept)-Sciurus_carolinensis -1.7707 0.8447 -3.5678 -1.7232
## Avg_Canopy_Cover-Canis_latrans 0.0784 0.4958 -0.8961 0.0728
## Avg_Canopy_Cover-Procyon_lotor 1.0063 0.5527 -0.0173 0.9833
## Avg_Canopy_Cover-Lynx_rufus 0.9436 0.7963 -0.4830 0.9075
## Avg_Canopy_Cover-Didelphis_virginiana 1.7191 0.7373 0.5383 1.6339
## Avg_Canopy_Cover-Sylvilagus_floridanus 2.1290 0.9494 0.6581 1.9994
## Avg_Canopy_Cover-Meleagris_gallopavo 1.5265 0.8454 0.0733 1.4542
## Avg_Canopy_Cover-Sciurus_carolinensis 1.7825 0.8227 0.5039 1.6637
## Avg_Cogongrass_Cover-Canis_latrans -0.0035 0.6764 -1.2835 -0.0237
## Avg_Cogongrass_Cover-Procyon_lotor -0.3587 0.7241 -1.7912 -0.3571
## Avg_Cogongrass_Cover-Lynx_rufus -0.5466 0.8256 -2.2564 -0.5154
## Avg_Cogongrass_Cover-Didelphis_virginiana 0.2585 0.8009 -1.2214 0.2180
## Avg_Cogongrass_Cover-Sylvilagus_floridanus -1.0162 0.8299 -2.7695 -0.9808
## Avg_Cogongrass_Cover-Meleagris_gallopavo -0.7046 0.9371 -2.6685 -0.6678
## Avg_Cogongrass_Cover-Sciurus_carolinensis -0.2794 0.7713 -1.8183 -0.2897
## I(Avg_Cogongrass_Cover^2)-Canis_latrans 1.6571 0.9244 0.1930 1.5432
## I(Avg_Cogongrass_Cover^2)-Procyon_lotor 1.5397 0.9757 0.1345 1.3458
## I(Avg_Cogongrass_Cover^2)-Lynx_rufus 1.4765 0.7530 0.2517 1.3950
## I(Avg_Cogongrass_Cover^2)-Didelphis_virginiana 0.5829 0.8167 -0.6295 0.4249
## I(Avg_Cogongrass_Cover^2)-Sylvilagus_floridanus 0.7873 0.6781 -0.3187 0.7057
## I(Avg_Cogongrass_Cover^2)-Meleagris_gallopavo 0.5148 1.0644 -1.2888 0.3727
## I(Avg_Cogongrass_Cover^2)-Sciurus_carolinensis 1.0495 0.6009 0.0265 0.9981
## 97.5% Rhat ESS
## (Intercept)-Canis_latrans 0.9342 1.0019 3316
## (Intercept)-Procyon_lotor 1.4503 1.0034 2798
## (Intercept)-Lynx_rufus 1.1852 1.0025 2115
## (Intercept)-Didelphis_virginiana -0.0039 1.0029 3297
## (Intercept)-Sylvilagus_floridanus 0.5713 1.0019 3358
## (Intercept)-Meleagris_gallopavo 1.5739 1.0003 2315
## (Intercept)-Sciurus_carolinensis -0.2196 1.0032 2713
## Avg_Canopy_Cover-Canis_latrans 1.0831 1.0018 6957
## Avg_Canopy_Cover-Procyon_lotor 2.1683 1.0000 5917
## Avg_Canopy_Cover-Lynx_rufus 2.6210 1.0018 2217
## Avg_Canopy_Cover-Didelphis_virginiana 3.4045 1.0036 2608
## Avg_Canopy_Cover-Sylvilagus_floridanus 4.3370 1.0014 1625
## Avg_Canopy_Cover-Meleagris_gallopavo 3.4171 1.0023 2597
## Avg_Canopy_Cover-Sciurus_carolinensis 3.7626 1.0036 2348
## Avg_Cogongrass_Cover-Canis_latrans 1.3948 1.0037 4629
## Avg_Cogongrass_Cover-Procyon_lotor 1.0770 1.0057 4020
## Avg_Cogongrass_Cover-Lynx_rufus 0.9980 1.0118 2837
## Avg_Cogongrass_Cover-Didelphis_virginiana 1.9157 1.0026 3431
## Avg_Cogongrass_Cover-Sylvilagus_floridanus 0.5409 1.0097 2709
## Avg_Cogongrass_Cover-Meleagris_gallopavo 0.9787 1.0125 1560
## Avg_Cogongrass_Cover-Sciurus_carolinensis 1.2396 1.0037 3382
## I(Avg_Cogongrass_Cover^2)-Canis_latrans 3.7729 1.0140 1630
## I(Avg_Cogongrass_Cover^2)-Procyon_lotor 3.9488 1.0113 1353
## I(Avg_Cogongrass_Cover^2)-Lynx_rufus 3.2257 1.0062 1586
## I(Avg_Cogongrass_Cover^2)-Didelphis_virginiana 2.6707 1.0019 884
## I(Avg_Cogongrass_Cover^2)-Sylvilagus_floridanus 2.3770 1.0051 1232
## I(Avg_Cogongrass_Cover^2)-Meleagris_gallopavo 2.8867 1.0201 627
## I(Avg_Cogongrass_Cover^2)-Sciurus_carolinensis 2.4103 1.0049 1787
##
## Detection (logit scale):
## Mean SD 2.5% 50% 97.5% Rhat
## (Intercept)-Canis_latrans -2.9518 0.3695 -3.7216 -2.9385 -2.2599 1.0043
## (Intercept)-Procyon_lotor -2.7460 0.4081 -3.6350 -2.7165 -2.0166 1.0179
## (Intercept)-Lynx_rufus -3.7852 0.4858 -4.7955 -3.7725 -2.8586 1.0073
## (Intercept)-Didelphis_virginiana -2.9990 0.4588 -3.9753 -2.9771 -2.1435 1.0052
## (Intercept)-Sylvilagus_floridanus -3.2478 0.4404 -4.1174 -3.2444 -2.3814 1.0011
## (Intercept)-Meleagris_gallopavo -3.8679 0.5275 -4.9310 -3.8599 -2.8619 1.0084
## (Intercept)-Sciurus_carolinensis -3.0645 0.4875 -4.0792 -3.0539 -2.1315 1.0071
## shrub_cover-Canis_latrans -0.2767 0.2230 -0.7209 -0.2765 0.1627 1.0005
## shrub_cover-Procyon_lotor 0.0623 0.1796 -0.2882 0.0632 0.4165 1.0013
## shrub_cover-Lynx_rufus -0.2775 0.3432 -0.9698 -0.2729 0.3849 1.0047
## shrub_cover-Didelphis_virginiana 0.5367 0.4986 -0.4133 0.5315 1.5163 1.0075
## shrub_cover-Sylvilagus_floridanus 0.1521 0.4846 -0.7776 0.1419 1.1171 1.0080
## shrub_cover-Meleagris_gallopavo -0.7280 0.3995 -1.5444 -0.7263 0.0555 1.0019
## shrub_cover-Sciurus_carolinensis 0.5210 0.5331 -0.5231 0.5273 1.5529 1.0028
## veg_height-Canis_latrans -0.6358 0.1891 -1.0185 -0.6333 -0.2723 1.0008
## veg_height-Procyon_lotor 0.4125 0.1297 0.1612 0.4122 0.6676 1.0009
## veg_height-Lynx_rufus 0.1118 0.2477 -0.4045 0.1198 0.5679 1.0041
## veg_height-Didelphis_virginiana 0.4486 0.2762 -0.0731 0.4422 1.0145 1.0001
## veg_height-Sylvilagus_floridanus 0.1961 0.2750 -0.3370 0.1923 0.7313 1.0095
## veg_height-Meleagris_gallopavo -0.2505 0.4133 -1.0878 -0.2430 0.5514 1.0117
## veg_height-Sciurus_carolinensis 0.2148 0.2367 -0.2422 0.2111 0.6832 1.0003
## ESS
## (Intercept)-Canis_latrans 921
## (Intercept)-Procyon_lotor 523
## (Intercept)-Lynx_rufus 682
## (Intercept)-Didelphis_virginiana 1343
## (Intercept)-Sylvilagus_floridanus 1130
## (Intercept)-Meleagris_gallopavo 909
## (Intercept)-Sciurus_carolinensis 1276
## shrub_cover-Canis_latrans 4075
## shrub_cover-Procyon_lotor 3514
## shrub_cover-Lynx_rufus 2279
## shrub_cover-Didelphis_virginiana 1203
## shrub_cover-Sylvilagus_floridanus 1482
## shrub_cover-Meleagris_gallopavo 1424
## shrub_cover-Sciurus_carolinensis 1280
## veg_height-Canis_latrans 3581
## veg_height-Procyon_lotor 6808
## veg_height-Lynx_rufus 3149
## veg_height-Didelphis_virginiana 3006
## veg_height-Sylvilagus_floridanus 2277
## veg_height-Meleagris_gallopavo 1476
## veg_height-Sciurus_carolinensis 3723
names(ms_cover_canopyQ)
## [1] "rhat" "beta.comm.samples" "alpha.comm.samples"
## [4] "tau.sq.beta.samples" "tau.sq.alpha.samples" "beta.samples"
## [7] "alpha.samples" "z.samples" "psi.samples"
## [10] "like.samples" "sigma.sq.p.samples" "alpha.star.samples"
## [13] "p.re.level.names" "sigma.sq.psi.samples" "beta.star.samples"
## [16] "re.level.names" "ESS" "X"
## [19] "X.p" "X.p.re" "X.re"
## [22] "y" "call" "n.samples"
## [25] "x.names" "sp.names" "x.p.names"
## [28] "n.post" "n.thin" "n.burn"
## [31] "n.chains" "pRE" "psiRE"
## [34] "run.time"
str(ms_cover_canopyQ$beta.samples)
## 'mcmc' num [1:14000, 1:28] -0.0765 -0.687 -1.0601 0.1264 -0.1138 ...
## - attr(*, "mcpar")= num [1:3] 1 14000 1
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:28] "(Intercept)-Canis_latrans" "(Intercept)-Procyon_lotor" "(Intercept)-Lynx_rufus" "(Intercept)-Didelphis_virginiana" ...
mean(ms_cover_canopyQ$beta.samples[, 5] > 0)
## [1] 0.1056429
MCMCplot(ms_cover_canopyQ$beta.samples, ref_ovl = TRUE, ci = c(50, 95)) # Occupancy

MCMCplot(ms_cover_canopyQ$alpha.samples, ref_ovl = TRUE, ci = c(50, 95)) # Detection

## Occupancy
# Total number of parameters
n_params <- ncol(ms_cover_canopyQ$beta.samples)
# Number of parameters to plot at a time
chunk_size <- 10
# Split and plot
for (i in seq(1, n_params, by = chunk_size)) {
end <- min(i + chunk_size - 1, n_params)
param_names <- colnames(ms_cover_canopyQ$beta.samples)[i:end]
# Set filename
file_name <- paste0("MCMCplot_Occupancy_Params_", i, "_to_", end, ".png")
# Save plot to PNG
png(filename = file_name, width = 1200, height = 800, res = 150)
MCMCplot(ms_cover_canopyQ$beta.samples[, param_names],
ref_ovl = TRUE,
ci = c(50, 95),
main = paste0("Occupancy Parameters: ", i, " to ", end))
dev.off()
}
## Detection
# Number of parameters
n_params <- ncol(ms_cover_canopyQ$alpha.samples)
# Number of parameters to plot at a time
chunk_size <- 10
# Split and plot
for (i in seq(1, n_params, by = chunk_size)) {
end <- min(i + chunk_size - 1, n_params)
param_names <- colnames(ms_cover_canopyQ$alpha.samples)[i:end]
# Set filename
file_name <- paste0("MCMCplot_Detection_Params_", i, "_to_", end, ".png")
# Save plot to PNG
png(filename = file_name, width = 1200, height = 800, res = 150)
MCMCplot(ms_cover_canopyQ$alpha.samples[, param_names, drop = FALSE],
ref_ovl = TRUE,
ci = c(50, 95),
main = paste0("Detection Parameters: ", i, " to ", end))
dev.off()
}
Facet Plots
plot_mcmc_faceted_groups <- function(samples_matrix,
chunk_size = 8,
title_text = "Parameters",
pd_cutoff = 0.95) {
param_names <- colnames(samples_matrix)
df <- as.data.frame(samples_matrix)
df$Iteration <- 1:nrow(df)
df_long <- df %>%
pivot_longer(-Iteration,
names_to = "Parameter",
values_to = "Value") %>%
mutate(
ParamIndex = match(Parameter, param_names),
Group = ceiling(ParamIndex / chunk_size)
)
# Posterior summaries + probability of direction
summary_df <- df_long %>%
group_by(Parameter, Group) %>%
summarise(
mean = mean(Value),
l95 = quantile(Value, 0.025),
u95 = quantile(Value, 0.975),
l50 = quantile(Value, 0.25),
u50 = quantile(Value, 0.75),
pd = max(mean(Value > 0), mean(Value < 0)),
.groups = "drop"
) %>%
mutate(
Credible = pd >= pd_cutoff
)
summary_df <- summary_df %>%
group_by(Group) %>%
mutate(Parameter = factor(Parameter,
levels = rev(unique(Parameter)))) %>%
ungroup()
ggplot(summary_df,
aes(x = mean, y = Parameter)) +
geom_vline(xintercept = 0, linetype = "dashed") +
# 95% CI
geom_errorbarh(aes(xmin = l95,
xmax = u95,
size = Credible),
height = 0) +
# 50% CI
geom_errorbarh(aes(xmin = l50,
xmax = u50,
size = Credible),
height = 0) +
# Posterior mean
geom_point(aes(fill = Credible),
shape = 21,
size = 3,
stroke = 1) +
facet_wrap(~Group, scales = "free_y", ncol = 2) +
scale_size_manual(values = c("TRUE" = 1.2,
"FALSE" = 0.5),
guide = "none") +
scale_fill_manual(values = c("TRUE" = "black",
"FALSE" = "white"),
guide = "none") +
labs(x = "Parameter Estimate",
y = "",
title = title_text) +
theme_bw() +
theme(
strip.background = element_blank(),
strip.text = element_blank(),
axis.text.y = element_text(size = 10)
)
}
plot_mcmc_faceted_groups(
ms_cover_canopyQ$beta.samples,
chunk_size = 8,
title_text = "",
pd_cutoff = 0.95
)
## Warning: `geom_errobarh()` was deprecated in ggplot2 4.0.0.
## ℹ Please use the `orientation` argument of `geom_errorbar()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggplot2 package.
## Please report the issue at <https://github.com/tidyverse/ggplot2/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `height` was translated to `width`.
## `height` was translated to `width`.

ggsave("mcmc_faceted_groups_occupancy.png",
width = 10, height = 8, dpi = 300)
## `height` was translated to `width`.
## `height` was translated to `width`.
plot_mcmc_faceted_groups(
ms_cover_canopyQ$alpha.samples,
chunk_size = 8,
title_text = "",
pd_cutoff = 0.95
)
## `height` was translated to `width`.
## `height` was translated to `width`.

ggsave("mcmc_faceted_groups_detection.png",
width = 10, height = 8, dpi = 300)
## `height` was translated to `width`.
## `height` was translated to `width`.
Plot Species level relationship with cogongrass cover
# Collecting scaled atrributes
cogon.mean <- attr(covariates_matrix, "scaled:center")["Avg_Cogongrass_Cover"]
cogon.sd <- attr(covariates_matrix, "scaled:scale")["Avg_Cogongrass_Cover"]
cogon.mean <- mean(CameraLoc$Avg_Cogongrass_Cover)
cogon.sd <- sd(CameraLoc$Avg_Cogongrass_Cover)
# Unscaled prediction values
cogon.pred.vals <- seq(0, 100, length.out = 100)
# Scale prediction values
cogon.pred.scale <- (cogon.pred.vals - cogon.mean) / cogon.sd
cogon.pred.scale2 <- cogon.pred.scale^2
canopy.mean <- attr(covariates_matrix, "scaled:center")["Avg_Canopy_Cover"]
canopy.sd <- attr(covariates_matrix, "scaled:scale")["Avg_Canopy_Cover"]
pred.df <- as.matrix(data.frame(
intercept = 1,
Avg_Cogongrass_Cover = cogon.pred.scale,
I.Avg_Cogongrass_Cover.2. = cogon.pred.scale2,
Avg_Canopy_Cover = 0
))
out.pred <- predict(
ms_cover_canopyQ,
X.0 = pred.df,
ignore.RE = TRUE
)
# Extract the species-specific betas for Coyote
coyote_index <- which(ms_cover_canopyQ$sp.names == "Canis_latrans")
# Get column indices for the parameters we need
intercept_col <- paste0("(Intercept)-", "Canis_latrans")
cogon_col <- paste0("Avg_Cogongrass_Cover-", "Canis_latrans")
cogon2_col <- paste0("I(Avg_Cogongrass_Cover^2)-", "Canis_latrans")
canopy_col <- paste0("Avg_Canopy_Cover-", "Canis_latrans")
# Extract posterior samples for each coefficient
beta_intercept <- ms_cover_canopyQ$beta.samples[, intercept_col]
beta_cogon <- ms_cover_canopyQ$beta.samples[, cogon_col]
beta_cogon2 <- ms_cover_canopyQ$beta.samples[, cogon2_col]
beta_canopy <- ms_cover_canopyQ$beta.samples[, canopy_col]
# Create prediction gradient (0 to 100%)
cogon.pred.vals <- seq(0, 100, length.out = 1000)
# Scale using same transformation
cogon.pred.scale <- (cogon.pred.vals - cogon.mean) / cogon.sd
cogon.pred.scale2 <- cogon.pred.scale^2
n_samples <- nrow(ms_cover_canopyQ$beta.samples)
n_pred <- length(cogon.pred.vals)
logit_psi <- matrix(NA, nrow = n_samples, ncol = n_pred)
for(i in 1:n_samples) {
logit_psi[i, ] <- beta_intercept[i] +
beta_cogon[i] * cogon.pred.scale +
beta_cogon2[i] * cogon.pred.scale2 +
beta_canopy[i] * 0 # Setting to mean (0 on scaled)
}
# Convert to probability scale
psi_samples <- plogis(logit_psi)
# Calculate quantiles across MCMC samples for each prediction point
psi.coyote.quants <- apply(psi_samples, 2, quantile,
probs = c(0.025, 0.5, 0.975))
psi.coyote.dat <- data.frame(
Avg_Cogongrass_Cover = cogon.pred.vals,
psi.low = psi.coyote.quants[1, ],
psi.med = psi.coyote.quants[2, ],
psi.high = psi.coyote.quants[3, ]
)
ggplot(psi.coyote.dat, aes(x = Avg_Cogongrass_Cover, y = psi.med)) +
geom_ribbon(aes(ymin = psi.low, ymax = psi.high), fill = "grey70", alpha = 0.5) +
geom_line(size = 1.2) +
theme_bw() +
labs(x = "Average Cogongrass Cover (%)",
y = "Occupancy Probability (Canis latrans)") +
scale_y_continuous(limits = c(0, 1)) +
scale_x_continuous(limits = c(0, 100))

summary(psi.coyote.dat)
## Avg_Cogongrass_Cover psi.low psi.med psi.high
## Min. : 0 Min. :0.1381 Min. :0.3829 Min. :0.7081
## 1st Qu.: 25 1st Qu.:0.2315 1st Qu.:0.5509 1st Qu.:0.8618
## Median : 50 Median :0.6187 Median :0.9931 Median :1.0000
## Mean : 50 Mean :0.5836 Mean :0.8158 Mean :0.9333
## 3rd Qu.: 75 3rd Qu.:0.9260 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :100 Max. :0.9937 Max. :1.0000 Max. :1.0000
Species Lookup
SpeciesLookup <- tibble::tribble(
~Name, ~Scientific_Name, ~Common_Name,
"Canis_latrans", "Canis latrans", "Coyote",
"Didelphis_virginiana", "Didelphis virginiana", "Virginia Opossum",
"Procyon_lotor", "Procyon lotor", "Raccoon",
"Lynx_rufus", "Lynx rufus", "Bobcat",
"Meleagris_gallopavo", "Meleagris gallopavo", "Wild Turkey",
"Sciurus_carolinensis", "Sciurus carolinensis", "Eastern Gray Squirrel",
"Sylvilagus_floridanus", "Sylvilagus floridanus", "Eastern Cottontail Rabbit",
)
Varying cogongrass and canopy cover
# Prediction gradient for cogongrass
cogon.pred.vals <- seq(0, 100, length.out = 1000)
cogon.pred.scale <- (cogon.pred.vals - cogon.mean) / cogon.sd
cogon.pred.scale2 <- cogon.pred.scale^2
# Define canopy cover scenarios with factor levels
canopy_scenarios <- data.frame(
scenario = factor(c("Low", "Average", "High"),
levels = c("Low", "Average", "High")),
canopy_scaled = c(-1, 0, 1),
color = c("#D55E00", "#009E73", "#0072B2")
)
n_samples <- nrow(ms_cover_canopyQ$beta.samples)
n_pred <- length(cogon.pred.vals)
# Lists for results
species_predictions <- list()
species_plots <- list()
# Loop through all species
for(sp in ms_cover_canopyQ$sp.names) {
# Get column names for this species
intercept_col <- paste0("(Intercept)-", sp)
cogon_col <- paste0("Avg_Cogongrass_Cover-", sp)
cogon2_col <- paste0("I(Avg_Cogongrass_Cover^2)-", sp)
canopy_col <- paste0("Avg_Canopy_Cover-", sp)
# Extract posterior samples
beta_intercept <- ms_cover_canopyQ$beta.samples[, intercept_col]
beta_cogon <- ms_cover_canopyQ$beta.samples[, cogon_col]
beta_cogon2 <- ms_cover_canopyQ$beta.samples[, cogon2_col]
beta_canopy <- ms_cover_canopyQ$beta.samples[, canopy_col]
# Store predictions for each canopy scenario
scenario_predictions <- list()
for(j in 1:nrow(canopy_scenarios)) {
canopy_val <- canopy_scenarios$canopy_scaled[j]
# Calculate linear predictor
logit_psi <- matrix(NA, nrow = n_samples, ncol = n_pred)
for(i in 1:n_samples) {
logit_psi[i, ] <- beta_intercept[i] +
beta_cogon[i] * cogon.pred.scale +
beta_cogon2[i] * cogon.pred.scale2 +
beta_canopy[i] * canopy_val
}
# Convert to probability
psi_samples <- plogis(logit_psi)
# Calculate quantiles
psi.quants <- apply(psi_samples, 2, quantile, probs = c(0.025, 0.5, 0.975))
# Store results
scenario_predictions[[j]] <- data.frame(
species = sp,
scenario = canopy_scenarios$scenario[j],
Avg_Cogongrass_Cover = cogon.pred.vals,
psi.low = psi.quants[1, ],
psi.med = psi.quants[2, ],
psi.high = psi.quants[3, ]
)
}
# Combine all scenarios for this species
species_predictions[[sp]] <- do.call(rbind, scenario_predictions)
all_predictions <- all_predictions %>%
left_join(SpeciesLookup, by = c("species" = "Name"))
# Create plot for this species
species_plots[[sp]] <- ggplot(species_predictions[[sp]],
aes(x = Avg_Cogongrass_Cover, y = psi.med,
color = scenario, fill = scenario)) +
geom_ribbon(aes(ymin = psi.low, ymax = psi.high), alpha = 0.2, color = NA) +
geom_line(size = 1.2) +
scale_color_manual(values = canopy_scenarios$color) +
scale_fill_manual(values = canopy_scenarios$color) +
theme_bw() +
labs(x = "Average Cogongrass Cover (%)",
y = "Occupancy Probability",
title = gsub("_", " ", sp),
color = "Canopy Cover",
fill = "Canopy Cover") +
scale_y_continuous(limits = c(0, 1)) +
scale_x_continuous(limits = c(0, 100)) +
theme(legend.position = "bottom")
}
# View individual plots
species_plots[["Canis_latrans"]]

species_plots[["Procyon_lotor"]]

# Combine all plots into a grid
all_species_plot <- wrap_plots(species_plots, ncol = 2, guides = "collect") &
theme(legend.position = "bottom")
all_species_plot

ggsave("all_species_cogongrass_canopy.png",
all_species_plot,
width = 14, height = 16, dpi = 300)
# Combine all predictions into one dataframe
all_predictions <- do.call(rbind, species_predictions)
all_predictions <- all_predictions %>%
left_join(
SpeciesLookup %>% dplyr::select(Name, Common_Name),
by = c("species" = "Name")
)
all_predictions$scenario <- factor(all_predictions$scenario,
levels = c("Low", "Average", "High"))
# Create faceted plot
faceted_plot <- ggplot(all_predictions,
aes(x = Avg_Cogongrass_Cover, y = psi.med,
color = scenario, fill = scenario)) +
geom_ribbon(aes(ymin = psi.low, ymax = psi.high), alpha = 0.2, color = NA) +
geom_line(size = 1.2) +
facet_wrap(~ Common_Name, ncol = 2) +
scale_color_manual(values = canopy_scenarios$color) +
scale_fill_manual(values = canopy_scenarios$color) +
theme_bw() +
labs(x = "Average Cogongrass Cover (%)",
y = "Occupancy Probability",
color = "Canopy Cover",
fill = "Canopy Cover") +
scale_y_continuous(limits = c(0, 1)) +
scale_x_continuous(limits = c(0, 100)) +
theme(strip.text = element_text(face = "bold"),
legend.position = "bottom")
faceted_plot

ggsave("all_species_faceted_canopy.png",
faceted_plot,
width = 12, height = 14, dpi = 600)
Community Occupancy Plot- Cogongrass and Canopy Cover
# Prediction gradient for cogongrass
cogon.pred.vals <- seq(0, 100, length.out = 1000)
cogon.pred.scale <- (cogon.pred.vals - cogon.mean) / cogon.sd
cogon.pred.scale2 <- cogon.pred.scale^2
# Define canopy cover scenarios
canopy_scenarios <- data.frame(
scenario = c("Low", "Average", "High"),
canopy_scaled = c(-1, 0, 1),
color = c("#D55E00", "#009E73", "#0072B2")
)
n_pred <- length(cogon.pred.vals)
# Get community-level parameters
comm_intercept <- ms_cover_canopyQ$beta.comm.samples[, "(Intercept)"]
comm_cogon <- ms_cover_canopyQ$beta.comm.samples[, "Avg_Cogongrass_Cover"]
comm_cogon2 <- ms_cover_canopyQ$beta.comm.samples[, "I(Avg_Cogongrass_Cover^2)"]
comm_canopy <- ms_cover_canopyQ$beta.comm.samples[, "Avg_Canopy_Cover"]
# Store predictions for each canopy scenario
community_predictions <- list()
for(j in 1:nrow(canopy_scenarios)) {
canopy_val <- canopy_scenarios$canopy_scaled[j]
# Calculate linear predictor
logit_psi_comm <- matrix(NA,
nrow = nrow(ms_cover_canopyQ$beta.comm.samples),
ncol = n_pred)
for(i in 1:nrow(ms_cover_canopyQ$beta.comm.samples)) {
logit_psi_comm[i, ] <- comm_intercept[i] +
comm_cogon[i] * cogon.pred.scale +
comm_cogon2[i] * cogon.pred.scale2 +
comm_canopy[i] * canopy_val
}
# Convert to probability
psi_comm_samples <- plogis(logit_psi_comm)
# Calculate quantiles
psi.comm.quants <- apply(psi_comm_samples, 2, quantile,
probs = c(0.025, 0.5, 0.975))
# Store results
community_predictions[[j]] <- data.frame(
scenario = canopy_scenarios$scenario[j],
Avg_Cogongrass_Cover = cogon.pred.vals,
psi.low = psi.comm.quants[1, ],
psi.med = psi.comm.quants[2, ],
psi.high = psi.comm.quants[3, ]
)
}
# Combine all scenarios
psi.comm.dat <- do.call(rbind, community_predictions)
# Reorder the scenario factor levels
psi.comm.dat$scenario <- factor(psi.comm.dat$scenario,
levels = c("Low", "Average", "High"))
community_plot <- ggplot(psi.comm.dat,
aes(x = Avg_Cogongrass_Cover, y = psi.med,
color = scenario, fill = scenario)) +
geom_ribbon(aes(ymin = psi.low, ymax = psi.high), alpha = 0.2, color = NA) +
geom_line(size = 1.5) +
scale_color_manual(values = canopy_scenarios$color) +
scale_fill_manual(values = canopy_scenarios$color) +
theme_bw(base_size = 14) +
labs(x = "Average Cogongrass Cover (%)",
y = "Community Occupancy Probability",
color = "Canopy Cover",
fill = "Canopy Cover") +
scale_y_continuous(limits = c(0, 1)) +
scale_x_continuous(limits = c(0, 100)) +
theme(legend.position = "bottom",
plot.title = element_text(hjust = 0.5))
community_plot

ggsave("community_cogongrass_canopy.png",
community_plot,
width = 10, height = 7, dpi = 300)
write.csv(psi.comm.dat, "community_predictions_by_canopy.csv", row.names = FALSE)