---
title: "Publication Code - Seed Predation Study"
output: html_document
date: "2025-04-24"
---

```{r setup, include=FALSE}

setwd("/Users/victoria/Documents/seedpred_final/Revisions")

# install.packages("tidyverse")
library(tidyverse)

# install.packages("plyr")
library(plyr)

# install.packages("dplyr")
library(dplyr)

# install.packages("ggplot2")
library(ggplot2) # for plots

# install.packages("lme4")
library(lme4) # for glmer(), i.e. generalized linear mixed models

# install.packages("emmeans")
library(emmeans) # for emmeans() and pairs(), i.e. estimated means and contrasts

# install.packages("car")
library(car) # for Anova() i.e. likelihood ratio test

# install.packages("multcomp")
library(multcomp) # for compact letter display, multcompLetters()

# install.packages("multcompView")
library(multcompView) # for multcompLetters(), i.e. compact letter display

```

```{r setup, include=FALSE} 

## Clean data for seeds remaining on seventh day. ##

raw <- read_csv("seedscleaned.csv")

seeds <- raw %>% gather(species, remaining, c(pila, pipo, psme, abco))

seeds$plot.type <- as.factor(seeds$plot.type)
seeds$plot <- as.factor(seeds$plot)
seeds$cluster <- as.factor(seeds$cluster)
seeds$trial <- as.factor(seeds$trial)
seeds$species <- as.factor(seeds$species)

# create removed and not removed columns for binomial distribution
seeds <- seeds %>% mutate(removed = 3 - remaining) %>% dplyr::select(plot, trial, plot.type, cluster, species, remaining, removed, shrub.5m, woody.debris.5m, litter.5m)


# grouping plots within a treatment regardless of distance from surviving trees

# create 'distance lumped' column
seeds$dist.lumped = with(seeds, 
                         ifelse(plot.type == "G", 0,
                                ifelse(plot.type == "H50", 50,
                                       ifelse(plot.type =="S50", 50, 250))))
# create 'overstory condition lumped' column
seeds$cond.lumped = with(seeds, 
                         ifelse(plot.type == "G", 'G',
                                ifelse(plot.type == "H50", 'H',
                                       ifelse(plot.type =="H250", 'H', 'S'))))
# note:
  # G = "green" i.e. low-sev, 
  # H = high-sev non-salvaged, 
  # S = high-sev salvaged

seeds$dist.lumped <- as.factor(seeds$dist.lumped)
seeds$cond.lumped <- as.factor(seeds$cond.lumped)
seeds$species  <- revalue(seeds$species, 
                          c("abco" = "white fir", 
                            "pila" = "sugar pine", 
                            "pipo" = "ponderosa pine", 
                            "psme" = "Douglas-fir"))

```

Evaluate Ground Cover
```{r}
## First glance at data indicates confounding of overstory condition 
#    (cond.lumped) with surrounding ground cover (shrub, woody debris, 
#    litter percentages).
# Determine whether any of these variables should be included in seed removal
#   models or if they are redundant with overstory condition.

# Reduce dataset to one row per plot because ground cover estimates were
#   only obtained once per plot.
seeds.no.repeats <- seeds %>% 
  filter(trial == "1", species == "sugar pine") %>% 
  dplyr::select(cond.lumped, plot, cluster, remaining, removed, shrub.5m, woody.debris.5m, litter.5m)

# Fit models, one per ground cover type (w/in 5m radius of seed trays).
#  Estimate mean ground cover percent for each overstory condition.
shrub_lm <- lm(shrub.5m ~ cond.lumped, data = seeds.no.repeats)
wood_lm  <- lm(woody.debris.5m ~ cond.lumped, data = seeds.no.repeats)
litter_lm <- lm(litter.5m ~ cond.lumped, data = seeds.no.repeats)

# ANOVA
anova(shrub_lm) # **
anova(wood_lm) # ***
anova(litter_lm) # ***

# R^2
summary(shrub_lm)$r.squared # 0.67

summary(wood_lm)$r.squared # 0.73

summary(litter_lm)$r.squared # 0.97

# all highly correlated -> excluding ground cover from models to avoid
#   redundancy.
```

