wee4_excercise A

Week 4, Excercise A

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

p_install("dplyr", force = FALSE)
Package is already on your system.
p_install("ggplot2", force = FALSE)
Package is already on your system.
p_install("readr", force = FALSE)
Package is already on your system.
p_install("tidyr", force = FALSE)
Package is already on your system.
p_install("sf", force = FALSE)
Package is already on your system.
p_install("terra", force = FALSE)
Package is already on your system.
p_install("tmap", force = FALSE)
Package is already on your system.
p_install("zoo", force = FALSE)
Package is already on your system.
p_install("units", force = FALSE)
Package is already on your system.
p_install("plotly", force = FALSE)
Package is already on your system.
p_install("patchwork", force = FALSE)
Package is already on your system.
library("ggplot2")
library("dplyr")

Attache Paket: 'dplyr'
Die folgenden Objekte sind maskiert von 'package:stats':

    filter, lag
Die folgenden Objekte sind maskiert von 'package:base':

    intersect, setdiff, setequal, union
library("readr")
library("sf")
Linking to GEOS 3.13.0, GDAL 3.10.1, PROJ 9.5.1; sf_use_s2() is TRUE
library("readr")
library("sf")
library(lubridate)

Attache Paket: 'lubridate'
Die folgenden Objekte sind maskiert von 'package:base':

    date, intersect, setdiff, union

Task 1: Import data

wildschwein <- read_delim("wildschwein_BE_2056.csv", ",")
Rows: 51246 Columns: 6
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (2): TierID, TierName
dbl  (3): CollarID, E, N
dttm (1): DatetimeUTC

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
wildschwein |>
  group_by(TierName) |>
  summarise(
    max(DatetimeUTC)
  )
# A tibble: 3 × 2
  TierName `max(DatetimeUTC)` 
  <chr>    <dttm>             
1 Rosa     2015-06-29 23:45:11
2 Ruth     2015-07-27 09:45:15
3 Sabi     2015-07-27 11:00:14
# Careful! What Timezone is assumed? remove = false = we don't want the other columns to be removed. 
rosa <- wildschwein |>
  st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE) |>
  filter(
    TierName == "Rosa", 
    DatetimeUTC >= "2014-12-31", 
    DatetimeUTC < "2015-01-29"
  )


ggplot(rosa) +
  geom_sf()+
  geom_path(aes(E, N))

Task 1: Calculate distances

a): Specify a temporal window v and Step b): Measure the distance to every point within v, which you had used with sabi, on on your own movement data or to a different wild boar using different sampling intervals.

distance_by_element <- function(later, now) {
  as.numeric(
    st_distance(later, now, by_element = TRUE)
  )
}


rosa <- rosa |>
    mutate(
        nMinus2 = distance_by_element(lag(geometry, 2), geometry),  # distance to pos -30 minutes
        nMinus1 = distance_by_element(lag(geometry, 1), geometry),  # distance to pos -15 minutes
        nPlus1  = distance_by_element(geometry, lead(geometry, 1)), # distance to pos +15 mintues
        nPlus2  = distance_by_element(geometry, lead(geometry, 2))  # distance to pos +30 minutes
    )

Task 2: Specify and apply threshold d

rosa <- rosa |>
  rowwise() |>
  mutate(stepMean = mean(c(nMinus2, nMinus1, nPlus1, nPlus2))) |>
  ungroup()

threshold = mean(rosa$stepMean, na.rm = TRUE)

rosa <- rosa |>
  mutate(static = stepMean < threshold)

Task 3: Visualize segmented trajectories

rosa |>
  ggplot(aes(x = E, y = N, colour = static)) +
  geom_path() +
  geom_point() +
  coord_equal() +
  theme(legend.position = "bottom")

Task 4: Segment-based analysis

rle_id <- function(vec) {
    x <- rle(vec)$lengths
    as.factor(rep(seq_along(x), times = x))
}
rosa <- rosa |>
  mutate(segment_id = rle_id(static)) |>
  mutate(timestamp = as.POSIXct(DatetimeUTC))

rosa_moving <- rosa |>
    filter(!static)

ggplot(rosa_moving) + 
  geom_sf() +
  geom_path(aes(E, N, color=segment_id))