# Prepare data and Working Environment ------

#load required libraries 
library(mgcv) #Generalized additive modeling 
library(gratia) #GAM model evaluation 
library(parallel) #parallel computation 
library(doSNOW) #parallel computation 
library(foreach) #parallel computation 
library(progress) #progress tracking on computations
library(Boruta) #Feature selection algorithm
library(caret) #Machine learning and classification performance metrics
library(RColorBrewer) #Color sets for plotting
library(ggpubr) #publication quality plotting themes
library(patchwork) #tools for generating multipanel figures
library(tidyverse) # data management, processing, and visualization 

#set working directory
data.dir <- "C:/Users/as.romer/OneDrive - University of Florida/Documents/PEP_ASR/data"
fig.dir <- "C:/Users/as.romer/OneDrive - University of Florida/Documents/PEP_ASR/figures"
setwd(data.dir)

# Load PEP (Python Elimination Program // SFWMD) data
PEP <- read.csv('PEP_with_MET.csv', stringsAsFactors = T)

# Clean and format data 
PEP <- PEP %>% 
  select(-c(1)) %>% #Remove indexing column
  #format existing data 
  mutate(date = ymd(date), #format dates as date
         julian = yday(date), #convert dates to Julian date
         month.n = month, #keep numeric month vector 
         month = fct_inseq(factor(month)), #generate factor month vector 
         week = week(date), #generate week vector
         year.n = year, #keep numeric year vector 
         year = fct_inseq(factor(year)), #generate factor year vector 
         survey_type = coalesce(other_type,survey_type), #coalesce survey type data into one column
         capture.f = factor(ifelse(snakes > 0, 1, 0), levels = c("0", "1")), #binary removal factor
         capture = as.numeric(capture.f)-1, #binary numeric for removal
         baro.change = factor(ifelse(baro.diff > 0, "pos", ifelse(baro.diff == 0, "same", "neg")), levels = c("same", "pos", "neg"))
  ) %>% 
  #drop now extraneous survey type column 
  select(-other_type) %>% 
  #format survey start and end times 
  mutate(across(.cols = c(StartSurvey, EndSurvey), .fns = ~as.POSIXct(.x, format="%Y-%m-%d %H:%M:%S", tz="UTC")), # load as UTC so times aren't changed
         across(.cols = c(StartSurvey, EndSurvey), .fns = ~force_tz(.x, tzone="America/New_York")),
         RPUE = snakes/survey_hr) # convert to ET 

#Filter data 
PEP <- PEP %>% filter(rapid_response == "No") %>% # no rapid response
  filter(leader_or_assistant == "Leader") %>%  #leader surveys only
  filter(date >"2020-05-26" & date <"2022-05-01") %>% # date range associated with PEP3
  # keep only records with no NA in environmental variables
  drop_na(c("radt.kwm2", "humi.perc", "airt.c", "rain.mm", "etp.mm",
            "wnds.mph","baro.mm", "baro.diff"))

# 1. Perform feature importance for RPUE and POR -----

# Run feature importance for RPUE
RPUE.Boruta <- PEP %>%
  select(-c(snake_IDs, QC_Recon_Notes, Survey123_End1, snakes, capture,
            StartSurvey, start_time, Survey123_Start1, EndSurvey, date,
            end_time, month, Survey123_Start2, Survey123_End2, Survey123_Start3,
            Survey123_End3, capture.f)) %>% 
  Boruta(RPUE ~ ., data = ., doTrace = 2, maxRuns = 50)
# Plot Algorithm results 
plot(RPUE.Boruta) 
# Get dataframe of attribute statistics 
attStats(RPUE.Boruta) %>%
  as.data.frame() %>%
  filter(decision != "Rejected") %>% 
  rownames_to_column("var") %>% 
  select(var, decision, meanImp) %>% 
  arrange(desc(meanImp)) -> RPUE.Boruta.dat
print(RPUE.Boruta.dat)

# Run feature importance for POR
POR.Boruta <- PEP %>%
  select(-c(snake_IDs, QC_Recon_Notes, Survey123_End1, snakes, capture.f,
            StartSurvey, start_time, Survey123_Start1, EndSurvey, date,
            end_time, month, Survey123_Start2, Survey123_End2, Survey123_Start3,
            Survey123_End3, RPUE)) %>% 
  Boruta(capture ~ ., data = ., doTrace = 2, maxRuns = 50)
# Plot Algorithm results 
plot(POR.Boruta) 
# Get dataframe of attribute statistics 
attStats(POR.Boruta) %>%
  as.data.frame() %>%
  filter(decision != "Rejected") %>% 
  rownames_to_column("var") %>% 
  select(var, decision, meanImp) %>% 
  arrange(desc(meanImp)) -> POR.Boruta.dat
print(POR.Boruta.dat)

# 2. Generate and evaluate GAM model for POR -----

# Set model formula 
por.form <- capture ~ season2 +
  s(airt.c, bs = 'ts') +
  s(julian, bs = 'cc') +
  ti(julian, airt.c, bs = c('cc', 'ts')) +
  te(start_minutes, survey_hr, bs = c('cc', 'ts')) +
  ti(start_minutes, survey_hr, airt.c, bs = c('cc', 'ts', 'ts')) +
  s(baro.diff, by = season2, bs = 'ts') +
  s(wnds.mph, bs = 'ts') +
  s(radt.kwm2, bs = 'ts') +
  s(etp.mm, bs = 'ts') +
  s(humi.perc, bs = 'ts') +
  s(baro.mm, bs = 'ts') +
  s(rain.mm, bs = 'ts') +
  te(illum_start, illum_end, bs = c('ts', 'ts')) +
  s(moon_start4, bs = 're') +
  s(year, bs = 're') +
  s(station1, station2, station3, bs = 're') +
  s(contractor, bs = 're') +
  s(alone_or_assist, bs = 're') +
  s(PATRIC_property_equiv, bs = 're') +
  s(survey_type, bs = 're')

#set knots for cubic cyclic splines 
por.form.knots <- list(julian=c(0.5, 366.5),
                       end_minutes=c(-0.5, 1439.5),
                       start_minutes=c(-0.5, 1439.5))

