PatTrEnvDat Week 4

Author

Jannis Bolzern

Exercise A

Load Necessary Libraries

library("readr")
library("sf")
library("dplyr")
library("ggplot2")
library("tidyr")

Load the data

wildschwein <- read_delim("wildschwein_BE_2056.csv", ",")

Convert to an sf object and filter for Ruth

ruth <- wildschwein |>
  st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE) |>
  filter(
    TierName == "Ruth", 
    DatetimeUTC >= "2015-07-01", 
    DatetimeUTC < "2015-07-03"
  )

Function to calculate Euclidean distance

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

Calculate distances within the temporal window

ruth <- ruth |>
  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 minutes
    nPlus2  = distance_by_element(geometry, lead(geometry, 2))  # distance to pos +30 minutes
  )

ruth <- ruth |>
  rowwise() |>
  mutate(
    stepMean = mean(c(nMinus2, nMinus1, nPlus1, nPlus2), na.rm = TRUE)
  ) |>
  ungroup()

Define threshold as the mean of stepMean

threshold_d <- mean(ruth$stepMean, na.rm = TRUE)

Mark static points

ruth <- ruth |>
  mutate(static = stepMean < threshold_d)

ggplot(ruth, aes(E, N)) +
  geom_path(data = filter(ruth, !static), aes(color = static), size = 1) +
  geom_point(aes(color = static), size = 2) +
  scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) +
  labs(
    title = "Segmented Trajectory of Ruth (2015-07-01 to 2015-07-03)",
    x = "Easting (E)",
    y = "Northing (N)",
    color = "Static"
  ) +
  theme_minimal() +
  coord_fixed()

Function to assign unique IDs to segments

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

Assign segment IDs

ruth <- ruth |>
  mutate(segment_id = rle_id(static))

ggplot(ruth, aes(E, N)) +
  geom_path(aes(color = segment_id), size = 1) +
  geom_point(aes(color = segment_id), size = 2) +
  labs(
    title = "Segmented Trajectory of Ruth by Segment ID",
    x = "Easting (E)",
    y = "Northing (N)",
    color = "Segment ID"
  ) +
  theme_minimal() +
  coord_fixed()

ruth <- ruth |>
  group_by(segment_id) |>
  mutate(segment_duration = as.numeric(difftime(max(DatetimeUTC), min(DatetimeUTC), units = "mins"))) |>
           ungroup()

ruth_filtered <- ruth |>
  filter(segment_duration >= 60)

ggplot(ruth_filtered, aes(E, N)) +
  geom_path(aes(color = segment_id), size = 1) +
  geom_point(aes(color = segment_id), size = 2) +
  labs(
    title = "Filtered Trajectory of Ruth (Duration >= 60 Minutes)",
    x = "Easting (E)",
    y = "Northing (N)",
    color = "Segment ID"
  ) +
  theme_minimal() +
  coord_fixed()

#EXERCISE B

Load the dataset

pedestrian <- read_csv("pedestrian.csv")

Inspect the dataset

head(pedestrian)

# A tibble: 6 × 4
  TrajID        E        N DatetimeUTC        
   <dbl>    <dbl>    <dbl> <dttm>             
1      1 2571414. 1205804. 2015-03-01 12:01:00
2      1 2571396. 1205791. 2015-03-01 12:02:00
3      1 2571373. 1205770. 2015-03-01 12:03:00
4      1 2571347. 1205753. 2015-03-01 12:04:00
5      1 2571336. 1205744. 2015-03-01 12:05:00
6      1 2571321. 1205732. 2015-03-01 12:06:00

Convert to sf object

pedestrian_sf <- pedestrian |>
  st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE)

Plot all trajectories

ggplot(pedestrian_sf, aes(E, N, color = as.factor(TrajID))) +
  geom_path(size = 1) +   # Add the path lines
  geom_point(size = 2) +  # Add points for each position
  labs(
    title = "Pedestrian Trajectories",
    x = "Easting (E)",
    y = "Northing (N)",
    color = "Trajectory ID"
  ) +
  theme_minimal() +
  coord_fixed() +         # Ensure aspect ratio is fixed
  facet_wrap(~ TrajID)     # Create separate subplots for each TrajID