Table 2: Report Ground Cover Patterns
```{r}

## Provide some detail on how ground cover varies by overstory condition.

# create a function to extract estimated means, CIs, and compact letter displays
get_cld <- function(model, cover_type) {
  emm <- emmeans(model, ~ cond.lumped, type = "response")
  cld_result <- cld(emm, adjust = "sidak", Letters = letters)
  cld_df <- as.data.frame(cld_result)
  cld_df$CoverType <- cover_type
  return(cld_df)}

# apply function to each model separately
combined_cld <- 
  bind_rows(get_cld(shrub_lm, "Shrub"),
            get_cld(wood_lm, "Wood"),
            get_cld(litter_lm, "Litter"))

# make final table: emm with cld
groundcover_table <- 
  combined_cld %>%
  transmute(ground_cover = CoverType,
            cond.lumped,
            value = paste0(round(emmean, 1), " ", .group)) %>%
  pivot_wider(names_from = cond.lumped,
              values_from = value)

groundcover_table # table 2

```

"All-Species Distance" Model
```{r}

## Create model with distance category as a fixed effect, including all species. ##

# filter out low-sev/0m-distance values (because distance does not apply to low-sev treatment)
hisevonly <- seeds %>% filter(dist.lumped != "0")

# Model Testing:
a <- glmer(cbind(removed, remaining)
                      ~ cond.lumped + dist.lumped + species +
                      ( 1 | cluster/plot) + (1 | trial),
                      data = hisevonly, family = binomial) 
# failed to converge

b <- glmer(cbind(removed, remaining)
                      ~ cond.lumped + dist.lumped + species +
                      ( 1 | cluster) + ( 1 | plot) + (1 | trial),
                      data = hisevonly, family = binomial) 
# failed to converge

c <- glmer(cbind(removed, remaining)
                      ~ cond.lumped + dist.lumped + species +
                      ( 1 | plot) + (1 | trial),
                      data = hisevonly, family = binomial)
# no issues -> use model c (calling it m1 from now on)

m1 <- glmer(cbind(removed, remaining)
                      ~ cond.lumped + dist.lumped + species +
                      ( 1 | plot) + (1 | trial),
                      data = hisevonly, family = binomial)

# estimated marginal means and pairwise contrasts for levels of...
emmeans(m1, revpairwise ~ dist.lumped, type = "response") # distance from surviving trees
emmeans(m1, pairwise ~ cond.lumped, type = "response") # overstory condition
emmeans(m1, pairwise ~ species, type = "response") # species
# note: these estimates exclude low-sev plots!

# summary table (ommitted from manuscript, not very informative)
means <- data.frame(emmeans(m1, ~cond.lumped + species, type = "response"))
anova_results <- Anova(m1, type = "III")
summary_table <- data.frame(
  coefficients = rownames(anova_results),
  df = anova_results$Df,
  chi_square = anova_results$Chisq,  
  p_value = anova_results$`Pr(>Chisq)`)

summary_table # all-species model summary
nrow(hisevonly) # N observations

# Pairwise contrast 250 m versus 50 m:
means <- emmeans(m1, ~ dist.lumped, type = "response")
pairs(means, reverse = TRUE)
# odds ratio 250m/50m = 3.39
# p-value = 0.3938

```

Display Distance Effect: Figure 3
```{r}
## Plot estimated means for distance categories (using all-species distance model). ##

# create df for plotting means and CI's
# use estimates from previous chunk
emm_dist <- data.frame(
  dist.lumped = c("50", "250"),
  prob = c(0.411, 0.702),
  SE = c(0.249, 0.220),
  asymp.LCL = c(0.0851, 0.2300),
  asymp.UCL = c(0.839, 0.949))

# order so 50m category displays first
emm_dist$dist.lumped <- factor(emm_dist$dist.lumped, levels = c("50", "250"))

# compact letter display to show contrast
p_values_dist <- c("50-250" = 0.3938)
letters_dist <- multcompLetters(p_values_dist)$Letters
emm_dist$cld <- c(letters_dist["50"], letters_dist["250"])

# plot
# Effect of Distance on Seed Removal for All Species
distanceplot <- 
  ggplot(emm_dist, 
         aes(x = dist.lumped, y = prob, fill = dist.lumped)) +
  geom_bar(stat = "identity", width = 0.4, position = position_dodge(), 
           color = "black") +
  geom_errorbar(aes(ymin = asymp.LCL, ymax = asymp.UCL), width = 0.2) +
  geom_text(aes(label = cld, y = asymp.UCL + 0.05), size = 6) +
  scale_fill_manual(values = c("gray60", "gray80")) + ylim(0, 1) +
  labs(x = "distance from surviving trees (m)",
       y = "estimated removal") +
  theme_bw() +
  theme(legend.position = "none",
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        axis.line = element_line(colour = "black"),
        text = element_text(size = 12))

distanceplot

# # save figure
# ggsave(distanceplot, filename = "fig_s1.pdf",
#        device = "pdf",
#        height = 4, width = 3.5, units = "in")

```

