Exercise A: Segmentation

library(readr)
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(ggplot2)
library(sf)

Linking to GEOS 3.14.1, GDAL 3.12.1, PROJ 9.7.1; sf_use_s2() is TRUE

# 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.

Task 1: Calculate distances

Step a): Specify a temporal window v

The sampling interval is 15 minutes. For a temporal window of 60 minutes, that would mean including 4 fixes.

Step b): Measure the distance to every point within v

# Wild boar Rosa
rosa <- wildschwein |>
    st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE) |>
    filter(
      TierName == "Rosa",
      DatetimeUTC >= "2014-11-07",
      DatetimeUTC < "2014-11-17"
      )

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

# calculate the Euclidean distance
#For each offset, one individual column.
distance_by_element <- function(later, now) {
  as.numeric(
    st_distance(later, now, by_element = TRUE)
  )
}


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

# calculate the mean distance of nMinus2, nMinus1, nPlus1, nPlus2 for each row
rosa <- rosa |>
    rowwise() |>
    mutate(
        stepMean = mean(c(nMinus2, nMinus1, nPlus1, nPlus2))
    ) |>
    ungroup()

rosa <- rosa |>
  rowwise() |> 
    mutate(static = stepMean < mean(stepMean, na.rm = TRUE)) |> 
  ungroup()

Task 2: Specify and apply threshold d

#threshold. For  a simple approch we`ll use the mean value as a threshold
threshold <- mean(rosa$stepMean, na.rm = TRUE)

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

Task 3: Visualize segmented trajectories

ggplot(rosa) +
  geom_path(aes(E,N)) +
  geom_sf(aes(color = static)) +
  coord_sf(datum = 2056) +
  theme(legend.position = "none")

Task 4: Segment-based analysis

# function
rle_id <- function(vec) {
    x <- rle(vec)$lengths
    as.factor(rep(seq_along(x), times = x))
}

# unique IDs to subtrajectories
rosa <- rosa |>
    mutate(segment_id = rle_id(static))

# segment_ID as a grouping variable to determine the segments duration and remove short segments < 5 
rosa <- rosa |> 
  group_by(segment_id) |> 
  mutate(duration = as.numeric(max(DatetimeUTC) - min(DatetimeUTC), unit = "mins")) |> 
  filter(duration >= 5) |> 
  ungroup()

ggplot(rosa) +
  geom_path(aes(E,N)) +
  geom_sf(aes(color = segment_id))+
  coord_sf(datum = 2056) +
  theme(legend.position = "none")