#Implement GAM model via bam (large datasets) function 
set.seed(123)
bam(formula = por.form,
    knots = por.form.knots, 
    data = PEP, 
    family = binomial(link = "logit"),
    discrete = T,
    nthreads = 7,
    select = T
) -> por.mod
round(AIC(por.mod)) #3769

# Ensure sufficient complexity was allocated to splines 
k.check(por.mod) %>%
  as.data.frame() %>%
  arrange(`p-value`) %>%
  filter(`p-value` < 0.1) %>% 
  rownames_to_column('smooth') %>% 
  select(c(1:3)) %>% 
  mutate(edf = round(edf, 1)) 

# Look at model diagnostics and fit 
gratia::appraise(por.mod, method = "simulate", type = "response") #Overall looks good

#check dispersion parameter
sum(residuals(por.mod, type="pearson")^2)/df.residual(por.mod) #looks good 👍

#results are essentially congruent with RPUE model 
(summary(por.mod) -> por.mod.sum)

#Not bad accuracy: 80.1% 
caret::confusionMatrix(data = factor(round(predict(por.mod, type = "response"))),
                       reference = PEP$capture.f,
                       positive = "1") 

# 3. Conduct Permutation test of POR model accuracy ----

# Calculate POR model accuracy with model predictions
predictions <- factor(round(predict(por.mod, type = "response")))
observed_accuracy <- confusionMatrix(data = predictions, reference = PEP$capture.f)$overall['Accuracy']

# Calculate proportions of captures in actual data
actual_dist <- table(PEP$capture)
prop_zeros <- actual_dist[1] / sum(actual_dist)
prop_ones <- actual_dist[2] / sum(actual_dist)

# Perform permutation test
n_permutations <- 1e4
permuted_accuracies_model <- numeric(n_permutations)
permuted_accuracies_actual <- numeric(n_permutations)

# Set up progress bar
pb <- txtProgressBar(min = 0, max = n_permutations, style = 3)

# Begin permutation test: shuffle predictions to create a distribution of accuracies
# for both model-predicted and actual class distributions. This will allow us to
# compare the model's accuracy to what might be expected by chance, given the
# distribution of the classes.
for(i in 1:n_permutations) {
  # Shuffle predictions keeping original proportions
  shuffled_predictions_model <- sample(predictions)
  shuffled_predictions_actual <- sample(c(rep(0, length(predictions) * prop_zeros), rep(1, length(predictions) * prop_ones)))
  
  # Calculate accuracy for both model and actual distributions
  permuted_accuracy_model <- MLmetrics::Accuracy(y_pred = factor(shuffled_predictions_model), y_true = PEP$capture.f)
  permuted_accuracy_actual <- MLmetrics::Accuracy(y_pred = factor(shuffled_predictions_actual), y_true = PEP$capture.f)
  
  # Store accuracies
  permuted_accuracies_model[i] <- permuted_accuracy_model
  permuted_accuracies_actual[i] <- permuted_accuracy_actual
  
  # Update progress bar
  setTxtProgressBar(pb, i)
}


# Close progress bar
close(pb)

# Calculate p-values
p_value_model <- sum(permuted_accuracies_model >= observed_accuracy) / n_permutations
p_value_actual <- sum(permuted_accuracies_actual >= observed_accuracy) / n_permutations

# Adjust p-values for display
p_value_model_display <- ifelse(p_value_model == 0, sprintf("< %.e", 1/n_permutations), p_value_model)
p_value_actual_display <- ifelse(p_value_actual == 0, sprintf("< %.e", 1/n_permutations), p_value_actual)

# Print p-values
cat("P-value for model-predicted class distribution:", p_value_model_display, "\n")
cat("P-value for actual class distribution:", p_value_actual_display, "\n")

# Combine data for plotting
data_for_plot <- data.frame(
  Accuracy = c(permuted_accuracies_model, permuted_accuracies_actual),
  Type = rep(c("Model", "Actual"), each = n_permutations)
)

# Plot using ggplot2 with proportion on the y-axis
(ggplot(data_for_plot, aes(x = Accuracy, y = after_stat(count / max(count)), fill = Type)) +
    geom_histogram(bins = 50, color = "black", linewidth = 0.5) +
    geom_vline(aes(xintercept = observed_accuracy), color = "black", linetype = "longdash", linewidth = 0.75) +
    annotate(geom = "text", x = 0.655, y = 0.7, label = paste('p', p_value_actual_display), size = 6) +
    annotate(geom = "text", x = 0.72, y = 0.95, label = paste('p', p_value_model_display), size = 6) +
    annotate(geom = "text", x = 0.75, y = 0.275, label = paste0("Accuracy = ", round(confusionMatrix(data = predictions, reference = PEP$capture.f)$overall['Accuracy']*100,1), "%\n",
                                                               "Sensitivity = ", round(confusionMatrix(data = predictions, reference = PEP$capture.f, positive = '1')$byClass['Specificity']*100,1), "%\n",
                                                               "Specificity = ", round(confusionMatrix(data = predictions, reference = PEP$capture.f, positive = '1')$byClass['Sensitivity']*100,1), "%"),
             hjust = 0, size = 6) +
    scale_y_continuous(expand = c(0,0),
                       labels = scales::percent) +
    scale_x_continuous(labels = scales::percent) +
    scale_fill_brewer(palette = "Paired", direction = -1) +
    theme_classic2() +
    theme(axis.title.y = element_text(margin = margin(r = 20, l = 2.5)),
          axis.title.x = element_text(margin = margin(t = 10, b = 2.5)),
          axis.title = element_text(size = 16),
          axis.text = element_text(size = 14, color = "black"),
          plot.tag = element_text(face = "bold", size = 18),
          plot.tag.position = c(0, 1.0625),
          plot.margin = margin(t = 25, rep(10, 3)),
          legend.text = element_text(size = 14),
          legend.title = element_text(size = 16),
          legend.position = c(0.7675, 0.8)) +
    labs(y = "Proportion",
         fill = "Class\nDistribution") -> por_acc_fig)

#Render high resolution PNG of plot
# ggsave(filename = "POR_perm.PNG", path = fig.dir, por_acc_fig, dpi = 320, width = 8, height = 5)


# 4. Generate figures for univariate POR terms ----

#get names of significant smooths
(por.mod.sum$s.table %>% 
   as.data.frame() %>% 
   filter(`p-value` < .05) %>% 
   rownames_to_column('smooths') %>% 
   pull('smooths') -> por.sig.smooths)