Main Results: Model Testing
```{r}

## Select model structure for species-specific GLMMs ##
# Remove terms to allow convergence and non-singular fit.
# This example is shown for ponderosa pine seed data only,
#   because this dataset presented the most issues.
# We want one model structure applied to each seed dataset separately,
#   so it is appropriate to fit a model to the most problematic dataset,
#   then apply this to the others.

d <- glmer(cbind(removed, remaining) 
           ~ cond.lumped + 
             ( 1 | cluster/plot) + (1 | trial), 
           data = subset(seeds, species == "ponderosa pine"), 
           family = binomial)
# failed to converge

e <- glmer(cbind(removed, remaining) 
           ~ cond.lumped + 
             ( 1 | cluster) + ( 1 | plot) + (1 | trial), 
           data = subset(seeds, species == "ponderosa pine"), 
           family = binomial)
# failed to converge

f <- glmer(cbind(removed, remaining) 
           ~ cond.lumped + 
             ( 1 | plot) + (1 | trial), 
           data = subset(seeds, species == "ponderosa pine"), 
           family = binomial)
# failed to converge

g <- glmer(cbind(removed, remaining) 
           ~ cond.lumped + 
              ( 1 | plot), 
           data = subset(seeds, species == "ponderosa pine"), 
           family = binomial)
# no issues
# use this model structure for all species data subsets, see next chunk

```

Main Results: Run Models
```{r}

## Create models for each species separately. ##

# sugar pine
m2 <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot),
            data = subset(seeds, species == "sugar pine"), 
            family = binomial)

# ponderosa pine
m3 <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot), 
            data = subset(seeds, species == "ponderosa pine"), 
            family = binomial)

# Douglas-fir
# must change one removal value to 1 to avoid separation issue
seeds$removed[which(seeds$species == "Douglas-fir" & seeds$cond.lumped == "G" & seeds$removed == 0)[1]] <- 1
# therefore the remaining num seeds for that trial is 2
seeds$remaining[which(seeds$species == "Douglas-fir" & seeds$cond.lumped == "G" & seeds$removed == 1)[1]] <- 2

m4 <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot), 
            data = subset(seeds, species == "Douglas-fir"), 
            family = binomial) 

# white fir
m5 <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot), 
            data = subset(seeds, species == "white fir"), 
            family = binomial)

```

Display Main Results: Figure 2
```{r}

## Get estimated means and pairwise contrasts for removal by overstory condition, repeat for each species. ##

# create a function to extract estimated means, CIs, and compact letter displays
# very similar to function from chunk 4, just species instead of ground cover
get_cld_2 <- function(model, species_name) {
  emm <- emmeans(model, ~ cond.lumped, type = "response")
  cld_result <- cld(emm, adjust = "sidak", Letters = letters)
  cld_df <- as.data.frame(cld_result)
  cld_df$Species <- species_name
  return(cld_df)}

# get estimated means & CLDs for each species model
df_sugarpine <- get_cld_2(m2, "sugar pine")
df_ponderosa <- get_cld_2(m3, "ponderosa pine")
df_douglasfir <- get_cld_2(m4, "Douglas-fir")
df_whitefir <- get_cld_2(m5, "white fir")

# combine all species data
df_all <- bind_rows(df_sugarpine, df_ponderosa, df_douglasfir, df_whitefir)
df_all$.group <- trimws(df_all$.group) # trim white space

df_all$Species <- factor(df_all$Species, levels = c("sugar pine", "ponderosa pine", "Douglas-fir", "white fir"))

# plot results with CLD
# Effect of Condition on Seed Removal by Species
mainfig <- ggplot(df_all, aes(x = cond.lumped, y = prob, fill = cond.lumped)) +
  geom_bar(stat = "identity", position = position_dodge(), color = "black") +
  geom_errorbar(aes(ymin = asymp.LCL, ymax = asymp.UCL), 
                width = 0.2, position = position_dodge(0.9)) +
  geom_text(aes(label = .group, y = asymp.UCL + 0.07), size = 4.5) + # cld
  scale_fill_manual(values = c("gray40", "gray70", "gray90")) +
  scale_x_discrete(labels=c("G" = "low sev", "H" = "high sev", "S" = "high sev+salv")) +
  facet_wrap(~Species) +  # separate plots for each species
  labs(y = "estimated removal", x = "overstory condition") +
  theme_bw() +
  theme(legend.position = "none") + 
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black")) +
  theme(text = element_text(size=12))

mainfig

# # save figure
# ggsave(mainfig,
#        filename = "fig2.pdf",
#        device = "pdf",
#        height = 5, width = 6, units = "in")

```

