Large scale space use for bulbuls, sparrows, and reed warblers

Load libraries and prepare files

# 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)]

Remove transit positions

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 patches by date

# 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))
  }
)


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