#
# Start with intuitive 1-d results #
#

#Generate function to scale smooth estimate to response term
scaled_smooth_estimates <- function(object, smooth, data = NULL, n = 100){
  #pipe to scale smooth estimates to response
  smooth_estimates(object, smooth = smooth, data = data, n = n) %>%
    add_constant(coef(object)[1]) %>% 
    add_confint() %>% 
    transform_fun(inv_link(object)) -> return.dat
  #return data from function  
  return(return.dat)
}

#Generate function to return rounded p-value for a specified smooth
getpval <- function(object, smooth){
  object$s.table %>% 
    as.data.frame() %>% 
    rownames_to_column('smths') %>% 
    filter(smths == smooth) %>% 
    pull(`p-value`) %>% 
    signif(2) -> pval 
  
  if(pval == 0){
    "p < 2e-16" -> pval
  } else { 
    paste('p =', pval) -> pval
  } 
  return(pval)
}

#Set plotting theme
univariate_theme <- theme_classic2() + 
    theme(axis.title.y = element_text(margin = margin(r = 20, l = 2.5)),
          axis.title.x = element_text(margin = margin(t = 10, b = 2.5)),
          axis.title = element_text(size = 16),
          axis.text = element_text(size = 14, color = "black"),
          plot.tag = element_text(face = "bold", size = 18),
          plot.tag.position = c(0, 1.0625),
          plot.margin = margin(t = 25, rep(10, 3)))

#Plot effect of air temperature  
#get distribution from PEP data 
hist.dat.airtc <- PEP %>% 
  mutate(airt.c = (airt.c %/% 1)*1) %>%
  group_by(airt.c) %>% 
  summarize(n = n()/nrow(PEP)) %>%
  ungroup()
#generate plot with model predictions and observed conditions 
scaled_smooth_estimates(por.mod, "s(airt.c)") %>% 
  ggplot(aes(x = airt.c)) + 
  geom_bar(data = hist.dat.airtc, aes(x = airt.c, y = n), stat = "identity", color = "black", fill = "white", width = 1) +
  geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci), alpha = 0.25) +
  geom_line(aes(y = est), linewidth = 0.75) +
  geom_line(aes(y = lower_ci), lty = "dashed", linewidth = 0.6) +
  geom_line(aes(y = upper_ci), lty = "dashed", linewidth = 0.6) +
  annotate(geom="text", x=14, y=0.75, label = getpval(por.mod.sum, "s(airt.c)"), size = 6) +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(n.breaks = 8) +
  univariate_theme +
  labs(y = "Probability of Removal",
       x = "Air Temperature (°C)") -> por_f1

#Plot Effect of day of year
#
#get distribution from PEP data 
hist.dat.julian <- PEP %>% 
  mutate(julian = (julian %/% 14)*14) %>%
  group_by(julian) %>% 
  summarize(n = n()/nrow(PEP)) %>%
  ungroup() 
#generate plot with model predictions and observed conditions 
scaled_smooth_estimates(por.mod, "s(julian)") %>% 
  ggplot(aes(x = julian)) + 
  geom_bar(data = hist.dat.julian, aes(x = julian, y = n), stat = "identity", color = "black", fill = "white", width = 14) +
  geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci), alpha = 0.25) +
  geom_line(aes(y = est), linewidth = 0.75) +
  geom_line(aes(y = lower_ci), lty = "dashed", linewidth = 0.6) +
  geom_line(aes(y = upper_ci), lty = "dashed", linewidth = 0.6) +
  annotate(geom="text", x=75, y=0.45, label = getpval(por.mod.sum, "s(julian)"), size = 6) +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(breaks = c(1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335),
                     labels = month.abb) +
  univariate_theme +
  theme(axis.text.x = element_text(size = 12, margin = margin(t = 6.5)),
        plot.title = element_blank()) +
  labs(y = "Probability of Removal",
       x = "Day of Year") -> por_f2

#Remove y-axis from figures for use in multipanel 
# por_f2_adjusted <- por_f2 + 
#   theme(axis.text.y = element_blank(), axis.title.y = element_blank(), axis.ticks.y = element_blank())
# por_f3_adjusted <- por_f3 +
#   theme(axis.text.y = element_blank(), axis.title.y = element_blank(), axis.ticks.y = element_blank())

# 5. Generate figures for multivariate POR terms ----

#Load monthly normal temperature data retrieved from NOAA database for HOMESTEAD GEN AVIATION AP
month_climdat <- read.csv("normals-monthly-1991-2020-2023-12-28T16-01-31.csv") %>%
  mutate(month.n = DATE, 
         #Convert measurements from imperial to metric
         airt.c = ((as.numeric(MLY.TAVG.NORMAL)-32)*5/9),
         .keep = "none") 

# 
# Plot interaction between survey start time, duration, and air temperature
#

#Get p-value of smooths for plot annotation 
int.pval <- getpval(por.mod.sum, "te(start_minutes,survey_hr)")
intxtemp.pval <- getpval(por.mod.sum, "ti(start_minutes,survey_hr,airt.c)")
por_time_airt_title <- paste0("Survey Interval: ", int.pval, ", Survey Interval x Temperature: ", intxtemp.pval)

#set interval for survey start time predictions (in minutes)
pred_int <- 5

#Get ecologically relevant temperatures to predict across 
PEP %>% 
  group_by(season2, month.n) %>%
  sample_n(1) %>% 
  ungroup() %>% 
  select(season2, month.n) %>% 
  left_join(month_climdat) %>% 
  mutate(airt.c = round(airt.c, 1)) -> tempdat_season

# Generate predictions for varied start times with reasonable
# duration and mean temperatures for months across wet/dry seasons 
data_slice(por.mod,
           start_minutes = c(seq(0, 1439, by = pred_int)),
           survey_hr = seq(1,6, by = (pred_int/60))) %>%
  select(-c(airt.c, season2)) %>% 
  cross_join(tempdat_season) %>%
  filter(month.n %in% c(2, 5, 8, 11)) %>% 
  fitted_values(por.mod, data = .) %>%
  mutate(strip.label = ifelse(month.n == 2, "Mid-Dry Season",
                              ifelse(month.n == 5, "End Dry Season",
                                     ifelse(month.n == 8, "Mid-Wet Season",
                                            ifelse(month.n == 11, "End Wet Season", NA)))),
         strip.label = fct_reorder(strip.label, month.n)) -> time_airt_plotdat