Display Main Results: Table 1
```{r}

## Customize direction of pairwise contrasts so that 
#   odds ratios are expressed as higher-over-lower comparisons.

pila_means <- emmeans(m2, ~ cond.lumped, type = "response")
pila_contrast <- as.data.frame(contrast(pila_means, method = 
                            list("H-G" = c(-1, 1, 0), # manually compare in this direction
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak")) # adjust for mult. comparisons

pipo_means <- emmeans(m3, ~ cond.lumped, type = "response")
pipo_contrast <- as.data.frame(contrast(pipo_means, method = 
                            list("H-G" = c(-1, 1, 0), 
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak"))

psme_means <- emmeans(m4, ~ cond.lumped, type = "response")
psme_contrast <- as.data.frame(contrast(psme_means, method = 
                            list("H-G" = c(-1, 1, 0), 
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak"))

abco_means <- emmeans(m5, ~ cond.lumped, type = "response")
abco_contrast <- as.data.frame(contrast(abco_means, method = 
                            list("H-G" = c(-1, 1, 0), 
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak"))

contrast_table <- data.frame(bind_rows(
  list(pila_contrast, pipo_contrast, psme_contrast, abco_contrast), 
  .id = "species")) %>% 
  dplyr::select(species, contrast, odds.ratio, SE, z.ratio, p.value)

contrast_table$species <-
  revalue(contrast_table$species, 
          c("1" = "sugar pine", 
            "2" = "ponderosa pine", 
            "3" = "Douglas-fir", 
            "4" = "white fir"))

contrast_table 
# No longer displaying table as-is
# Use these outputs to make simplified table.

```

Sensitivity Analysis
```{r}

## From peer review: suggestion to remove pseudoreplication introduced by trial.
#   Trial is not modeled, so should be removed from data structure -> aggregate
#   across trial, and refit models.

# Aggregate across trial (for each species at each unique seed station)
seeds_test <- seeds %>%
  group_by(plot, species, cond.lumped) %>%
  dplyr::summarise(
    removed = sum(removed, na.rm = TRUE),
    remaining = sum(remaining, na.rm = TRUE),
    .groups = "drop")

# sugar pine
m2_test <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot),
            data = subset(seeds_test, species == "sugar pine"), 
            family = binomial)

# ponderosa pine
m3_test <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot), 
            data = subset(seeds_test, species == "ponderosa pine"), 
            family = binomial)

# Douglas-fir
# # must change one removal value to 1 to avoid separation issue
# seeds_test$removed[which(seeds_test$species == "Douglas-fir" & seeds_test$cond.lumped == "G" & seeds$removed == 0)[1]] <- 1
# # therefore the remaining num seeds for that trial is 2
# seeds$remaining[which(seeds$species == "Douglas-fir" & seeds$cond.lumped == "G" & seeds$removed == 1)[1]] <- 2

m4_test <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot), 
            data = subset(seeds_test, species == "Douglas-fir"), 
            family = binomial) 

# white fir
m5_test <- glmer(cbind(removed, remaining) 
            ~ cond.lumped + ( 1 | plot), 
            data = subset(seeds_test, species == "white fir"), 
            family = binomial)

pila_meanstest <- emmeans(m2_test, ~ cond.lumped, type = "response")
pila_contrasttest <- as.data.frame(contrast(pila_meanstest, method = 
                            list("H-G" = c(-1, 1, 0), # manually compare in this direction
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak")) # adjust for mult. comparisons

pipo_meanstest <- emmeans(m3_test, ~ cond.lumped, type = "response")
pipo_contrasttest <- as.data.frame(contrast(pipo_meanstest, method = 
                            list("H-G" = c(-1, 1, 0), 
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak"))

psme_meanstest <- emmeans(m4_test, ~ cond.lumped, type = "response")
psme_contrasttest <- as.data.frame(contrast(psme_meanstest, method = 
                            list("H-G" = c(-1, 1, 0), 
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak"))

abco_meanstest <- emmeans(m5_test, ~ cond.lumped, type = "response")
abco_contrasttest <- as.data.frame(contrast(abco_meanstest, method = 
                            list("H-G" = c(-1, 1, 0), 
                                 "S-G" = c(-1, 0, 1),
                                 "H-S" = c(0, 1, -1)),
                            type = "response",
                            adjust = "sidak"))

contrast_table_test <- data.frame(bind_rows(
  list(pila_contrasttest, pipo_contrasttest, psme_contrasttest, abco_contrasttest), 
  .id = "species")) %>% 
  dplyr::select(species, contrast, odds.ratio, SE, z.ratio, p.value)

contrast_table_test$species <-
  revalue(contrast_table_test$species, 
          c("1" = "sugar pine", 
            "2" = "ponderosa pine", 
            "3" = "Douglas-fir", 
            "4" = "white fir"))

contrast_table_test

# Outcome: almost identical values to previous results. This chunk will be
#   retained in code, but will not be mentioned in manuscript.

```

