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"))
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]
# 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") ]
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"]
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" )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.