#Generate figure
time_airt_plotdat %>% 
  mutate(shift_start = (start_minutes - 630) %% 1440) %>%
  ggplot(aes(x = shift_start, y = survey_hr, z = fitted)) +
  facet_wrap(~strip.label) +
  geom_tile(aes(fill = fitted, color = fitted), width = pred_int, height = (pred_int/60), show.legend = T) +
  geom_contour(color = "black", breaks = seq(0, 0.25, by = 0.025), linewidth = 0.75) + 
  scale_x_continuous(breaks = seq(90, 1439, by = 240),
                     labels = c("12", "16", "20",'0', '4', '8'),
                     expand = c(0,0)
  ) +
  scale_y_continuous(expand = c(0,0)) +
  labs(x = "Start Hour",
       y = "Survey Duration (hrs)",
       title = por_time_airt_title) + 
  scale_fill_gradientn(
    colors = RColorBrewer::brewer.pal("RdYlGn", n = 11),
    values = seq(0, 1, length.out = 11),
    breaks = seq(0, 0.261, by = 0.025),
    limits = c(0, 0.261),
    guide = guide_colorbar(
      frame.colour = "black",
      ticks.colour = "black",
      ticks.linewidth = 1,
      title = "Probability\nof Removal",
      title.hjust = 0.5,
      title.vjust = 0.5,
      frame.linewidth = 0.75,
      barheight = 15,
      barwidth = 3
    )) +
  scale_color_gradientn(
    colors = RColorBrewer::brewer.pal("RdYlGn", n = 11),
    values = seq(0, 1, length.out = 11),
    breaks = seq(0, 0.261, by = 0.025),
    limits = c(0, 0.261),
  ) + 
  theme_classic2() +
  theme(
    legend.text = element_text(size = 14),
    legend.title = element_text(size = 16),
    strip.text = element_text(size = 14),
    axis.text.y = element_text(size = 14, color = "black"),
    axis.text.x = element_text(size = 12, color = "black"),
    axis.title = element_text(size = 16),
    axis.title.y = element_text(margin = margin(r = 15)),
    axis.title.x = element_text(color = "black", margin = margin(t = 7.5)),
    legend.margin = margin(l = 15, b = 15),
    plot.tag = element_text(face = "bold", size = 18),
    plot.title = element_text(margin = margin(b = 10), size = 16),
    aspect.ratio = 0.75
  ) +
  guides(color = "none") -> por_2d_fig2

#Use patchwork to generate multipanel of results from POR model 
(por_f1 + theme(plot.tag.position = c(0, 1))) +
  (por_f2 + theme(plot.tag.position = c(0, 1.1))) +
  (por_2d_fig2 + theme(plot.tag.position = c(0, 1))) +
  (por_acc_fig + theme(plot.tag.position = c(0, 1.1))) +
  plot_layout(design = 
              "AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               AAAAAAAAAAAAAACCCCCCCCCCCCCCCCC#
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD
               BBBBBBBBBBBBBBDDDDDDDDDDDDDDDDDD"
  ) +
  plot_annotation(tag_levels = c("A")) &
  theme(plot.tag = element_text(face = "bold", size = 30),
        plot.margin = margin(rep(20,4))) -> por_multi

#Render high resolution PNG of multipanel
ggsave(filename = "POR_multi.PNG", path = fig.dir, plot = por_multi, dpi = 300, width = 20, height = 15)

# 6. Generate and evaluate GAM model for RPUE -----

#Why switch from RPUE to removal count as response variable?
PEP %>% 
  pivot_longer(cols = c(snakes,RPUE), names_to = 'cap.metric', values_to = "value") %>% 
  filter(capture == 1 & survey_hr < 8 & value < 6) %>%
  ggplot(aes(x = survey_hr)) +
  geom_point(aes(y = value, color = cap.metric), show.legend = F, size = 3, alpha = 0.1) + 
  geom_smooth(aes(y = value, color = cap.metric), linewidth = 2, method = "gam") +
  scale_color_brewer(palette = "Set2") +
  theme_classic2() + 
  theme(legend.title = element_blank()) -> rpue_snakes_fig
# What you're primarily measuring with RPUE is your initial success and survey duration
# Removal count (i.e., `snakes`) is better decoupled from survey effort and subsequently provides 
# a better response for predicting what environmental variables and contractor decisions effect 
# success in removal. 

# RPUE can be recovered from model predictions by simply dividing predicted removal counts by 
# survey effort which is a required input to make predictions with a GAMM due to their additive
# nature 

# Set model formula 
rpue.form <- snakes ~ season2 +
  s(airt.c, bs = "ts") +
  s(julian, bs = "cc", k = 20) +
  ti(julian, airt.c, bs = c("cc", "ts")) +
  te(start_minutes, survey_hr, bs = c("cc", "ts")) +
  ti(start_minutes, survey_hr, airt.c, bs = c("cc", "ts", "ts")) +
  s(baro.diff, by = season2, bs = "ts") +
  s(wnds.mph, bs = "ts") +
  s(radt.kwm2, bs = "ts") +
  s(etp.mm, bs = "ts") +
  s(humi.perc, bs = "ts") +
  s(baro.mm, bs = "ts") +
  s(rain.mm, bs = "ts") +
  te(illum_start, illum_end, bs = c("ts", "ts")) +
  s(moon_start4, bs = "re") +
  s(year, bs = "re") +
  s(station1, station2, station3, bs = "re") +
  s(contractor, bs = "re") +
  s(alone_or_assist, bs = "re") +
  s(PATRIC_property_equiv, bs = "re") +
  s(survey_type, bs = "re")

response ~ s(covariate , by = interaction(term1,))
# Set knots for cubic cyclic splines 
rpue.knots <- list(julian=c(0.5, 366.5),
                   end_minutes=c(-0.5, 1439.5),
                   start_minutes=c(-0.5, 1439.5))

# Implement GAM model via bam (large datasets) function 
bam(data = PEP, 
    formula = rpue.form,
    knots = rpue.knots,
    family = nb(),
    discrete = T,
    nthreads = 7,
    select = F) -> rpue.mod
