Exercise 4

Libraries

library(pacman)
library(readr)
library(tidyverse)
library(sf)
library(gridExtra) 
p_load(tmap)

package 'tmap' successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\markv\AppData\Local\Temp\RtmpqMYDJF\downloaded_packages

Exercise 4A: Segmentation

Task 1: Calculating distances

Creating Dataset for wildboar Rosa withdata from 07.11.2014 to 09.11.2014

wildboars <- read_delim("Datasets/wildschwein_BE_2056.csv", ",")

rosa <- wildboars |> 
  st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE) |> 
  filter(
    TierName == "Rosa",
    DatetimeUTC >= "2014-11-07",
    DatetimeUTC < "2014-11-09"
  )

Creating distance function

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

Calculating distances

# Creating new columns for the positions, in order to calculate the euclidean distances
rosa <- rosa |> 
  mutate(
    nMinus2 = distance_by_element(lag(geometry, 2), geometry),
    nMinus1 = distance_by_element(lag(geometry, 1), geometry),
    nPlus1 = distance_by_element(geometry, lead(geometry, 1)),
    nPlus2 = distance_by_element(geometry, lead(geometry, 2))
  )

# Calculating euclidean distances
rosa <- rosa |> 
  rowwise() |>
  mutate(
    stepMean = mean(c(nMinus2, nMinus1, nPlus1, nPlus2), na.rm = TRUE)
  ) |> 
  ungroup()

Task 2: Specifying and applying threshold d

Creating the threshold values

threshold <- quantile(rosa$stepMean, probs = .75, na.rm = TRUE)

Creating Static column with boolean values

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

Task 3: Visualizing segmented trajectories

ggplot(rosa_filter, aes(E, N)) +
  geom_point() +
  geom_path() +
  geom_point(color = "blue") +
  coord_fixed() 

Task 4: Segment-based analysis

Function for creating ID for each segment

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

Creating IDs for Rosa trajectories

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

Visualizing movements through segment IDs

ggplot(rosa, aes(E, N, color = segment_id)) +
  geom_point(data = rosa_filter, color = "black") +
  geom_path() +
  coord_fixed() +
  theme_minimal()

Exercise 4B: Similarities

Dataset

pedestrian <- read_delim("Datasets/pedestrian.csv", ",")  
pedestrian$TrajID <- as.factor(pedestrian$TrajID)

Task 1: Similarity measures

Visualisation of the trajectories

ggplot(pedestrian, aes(E, N, color = TrajID)) +   
  geom_point() +  
  geom_path() +  
  coord_fixed() +  
  facet_wrap(~TrajID) +
  theme_minimal()

Task 2: Calculate similarity

install.packages("SimilarityMeasures") 

package 'SimilarityMeasures' successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\markv\AppData\Local\Temp\RtmpqMYDJF\downloaded_packages

library(SimilarityMeasures)

Creating matrixes from every single pedestrian

t1 <- pedestrian |>    filter(TrajID == 1) |>    select(c("E", "N"))  
t2 <- pedestrian |>    filter(TrajID == 2) |>    select(c("E", "N"))  
t3 <- pedestrian |>    filter(TrajID == 3) |>    select(c("E", "N"))  
t4 <- pedestrian |>    filter(TrajID == 4) |>    select(c("E", "N"))  
t5 <- pedestrian |>    filter(TrajID == 5) |>    select(c("E", "N"))  
t6 <- pedestrian |>    filter(TrajID == 6) |>    select(c("E", "N"))  

t1 <- as.matrix(t1) 
t2 <- as.matrix(t2) 
t3 <- as.matrix(t3) 
t4 <- as.matrix(t4) 
t5 <- as.matrix(t5) 
t6 <- as.matrix(t6)  

trajectories <- list(t2, t3, t4, t5, t6) 
names_trajectories <- c("t2", "t3", "t4", "t5", "t6")

Calculating similarities using DTW

dtw_values <- sapply(trajectories, function(t) DTW(t1, t,)) 
dtw_results <- data.frame(Trajectory = names_trajectories, Distance = dtw_values)

dtw_plot <- ggplot(dtw_results, aes(x = Trajectory, y = Distance, fill = Trajectory)) +   
  geom_bar(stat = "identity") +  
  theme_minimal() +   
  labs(title = "DTW", x = "Trajectories", y = "Distance DTW") 

Calculating similarities using Edit Distance (distance between sequence of coordinates)

edit_values <- sapply(trajectories, function(t) EditDist(t1, t))  
edit_results <- data.frame(Trajectory = names_trajectories, Distance = edit_values)   

edit_plot <- ggplot(edit_results, aes(x = Trajectory, y = Distance, fill = Trajectory)) +  
  geom_bar(stat = "identity") +  
  theme_minimal() +  
  labs(title = "Edit Distance", x = "Trajectories", y = "Edit Distance")  

Calculating similarities using Frechet Distance (Similarity between curves)

frechet_values <- sapply(trajectories, function(t) Frechet(t1, t))  
frechet_results <- data.frame(Trajectory = names_trajectories, Distance = frechet_values)   

frechet_plot <- ggplot(frechet_results, aes(x = Trajectory, y = Distance, fill = Trajectory)) +   
  geom_bar(stat = "identity") +   
  theme_minimal() +   
  labs(title = "Frechet", x = "Trajectories", y = "Frechet Distance")

Calculating similarities using LCSS (Longest Common Subsequence Similarity)

lcss_values <- sapply(trajectories, function(t) SimilarityMeasures::LCSS(t1, t, 0.5))  
lcss_results <- data.frame(Trajectory = names_trajectories, Distance = lcss_values)   
lcss_plot <- ggplot(lcss_results, aes(x = Trajectory, y = Distance, fill = Trajectory)) +   
  geom_bar(stat = "identity") +  
  theme_minimal() +  
  labs(title = "LCSS", x = "Trajectories", y = "Distance LCSS")  

Visualizing the 4 plots with the different methods.

grid.arrange(dtw_plot, edit_plot, frechet_plot, lcss_plot, ncol = 2)