Load similarity measures

library("SimilarityMeasures")

Split the dataset into individual trajectories

traj_list <- split(pedestrian[, c("E", "N")], pedestrian$TrajID)

Convert each trajectory to a matrix

traj_list <- lapply(traj_list, as.matrix)

Extract Trajectory 1 and Trajectories 2-6

traj1 <- traj_list[[1]]
traj2 <- traj_list[[2]]
traj3 <- traj_list[[3]]
traj4 <- traj_list[[4]]
traj5 <- traj_list[[5]]
traj6 <- traj_list[[6]]

Calculate DTW (Dynamic Time Warping)

dtw_1_2 <- DTW(traj1, traj2)
dtw_1_3 <- DTW(traj1, traj3)
dtw_1_4 <- DTW(traj1, traj4)
dtw_1_5 <- DTW(traj1, traj5)
dtw_1_6 <- DTW(traj1, traj6)

Calculate EditDist (Edit Distance)

edit_1_2 <- EditDist(traj1, traj2)
edit_1_3 <- EditDist(traj1, traj3)
edit_1_4 <- EditDist(traj1, traj4)
edit_1_5 <- EditDist(traj1, traj5)
edit_1_6 <- EditDist(traj1, traj6)

Calculate Frechet Distance

frechet_1_2 <- Frechet(traj1, traj2)
frechet_1_3 <- Frechet(traj1, traj3)
frechet_1_4 <- Frechet(traj1, traj4)
frechet_1_5 <- Frechet(traj1, traj5)
frechet_1_6 <- Frechet(traj1, traj6)

Calculate LCSS

lcss_1_2 <- LCSS(traj1, traj2, pointSpacing = 1, pointDistance = 1, errorMarg = 1)
lcss_1_3 <- LCSS(traj1, traj3, pointSpacing = 1, pointDistance = 1, errorMarg = 1)
lcss_1_4 <- LCSS(traj1, traj4, pointSpacing = 1, pointDistance = 1, errorMarg = 1)
lcss_1_5 <- LCSS(traj1, traj5, pointSpacing = 1, pointDistance = 1, errorMarg = 1)
lcss_1_6 <- LCSS(traj1, traj6, pointSpacing = 1, pointDistance = 1, errorMarg = 1)

Create a data frame of similarity results

similarity_results <- data.frame(
  Trajectory = c("Traj2", "Traj3", "Traj4", "Traj5", "Traj6"),
  DTW = c(dtw_1_2, dtw_1_3, dtw_1_4, dtw_1_5, dtw_1_6),
  EditDist = c(edit_1_2, edit_1_3, edit_1_4, edit_1_5, edit_1_6),
  Frechet = c(frechet_1_2, frechet_1_3, frechet_1_4, frechet_1_5, frechet_1_6),
  LCSS = c(lcss_1_2, lcss_1_3, lcss_1_4, lcss_1_5, lcss_1_6)
)

Reshape the data to long format

similarity_long <- similarity_results |>
  pivot_longer(cols = -Trajectory, names_to = "Measure", values_to = "Similarity")

Create faceted plot with different colors for each measure

ggplot(similarity_long, aes(x = Trajectory, y = Similarity, fill = Measure)) +
  geom_bar(stat = "identity", position = "dodge") +
  facet_wrap(~ Measure, scales = "free_y") +  # Each measure has its own y-axis scale
  labs(
    title = "Similarity Between Trajectory 1 and Trajectories 2-6",
    x = "Trajectory",
    y = "Similarity Score",
    fill = "Measure"
  ) +
  scale_fill_manual(values = c("DTW" = "steelblue", "EditDist" = "darkorange", "Frechet" = "forestgreen", "LCSS" = "purple")) +  # Assign colors to measures
  theme_minimal() +
  theme(
    strip.text = element_text(size = 12, face = "bold"),  # Customize facet labels
    axis.text.x = element_text(angle = 45, hjust = 1)     # Rotate x-axis labels
  )