AIC(rpue.mod) #3830.165

# Ensure sufficient complexity was allocated to splines 
k.check(rpue.mod) %>%
  as.data.frame() %>%
  arrange(`p-value`) %>%
  filter(`p-value` < 0.1) %>% 
  rownames_to_column('smooth') %>% 
  select(c(1:3)) %>% 
  mutate(edf = round(edf, 1)) 

# Look at model diagnostics and fit 
gratia::appraise(rpue.mod, method = "simulate") #model predictions looks great!

#check dispersion parameter
sum(residuals(rpue.mod, type="pearson")^2)/df.residual(rpue.mod) #looks good 👍

#Solid R-squared: 31.2% 
(summary(rpue.mod) -> rpue.mod.sum)

summary(predict(rpue.mod, type = "response")) #Predicting a removal count of up to 5.7
#Actual max is 13 but getting predictions this high is hard because these values are so rare 

# 7. Generate figures for environmental effects on RPUE ----

#get names of significant smooths
(rpue.mod.sum$s.table %>% 
   as.data.frame() %>% 
   filter(`p-value` < .05) %>% 
   rownames_to_column('smooths') %>% 
   pull('smooths') -> rpue.sig.smooths)

#Set plotting theme
rpue_theme <- theme_classic2() + 
  theme(axis.title.y = element_text(margin = margin(r = 20, l = 2.5)),
        axis.title.x = element_text(margin = margin(t = 10, b = 2.5)),
        axis.title = element_text(size = 16),
        axis.text = element_text(size = 14, color = "black"))

#Plot effect of air temperature   
#
#get distribution from PEP data 
hist.dat.airtc <- PEP %>% 
  mutate(airt.c = (airt.c %/% 1)*1) %>%
  group_by(airt.c) %>% 
  summarize(n = n()/nrow(PEP)) %>%
  ungroup() 
#generate plot with model predictions and observed conditions 
data_slice(rpue.mod,
           airt.c = evenly(airt.c),
           survey_hr = 1) %>% 
  scaled_smooth_estimates(object = rpue.mod, smooth = "s(airt.c)", data = .) %>% 
  ggplot(aes(x = airt.c)) + 
  geom_bar(data = hist.dat.airtc, aes(x = airt.c, y = n), stat = "identity", color = "black", fill = "white", width = 1) +
  geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci), alpha = 0.25) +
  geom_line(aes(y = est), linewidth = 0.75) +
  geom_line(aes(y = lower_ci), lty = "dashed", linewidth = 0.6) +
  geom_line(aes(y = upper_ci), lty = "dashed", linewidth = 0.6) +
  annotate(geom="text", x=4.64, y=0.425, hjust = 0, label = getpval(rpue.mod.sum, "s(airt.c)"), size = 6) +
  scale_x_continuous(n.breaks = 8) +
  rpue_theme +
  labs(y = "Removal per Unit Effort",
       x = "Air Temperature (°C)") -> rpue_f1

#Plot effect of day of year
#
#get distribution from PEP data 
hist.dat.julian <- PEP %>% 
  mutate(julian = (julian %/% 14)*14) %>%
  group_by(julian) %>% 
  summarize(n = n()/nrow(PEP)) %>%
  ungroup() 
#generate plot with model predictions and observed conditions 
data_slice(rpue.mod,
           julian = unique(PEP$julian),
           survey_hr = 1) %>% 
  scaled_smooth_estimates(object = rpue.mod, smooth = "s(julian)", data = .) %>% 
  ggplot(aes(x = julian)) + 
  geom_bar(data = hist.dat.julian, aes(x = julian, y = n), stat = "identity", color = "black", fill = "white", width = 14) +
  geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci), alpha = 0.25) +
  geom_line(aes(y = est), linewidth = 0.75) +
  geom_line(aes(y = lower_ci), lty = "dashed", linewidth = 0.6) +
  geom_line(aes(y = upper_ci), lty = "dashed", linewidth = 0.6) +
  annotate(geom="text", x=1, y=0.64, hjust = 0, label = getpval(rpue.mod.sum, "s(julian)"), size = 6) +
  scale_x_continuous(breaks = c(1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335),
                     labels = month.abb) +
  rpue_theme +
  theme(axis.text.x = element_text(size = 12)) + 
  labs(y = "Removal per Unit Effort",
       x = "Day of Year") -> rpue_f2


#Plot effect of barometric pressure
#
#get distribution from PEP data 
hist.dat.baro <- PEP %>% 
  filter(season2 == "wet") %>% 
  mutate(baro.diff = (baro.diff %/% 0.5)*0.5) %>%
  group_by(baro.diff) %>% 
  summarize(n = n()/nrow(PEP)) %>%
  ungroup() %>% 
  mutate(n = n*0.75)
# Constrain bootstrapped barometric difference values 
# to those extremes observed within a season 
wet.baro_diff.max <- max(filter(PEP, season2 == "wet")$baro.diff)
wet.baro_diff.min <- min(filter(PEP, season2 == "wet")$baro.diff)
data_slice(rpue.mod,
           baro.diff = seq(wet.baro_diff.min, wet.baro_diff.max, length.out = 100),
             season2 = factor("wet"),
             survey_hr = 1) %>% 
  #generate plot with model predictions and observed conditions 
  scaled_smooth_estimates(object = rpue.mod, smooth = "s(baro.diff):season2wet", data = .) %>%
  ggplot(aes(x = baro.diff)) + 
  geom_bar(data = hist.dat.baro, aes(x = baro.diff, y = n), stat = "identity", color = "black", fill = "white", width = 0.5) +
  geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci), alpha = 0.25) +
  geom_line(aes(y = est), linewidth = 0.75) +
  geom_line(aes(y = lower_ci), lty = "dashed", linewidth = 0.6) +
  geom_line(aes(y = upper_ci), lty = "dashed", linewidth = 0.6) + 
  annotate(geom="text", x=-1.5, y=0.65, hjust = 0, label = paste("Wet Season:", getpval(rpue.mod.sum, "s(baro.diff):season2wet")), size = 6) +
  scale_color_brewer(palette = "Set1") +
  scale_y_continuous(limits = c(0,1.3), breaks = seq(0,1.25, 0.25)) +
  rpue_theme +
  labs(y = "Removal per Unit Effort",
       x = "Pressure Change (mm Hg)",
       color = "Season")  -> rpue_f3