Removal Over Time
```{r}

## Describe how quickly seeds were removed. ##

# load data for seeds remaining on each day of trial i.e. data for seeds remaining over time
time_raw <- read_csv("timecleaned.csv")

# reformat so that df shows seeds remaining on each day with day as a col
time <- time_raw %>% 
  gather(species, remaining, c(pila, pipo, psme, abco)) %>% 
  spread(day, remaining) %>% 
  dplyr::rename(day0 = '0', day1 = '1', day2 = '2', day7 = '7')

# calculate true proportion removed each day

# total num seeds removed (summed across plots and trials)
sum(time$day0) # began with 720 seeds
720 - sum(time$day1) # 201 seeds were removed by day 1
720 - sum(time$day2) # 242 seeds were removed by day 2
sum(time$day1) - sum(time$day2) # 41 removed between day 1 and 2
720 - sum(time$day7) # 331 seeds were by day 7
sum(time$day2) - sum(time$day7) # 89 removed between day 2 and 7


# when were most seeds removed?

(sum(time$day0) - sum(time$day1)) / (sum(time$day0) - sum(time$day7))
# 60.7% of seeds removed occurred in first 24 hrs i.e. between days 0 and 1

(sum(time$day1) - sum(time$day2)) / (sum(time$day0) - sum(time$day7))
# 12.4% between days 1 and 2

(sum(time$day2) - sum(time$day7)) / (sum(time$day0) - sum(time$day7))
# 26.9% between days 2 and 7

```

Camera Trap Data
```{r}
cam <- read_csv("cams_cleaned.csv")

# clean data
cam$at_tray[cam$at_tray %in% c("na", "", " ")] <- NA
cam$taxa[cam$taxa %in% c("na", "", " ")] <- NA

cam <- cam %>%
  mutate(
    plot = case_when(
      trial == "1" & cam == "1" ~ "H250-1",
      trial == "1" & cam == "2" ~ "H250-2",
      trial == "1" & cam == "3" ~ "H50-1",
      trial == "2" & cam == "1" ~ "H250-1",
      trial == "2" & cam == "5" ~ "S50-2",
      trial == "3" & cam == "1" ~ "H50-1",
      trial == "3" & cam == "2" ~ "H250-2",
      trial == "3" & cam == "3" ~ "S50-1",
      trial == "3" & cam == "5" ~ "G-2",
      trial == "3" & cam == "6" ~ "G-3",
      trial == "4" & cam == "2" ~ "H50-2",
      trial == "4" & cam == "3" ~ "S50-1",
      trial == "4" & cam == "4" ~ "S250-3",
      trial == "4" & cam == "5" ~ "G-2"))

cam$cond.lumped = with(cam, 
                         ifelse(plot == "G-1" | plot == "G-2" | plot == "G-3", 'G',
                                ifelse(plot == "H50-1" | plot == "H50-2" | plot == "H50-3" |
                                       plot == "H250-1" | plot == "H250-2" | plot == "H520-3",'H', 'S')))

cam <- cam %>%
  mutate(
    taxa = case_when(
      taxa == "m" ~ "mouse",
      taxa == "s" ~ "squirrel",
      taxa == "b" ~ "bird",
      taxa == "c" ~ "chipmunk",
      TRUE ~ taxa ))


# aggregate detections and make simple summary

# make unique hour column
cam$hour <- as.POSIXct(format(cam$datetime, "%Y-%m-%d %H:00:00"))

# remove unidentifiable animals and those not at trays
usable <- cam[!is.na(cam$taxa) & cam$at_tray == 1, ]

# aggregate
hourly <- unique(usable[, c("trial", "cond.lumped", "hour", "taxa")])

summary_table <- as.data.frame(table(hourly$cond.lumped, hourly$taxa))

summary_table

```