Quantify daily distance travelled by swallows

library(data.table)
library(ggplot2)
library(colorspace)
# load swallow data preprocessed
files <- list.files(
  path = "data/processed/data_preprocessed",
  pattern = "Hirundo",
  full.names = TRUE
)
# read all data
data <- lapply(files, fread)

# bind list and split by id and date
data <- rbindlist(data)
data <- split(data, by = c("TAG", "date"))

Calculate distance and area

Distance

library(atlastools)
data <- lapply(
  data, function(df) {
    df[, dist := atl_simple_dist(df, x = "X", y = "Y")]
    df[, dist := nafill(dist, type = "const", fill = 0)]
    df
  }
)

# cumulative daily distance in kilometres
data_dist <- lapply(data, function(df) {
  df[, list(
    dist = sum(dist) / 1000,
    tracking_time = diff(range(time)) / (60 * 60)
  ), by = c("TAG", "date")]
}) |> rbindlist()

data_dist$date <- as.character(data_dist$date)

# get distance per hour
data_dist[, dist_ph := dist / tracking_time]

Link with RRV and moult status

# read rrv
rrv <- fread("data/results/data_daily_rrv.csv")
rrv$date <- as.character(rrv$date)

data_dist <- merge(
  data_dist,
  rrv,
  by.x = c("TAG", "date"),
  by.y = c("TAG", "date"),
  all.x = TRUE,
  all.y = FALSE
)
# sanity check
ggplot(data_dist) +
  geom_jitter(
    aes(rrv_calc, dist_ph, col = treat)
  )
# speed over rrv summary
psdf <- copy(data_dist)
psdf2 <- psdf[, unlist(
  lapply(.SD, function(x) {
    list(
      mean = mean(x, na.rm = TRUE),
      sd = sd(x, na.rm = TRUE)
    )
  }),
  recursive = F
),
.SDcols = c("dist_ph", "rrv_calc"), by = c("treat")
]

Fit GAM movement to data

library(mgcv)

mod1 <- gam(
  dist_ph ~ s(rrv_calc, k = 3),
  data = psdf
)

gratia::draw(mod1)

# save model summary
mod_summary <- summary(mod1)
writeLines(
  capture.output(
    mod_summary
  ),
  con = "data/results/mod_summary_swallow_movement.txt"
)
# make prediction table
pred_data <- CJ(
  sp = as.factor(unique(psdf$sp)),
  id = "new",
  rrv_calc = seq(0, 20, 0.5)
)

# get prediction
pred <- predict(mod1, newdata = pred_data, allow.new.levels = T, se.fit = T)

pred_data$pred <- pred$fit
pred_data$se <- pred$se.fit

# add species name
psdf2[, sp := "Hirundo"]

Plot movement over WGI

fig_swallow_dist <-
  ggplot(psdf2) +
  geom_jitter(
    data = psdf,
    aes(
      rrv_calc, dist_ph,
      col = treat
    ),
    shape = 1
  ) +
  # geom_ribbon(
  #   data = pred_data[rrv_calc < 15,],
  #   aes(
  #     rrv_calc,
  #     ymin = pred - se,
  #     ymax = pred + se
  #   ),
  #   fill = "transparent",
  #   col = "grey",
  #   lty = 1
  # )+
  # geom_line(
  #   data = pred_data[rrv_calc < 15,],
  #   aes(
  #     rrv_calc, pred
  #   ),
  #   col = "indianred"
  # )+
  geom_linerange(
    aes(
      x = rrv_calc.mean,
      ymin = dist_ph.mean - dist_ph.sd,
      ymax = dist_ph.mean + dist_ph.sd
    )
  ) +
  geom_linerange(
    aes(
      x = rrv_calc.mean,
      y = dist_ph.mean,
      xmin = rrv_calc.mean - rrv_calc.sd,
      xmax = rrv_calc.mean + rrv_calc.sd
    )
  ) +
  geom_point(
    aes(
      rrv_calc.mean, dist_ph.mean,
      fill = treat
    ),
    shape = 21,
    size = 3
  ) +
  facet_grid(
    rows = vars(sp),
    labeller = labeller(
      sp = c(
        "Hirundo" = "Barn swallow"
      )
    )
  ) +
  scale_fill_discrete_sequential(
    palette = "Batlow",
    l1 = 30, l2 = 60,
    breaks = c("NonMoulting", "Moulting", "Manipulated"),
    labels = c("Non-molting", "Molting", "Manipulated")
  ) +
  scale_colour_discrete_sequential(
    palette = "Batlow",
    l1 = 50, l2 = 50,
    guide = "none"
  ) +
  coord_cartesian(
    # ylim = c(0, NA)
  ) +
  theme_test(
    base_size = 10,
    base_family = "Arial"
  ) +
  theme(
    legend.position = "top",
    strip.background = element_blank(),
    strip.text = element_text(
      face = "italic"
    )
  ) +
  labs(
    x = "Wing gap index (More gappy wing →)",
    y = "Distance moved (km) / hr",
    fill = NULL
  )

# save
ggsave(
  fig_swallow_dist,
  filename = "figures/fig_02.png",
  height = 70, width = 87, units = "mm"
)


pratikunterwegs/holeybirds documentation built on Aug. 6, 2023, 8:53 a.m.