#Remove y-axis title for use in multipanel 
rpue_f2_adjusted <- rpue_f2 +
  theme(axis.title.y = element_blank())
rpue_f3_adjusted <- rpue_f3 +
  theme(axis.title.y = element_blank())

#
# Plot interaction between Julian day and air temperature
#

#specify non-relevant smooths to zero for prediction
rpue.boot.smooths <- rpue.sig.smooths[c(1:4)]
rpue.boot.smooths.out <- subset(smooths(rpue.mod), !smooths(rpue.mod) %in% rpue.boot.smooths)

# Pull daily average air temperature data for HOMESTEAD GEN AVIATION AP 
# from NOAA from 1991-2020 (https://www.weather.gov/wrh/Climate?wfo=mfl)
read_rds(file = "NOAA_HOMESTEAD.GEN.AVIATION.AP_climdat.rds") %>%
  as.data.frame() %>% 
  pivot_longer(-Day, names_to = "Month", values_to = "Temp") %>% 
  filter(Temp != "-") %>% 
  mutate(month = match(Month, month.abb),
         date = make_date(2021, month, Day),
         week = week(date),
         julian = yday(date),
         Temp = ((as.numeric(Temp)-32)*5/9)) %>%
  select(Month, month.n = month, week, julian, airt.c.mean = Temp) %>% 
  left_join(unique(select(PEP, season2, month.n))) -> clim.dat 

#Get fitted values for a 6-hour survey
temp_range <- 5
clim.dat %>%
  mutate(airt.c.mean = (airt.c.mean %/% 0.25)*0.25) %>%
  rowwise() %>%
  mutate(temp_adjust_val = list(seq(-temp_range,temp_range,0.25))) %>% 
  unnest(temp_adjust_val) %>% 
  mutate(airt.c = airt.c.mean + temp_adjust_val) %>% 
  select(-temp_adjust_val) %>%
  expand(nesting(Month, month.n, week, julian, airt.c.mean), airt.c) %>%
  mutate(grid = ifelse(temp_range < abs(airt.c.mean - airt.c), "out", "in")) %>%
  cbind(select(data_slice(object = rpue.mod,
                          survey_hr = 3,
                          start_minutes = 1260),
               -c(airt.c, julian))) %>% 
  fitted_values(object = rpue.mod, data = ., exclude = rpue.boot.smooths.out) %>% 
  mutate(fitted = fitted/(survey_hr+1.5)) -> julian_airt_plotdat

max(julian_airt_plotdat$fitted)

#set consistent color and fill scale for RPUE plots 
color_scale <- scale_color_gradientn(
  colors = brewer.pal(11, "RdYlGn"),
  breaks = seq(0, 0.22, by = 0.05),
  limits = c(0, 0.22)
)
fill_scale <- scale_fill_gradientn(
  colors = brewer.pal(11, "RdYlGn"),
  breaks = seq(0, 0.22, by = 0.025),
  limits = c(0, 0.22),
  guide = guide_colorbar(
    frame.colour = "black",
    ticks.colour = "black",
    ticks.linewidth = 1,
    title = "Removal Per\nUnit Effort",
    title.hjust = 0.5,
    title.vjust = 0.5,
    frame.linewidth = 0.75,
    barheight = 15,
    barwidth = 3
  )
)

#Generate figure
julian_airt_plotdat %>%  
  mutate(fitted = ifelse(grid == 'in', fitted, NA)) %>% 
  ggplot() + 
  annotate("rect", xmin = 1, xmax = 91, ymin = 14, ymax = 35, fill = "#C2B280", color = NA, alpha = 0.45) +
  annotate("rect", xmin = 91, xmax = 306, ymin = 14, ymax = 35, fill = "#3399FF", color = NA, alpha = 0.45) +
  annotate("rect", xmin = 306,  xmax = 365, ymin = 14, ymax = 35, fill = "#C2B280", color = NA, alpha = 0.45) +
  geom_tile(data = . %>% filter(grid == "in"), aes(x = julian, y = airt.c, fill = fitted, color = fitted), height = 0.25, na.rm = T) +
  geom_contour(aes(x = julian, y = airt.c, z = fitted), na.rm = T, color = "black", linewidth = 0.75, breaks = seq(0, 0.375, by = 0.025)) +
  geom_smooth(data = clim.dat, aes(x = julian, y = airt.c.mean), method = "gam", color = "black", se = F, lty = "longdash") +
  geom_line(data = clim.dat, aes(x = julian, y = airt.c.mean+(temp_range)), linewidth = 3) +
  geom_line(data = clim.dat, aes(x = julian, y = airt.c.mean-(temp_range+0.23)), linewidth = 3) +
  annotate(geom="text", x = 10, y = 31, hjust = 0, label = getpval(rpue.mod.sum, "ti(julian,airt.c)"), size = 6, color = "black") +
  scale_x_continuous(breaks = c(1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335),
                     labels = month.abb,
                     expand = c(0,0)) +
  scale_y_continuous(expand = c(0,0)) +
  fill_scale +
  color_scale + 
  rpue_theme +
  guides(color = "none") +
  labs(y = "Air Temperature (°C)",
       x = "Day of Year") +
  theme(
    legend.text = element_text(size = 14),
    legend.position = "right",
    legend.title = element_text(size = 16),
    strip.text = element_text(size = 16),
    axis.text.y = element_text(size = 14, color = "black"),
    axis.text.x = element_text(size = 14, color = "black"),
    axis.title = element_text(size = 16),
    axis.title.y = element_text(margin = margin(r = 15)),
    axis.title.x = element_text(color = "black", margin = margin(t = 7.5)),
    legend.margin = margin(l = 15)) -> rpue_f4

#
#Generate multi-panel of environmental RPUE effects #
#

