# libs for data library(data.table) library(lubridate) # library for atlas data library(atlastools)
List the files and remove swallows, as they need to be handled differently.
# list all preprocessed data files files <- list.files( "data/processed/data_preprocessed", pattern = "csv", full.names = T ) # remove swallow files files <- files[-grep("Hirundo", files)] # apply over a subsample # files = files[sample(length(files), 10)]
Apply a single speed filter on the smoothed data to remove positions faster than 1.5 m/s.
# apply to all data data <- lapply( files, function(file) { # read the file df <- fread(file) # select useful columns df <- df[, c("X", "Y", "time", "TAG", "date")] # handle time df[, time := ( as.POSIXct(time, origin = "1970-01-01", tz = "Asia/Jerusalem") )] # change colname from TAG to id setnames(df, old = "TAG", "id") # recalculate speeds and angles df[, c("speed", "angle") := list( atl_get_speed(df, x = "X", y = "Y"), atl_turning_angle(df, x = "X", y = "Y") )] # handle NAN angles from cosines method df[, angle := nafill(angle, fill = 0)] # smooth speed to hopefully remove small reflections df[, speed := runmed(speed, k = 3)] # calculate and print 90th percentile of speed print( glue::glue( "90th percentile speed = {quantile(df$speed, probs = 0.9)} m/s" ) ) # use a standard speed for now, 1.5m/s df <- df[speed < 1.5, ] df } )
# residence patch parameters buffer_radius_ <- 25 # metres lim_spat_indep_ <- 100 # metres # smaller lim_spat_indep for warblers lim_spat_indep_warbler_ <- 25 # metres lim_time_indep_ <- 30 # minutes min_fixes_ <- 9 # fixes
# split by date and handle warblers differently is_warbler <- grepl("Acrocephalus", files) patch_data <- Map( data, is_warbler, f = function(df, is_warbler_) { # split by date df <- split(df, by = "date") # apply the residence patch method patches <- lapply(df, function(d) { # make a copy --- slower but safer d_ <- data.table::copy(d) # select relevant columns d_ <- d[, c("X", "Y", "id", "time")] # names to lowercase setnames(d_, old = c("X", "Y"), new = c("x", "y")) lim_spat_indep_temp_ <- if (is_warbler_) { lim_spat_indep_warbler_ } else { lim_spat_indep_ } # apply method atl_res_patch( data = d_, buffer_radius = buffer_radius_, lim_spat_indep = lim_spat_indep_temp_, lim_time_indep = lim_time_indep_, min_fixes = min_fixes_ ) }) } )
Get residence patch summaries.
# run summary function over each list element patch_summaries <- lapply( # running over individuals patch_data, function(l) { # running over dates within individuals ps_df <- Map( l, names(l), f = function(le, n) { # get the summary patches_id_date <- atl_patch_summary( le, which_data = "summary" ) # add the date to the summary patches_id_date$date <- n # return summary patches_id_date } ) # return individual level as a single data frame rbindlist(ps_df) } ) # bind all individual level data frames together patch_summaries <- rbindlist(patch_summaries) # join with species and treatment data id_data <- fread("data/results/data_tracking_metrics_rrv.csv") patch_summaries <- merge(patch_summaries, id_data, by.x = "id", by.y = "TAG") fwrite(patch_summaries, file = "data/results/data_patch_summary_ppa.csv")
Get patch points.
# run summary function over each list element patch_points <- lapply( # running over individuals patch_data, function(l) { # running over dates within individuals ps_df <- Map( l, names(l), f = function(le, n) { # get the summary patches_id_date <- atl_patch_summary( le, which_data = "points" ) # add the date to the summary patches_id_date$date <- n # return summary patches_id_date } ) # return individual level as a single data frame rbindlist(ps_df) } ) # bind all individual level data frames together patch_points <- rbindlist(patch_points) patch_points <- merge(patch_points, id_data, by.x = "id", by.y = "TAG") fwrite(patch_points, file = "data/results/data_patch_points_ppa.csv") # save by species patch_points <- split(patch_points, by = "sp") Map( patch_points, names(patch_points), f = function(sp_df, name) { fwrite(sp_df, file = sprintf("data/results/data_patch_points_%s.csv", name)) } )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.