rpue_f1 + rpue_f2_adjusted + rpue_f3_adjusted + rpue_f4 +
  plot_layout(design = 
              "AAAAAAAAABBBBBBBBBCCCCCCCCC
               DDDDDDDDDDDDDDDDDDDDDDDDDD#") +
  plot_annotation(tag_levels = "A") &
  theme(plot.tag = element_text(face = "bold", size = 30),
        plot.margin = margin(rep(20,4)),
        plot.tag.position = c(-0.015, 1.06)) -> rpue_env_multi
  
#render high resolution multipanel of results
ggsave(filename = "rpue_env_multi.PNG", plot = rpue_env_multi, dpi = 320, path = fig.dir, width = 20, height = 15)

# 8. Generate figures for survey effects on RPUE ----

#Update RPUE theme 
rpue_theme <- rpue_theme + 
  theme(
    legend.text = element_text(size = 14),
    legend.title = element_text(size = 16),
    strip.text = element_text(size = 16),
    axis.text.y = element_text(size = 14, color = "black"),
    axis.text.x = element_text(size = 14, color = "black"),
    axis.title = element_text(size = 16),
    axis.title.y = element_text(margin = margin(r = 15)),
    axis.title.x = element_text(color = "black", margin = margin(t = 7.5)),
    legend.margin = margin(l = 15))

#set interval for survey start time predictions (in minutes)
pred_int <- 5

#set maximum and minimum survey duration for simulations 
max_hr <- 6
min_hr <- 1

#set survey hour intercept for RPUE calculation
RPUE_intercept <- 1.5

#Get ecologically relevant temperatures to predict across 
PEP %>% 
  group_by(season2, month.n) %>%
  mutate(julian = median(julian)) %>% 
  sample_n(1) %>% 
  ungroup() %>% 
  select(season2, month.n, julian) %>% 
  left_join(month_climdat) %>% 
  mutate(airt.c = round(airt.c, 1),
         strip.label = ifelse(month.n == 2, "Mid-Dry Season",
                              ifelse(month.n == 5, "End Dry Season",
                                     ifelse(month.n == 8, "Mid-Wet Season",
                                            ifelse(month.n == 11, "End Wet Season", NA)))),
         strip.label = fct_reorder(strip.label, month.n)) %>% 
  filter(!is.na(strip.label)) -> tempdat_season

#specify non-relevant smooths to zero for prediction
rpue.boot.smooths <- rpue.sig.smooths[c(1:5)]
rpue.boot.smooths.out <- subset(smooths(rpue.mod), !smooths(rpue.mod) %in% rpue.boot.smooths)

#Get p-value of smooths for plot annotation 
int.pval <- getpval(rpue.mod.sum, "te(start_minutes,survey_hr)")
intxtemp.pval <- getpval(rpue.mod.sum, "ti(start_minutes,survey_hr,airt.c)")
time_airt_title <- paste0("Survey Interval: ", int.pval, ", Survey Interval x Temperature: ", intxtemp.pval)

# Generate predictions for varied start times with reasonable
# duration and mean wet/dry season temperatures 
data_slice(rpue.mod,
           airt.c = unique(tempdat_season$airt.c),
           start_minutes = seq(0, 1439, by = pred_int),
           survey_hr = seq(min_hr,max_hr, by = (pred_int/60))) %>%
  select(-c(season2, julian)) %>% 
  left_join(tempdat_season, by = 'airt.c') %>% 
  fitted_values(object = rpue.mod, data = ., exclude = rpue.boot.smooths.out) %>% 
  mutate(RPUE = fitted/(survey_hr+RPUE_intercept),
         shift_start = ((start_minutes - 630) %% 1440)) -> time_airt_plotdat

#Generate figure
time_airt_plotdat %>% 
  ggplot(aes(x = shift_start, y = survey_hr)) +
  facet_wrap(~strip.label, ncol = 4) +
  geom_tile(aes(fill = RPUE, color = RPUE)) +
  geom_contour(aes(z = RPUE), color = "black", linewidth = 0.75, breaks = seq(0, 0.25, by = 0.025)) +
  scale_x_continuous(breaks = seq(90, 1439, by = 240),
                     labels = c("12", "16", "20",'0', '4', '8'),
                     expand = c(0,0)
  ) +
  scale_y_continuous(expand = c(0,0)) +
  labs(x = "Start Hour",
       y = "Survey Duration (hrs)",
       title = time_airt_title) + 
  rpue_theme +
  theme(strip.text = element_text(size = 14),
        plot.title = element_text(size = 16, margin = margin(b = 10))) +
  fill_scale +
  color_scale +
  guides(color = "none") -> rpue_2d

#
# Predict optimal surveying time (maximized RPUE) by month #
#

#Load monthly normal temperature data retrieved from NOAA database for HOMESTEAD GEN AVIATION AP
month_climdat <- read.csv("normals-monthly-1991-2020-2023-12-28T16-01-31.csv") %>%
  mutate(month.n = DATE, 
         #Convert measurements from imperial to metric
         airt.c = ((as.numeric(MLY.TAVG.NORMAL)-32)*5/9),
         .keep = "none") 


#Get mean Julian day for each month of the year  
PEP %>% 
  group_by(month.n, julian) %>%
  sample_n(1) %>% 
  group_by(month.n) %>% 
  mutate(julian = round(median(julian))) %>%
  sample_n(1) %>% 
  select(season2, month.n, julian) -> month_julian


#Bootstrap search for optimal survey conditions per month
month_julian %>%  
  #Add NOAA air temperature data 
  left_join(month_climdat, by = 'month.n') %>% 
  #Add grid of start times / durations for all months 
  cross_join(., 
             select(data_slice(rpue.mod,
                               start_minutes = seq(0,1440, by = 5),
                               survey_hr = seq(min_hr, max_hr, by = (5/60))),
                    -c(season2, julian, airt.c))
  ) %>% 
  #get model predictions for simulated surveys 
  fitted_values(object = rpue.mod, data = ., exclude = rpue.boot.smooths.out) %>% 
  #calculate RPUE with intercept 
  mutate(RPUE = fitted/(survey_hr+RPUE_intercept)) %>%
  #filter to best survey conditions for each month
  group_by(month.n) %>% 
  filter(max(RPUE) == RPUE) %>% 
  #keep only relevent columns 
  select(month.n, start_minutes, survey_hr, fitted, RPUE) %>% 
  ungroup() %>% 
  #calculate survey end time
  mutate(end_minutes = start_minutes + (survey_hr*60),
         end_minutes = ifelse(end_minutes > 1440, end_minutes %% 1440, end_minutes)) %>% 
  #shift X axis start to 8pm
  mutate(across(.cols = ends_with("_minutes"), .fns = ~ (.x - 1080) %% 1440)) -> opt_survey_df
  
#plot optimal survey conditions bootstrap search
opt_survey_df %>% 
  ggplot() + 
  geom_segment(aes(y = month.n, yend = month.n,
                   x = start_minutes, xend = end_minutes),
               color = "black", linewidth = 1) + 
  geom_point(aes(y = month.n, x = start_minutes, fill = RPUE), size = 6, pch = 21, show.legend = T) + 
  geom_point(aes(y = month.n, x = end_minutes, fill = RPUE), size = 6, pch = 21, show.legend = T) +
  scale_y_reverse(breaks = c(1:12),
                  labels = month.abb) +
  scale_x_continuous(breaks = seq(0,720, by = 120),
                     labels = c("6pm", "8pm", "10pm", "12am",
                                "2am", "4am", "6pm"),
                     limits = c(90, 600)) +
  fill_scale + 
  labs(y = "Survey Month",
       x = "Survey Interval") +
  rpue_theme -> opt_survey_fig 

# 9. Perform Feature Importance on RPUE model ----

# Define a vector of predictor terms used in the model formula. 
form.preds <- c(
  "season2",
  "s(airt.c, bs = 'ts')",
  "s(julian, bs = 'cc', k = 20)", 
  "ti(julian, airt.c, bs = c('ts', 'ts'))",
  "te(start_minutes, survey_hr, bs = c('cc', 'ts'))",
  "ti(start_minutes, survey_hr, airt.c, bs = c('cc', 'ts', 'ts'))",
  "s(baro.diff, by = season2, bs = 'ts')",
  "s(wnds.mph, bs = 'ts')",
  "s(radt.kwm2, bs = 'ts')",
  "s(etp.mm, bs = 'ts')", 
  "s(humi.perc, bs = 'ts')",
  "s(baro.mm, bs = 'ts')",
  "s(rain.mm, bs = 'ts')",
  "te(illum_start, illum_end, bs = c('ts', 'ts'))",
  "s(moon_start4, bs = 're')",
  "s(year, bs = 're')",
  "s(station1, station2, station3, bs = 're')",
  "s(contractor, bs = 're')",
  "s(alone_or_assist, bs = 're')",
  "s(PATRIC_property_equiv, bs = 're')",
  "s(survey_type, bs = 're')" 
)

# Initialize an empty list to store the nested formulas. 
# Nested formulas are derived from the original formula by removing one predictor term at a time.
nested_formulas <- list()

# Loop through each predictor term in the model formula and create 
# a new formula by removing that specific term.
for (term in form.preds) {
  nested_formulas[[term]] <- update(formula(rpue.mod), paste(". ~ . -", term))
}

# Calculate the baseline performance of the original model
baseline_rsq <- rpue.mod.sum$r.sq

# Initialize a vector to store the change in performance for each feature
feature_performance_change <- numeric()

# Fit and evaluate each nested model using the 'update' function
for (i in names(nested_formulas)) {
  #keep track of loop
  print(i)
  
  # Update the model by removing the current term
  set.seed(123)
  nested_model <- update(rpue.mod, as.formula(nested_formulas[[i]]))
  
  # Evaluate the nested model
  set.seed(123)
  nested_rsq <- summary(nested_model)$r.sq  # Replace 'target' with your actual target variable name
  
  # Calculate the change in performance
  feature_performance_change[i] <- baseline_rsq - nested_rsq
}

# Define a vector of labels for the predictor terms
data.frame(
  smooths.form = names(feature_performance_change)[-1]
) %>% 
  mutate(smooths.sum = str_replace(smooths.form, ',\\sbs(?<=,\\sbs).*(?=\\))', ''),
         smooths.sum = str_replace_all(smooths.sum, ' ', ''),
         smooths.sum = ifelse(smooths.sum == "s(station1,station2,station3)", 's(station3,station2,station1)', smooths.sum)) %>% 
  left_join(rownames_to_column(as.data.frame(rpue.mod.sum$s.table), "smooths.sum")) %>% 
  left_join(rownames_to_column(as.data.frame(feature_performance_change), "smooths.form")) %>% 
  filter(`p-value` < 0.05 | smooths.sum == "s(baro.diff,by=season2)") %>% 
  arrange(desc(feature_performance_change)) %>% 
  mutate(term_type = ifelse(grepl('re', smooths.form), "Random Effect Term",
                            ifelse(grepl('c\\(', smooths.form), "Multivariate Smooth",
                                   "Univariate Smooth")),
         smooths.sum = fct_inorder(smooths.sum)) %>% 
  ggplot() +
  geom_col(aes(x = feature_performance_change, y = smooths.sum, fill = term_type),
           color = "black",
           linewidth = 0.75,
           width = 0.9) + 
  theme_classic2() + 
  theme(legend.position = c(0.70, 0.90),
        axis.text.y = element_text(size = 14, color = "black", margin = margin(l = 5, r = 5)),
        axis.text.x = element_text(size = 14, color = "black"),
        axis.title.y = element_text(size = 16, margin = margin(l = 0, r = 15)),
        axis.title.x = ggtext::element_markdown(size = 16, margin = margin(t = 15, b = 7.5)),
        legend.title = element_blank(),
        legend.text = element_text(size = 14)) +
  coord_cartesian(xlim = c(0,0.15)) +
  scale_fill_brewer(palette = "Set1") + 
  scale_x_continuous(breaks = c(0, 0.05, 0.1, 0.15),
                     labels = c("0%", "-5%", "-10%", '-15%')) + 
  labs(x = "ΔR<sup>2</sup>",
       y = "Model Term") -> rpue_featimp

#
# Generate multipanel of RPUE survey effect results #
#

(wrap_elements(full = rpue_2d + theme(legend.position = "none")) / (rpue_featimp | (opt_survey_fig  + theme(legend.position = "none"))) | get_legend(rpue_2d)) +
  plot_layout(widths = c(1, 0.15)) +
  plot_annotation(tag_levels = list(c("A", "B", "C", ""))) &
  theme(plot.tag = element_text(face = "bold", size = 30),
        plot.tag.position = c(-0.0125,1.035),
        plot.margin = margin(rep(20,4))) -> rpue_surv_multi

ggsave(plot = rpue_surv_multi, "rpue_surv_multi.PNG", path = fig.dir, dpi = 300, height = 15, width = 20)