Exercise_4B

Exercise 4B

Libraries

library(pacman)
p_load(SimilarityMeasures)
p_load(readr)
p_load(sf)
p_load(dplyr)
p_load(ggplot2)
p_load(patchwork)

Task 1

Read df

ped <- read_delim("pedestrian.csv")

Rows: 289 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl  (3): TrajID, 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.

ped <- ped |> 
  st_as_sf(coords = c("E", "N"), crs = 2056, remove = FALSE) |> 
  mutate(
    trajID = as.factor(TrajID)
  )

Visualize Trajectories

ggplot(ped, aes(x = E, y = N, colour = trajID)) +
  geom_point() +
  geom_path(aes(E,N)) +
  facet_wrap(~ trajID) +  # Small multiples by 'group'
  theme_minimal()

Task 2: Calculate similarity

Inspect Similarity Measures package

help(package = "SimilarityMeasures")

Split trajcetories into matrices

tra1 <- ped |> 
  filter(trajID == 1) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()

tra2 <- ped |> 
  filter(trajID == 2) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()

tra3 <- ped |> 
  filter(trajID == 3) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()

tra4 <- ped |> 
  filter(trajID == 4) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()

tra5 <- ped |> 
  filter(trajID == 5) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()

tra6 <- ped |> 
  filter(trajID == 6) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()

With function

ped_asf <- function(data, trajnr) {
  tra <- data |> 
  filter(trajID == trajnr) |> 
  select(c(E,N)) |> 
  st_drop_geometry() |> 
  as.matrix()
}

tra1 <- ped_asf(ped,1)
tra2 <- ped_asf(ped,2)
tra3 <- ped_asf(ped,3)
tra4 <- ped_asf(ped,4)
tra5 <- ped_asf(ped,5)
tra6 <- ped_asf(ped,6)

Comparisons

Similarity Functions

help(package="SimilarityMeasures")

DTW

dtw12 <- DTW(tra1, tra2, pointSpacing=-1)
dtw13 <- DTW(tra1, tra3, pointSpacing=-1)
dtw14 <- DTW(tra1, tra4, pointSpacing=-1)
dtw15 <- DTW(tra1, tra5, pointSpacing=-1)
dtw16 <- DTW(tra1, tra6, pointSpacing=-1)

comp_dtw <- c("1-2", "1-3", "1-4", "1-5", "1-6")
dtw <- c(dtw12, dtw13, dtw14, dtw15, dtw16)

dtw_comp <- tibble(comp_dtw, dtw)

plot_dtw <- ggplot(dtw_comp, aes(x = comp_dtw, y = dtw)) +
              geom_col(aes(fill = comp_dtw)) + 
              ggtitle("DTW") +
              ylab("") +
              xlab("Comparison") +
              theme(
                legend.position = "none",  # Remove legend
                plot.title = element_text(hjust = 0.5)  # Center title
  )

EditDist

ED12 <- EditDist(tra1, tra2, pointDistance=20)
ED13 <- EditDist(tra1, tra3, pointDistance=20)
ED14 <- EditDist(tra1, tra4, pointDistance=20)
ED15 <- EditDist(tra1, tra5, pointDistance=20)
ED16 <- EditDist(tra1, tra6, pointDistance=20)

comp_ED <- c("1-2", "1-3", "1-4", "1-5", "1-6")
ED <- c(ED12, ED13, ED14, ED15, ED16)

ED_comp <- tibble(comp_ED, ED)

plot_ED <- ggplot(ED_comp, aes(x = comp_ED, y = ED)) +
  geom_col(aes(fill = comp_ED) ) +
  ggtitle("ED") +
              ylab("") +
              xlab("Comparison") +
              theme(
                legend.position = "none",  # Remove legend
                plot.title = element_text(hjust = 0.5)  # Center title
  )

Frechet

F12 <- Frechet(tra1, tra2, testLeash=-1)
F13 <- Frechet(tra1, tra3, testLeash=-1)
F14 <- Frechet(tra1, tra4, testLeash=-1)
F15 <- Frechet(tra1, tra5, testLeash=-1)
F16 <- Frechet(tra1, tra6, testLeash=-1)

comp_F <- c("1-2", "1-3", "1-4", "1-5", "1-6")
F <- c(F12, F13, F14, F15, F16)

F_comp <- tibble(comp_F, F)

plot_F <- ggplot(F_comp, aes(x = comp_F, y = F)) +
  geom_col(aes(fill = comp_F)) +
              ggtitle("F") +
              ylab("") +
              xlab("Comparison") +
              theme(
                legend.position = "none",  # Remove legend
                plot.title = element_text(hjust = 0.5)  # Center title
  )

LCSS

LCSS12 <- LCSS(tra1, tra2, pointSpacing=-1, pointDistance=20, 
     errorMarg=10, returnTrans=FALSE)
LCSS13 <- LCSS(tra1, tra3, pointSpacing=-1, pointDistance=20, 
     errorMarg=10, returnTrans=FALSE)
LCSS14 <- LCSS(tra1, tra4, pointSpacing=-1, pointDistance=20, 
     errorMarg=10, returnTrans=FALSE)
LCSS15 <- LCSS(tra1, tra5, pointSpacing=-1, pointDistance=20, 
     errorMarg=10, returnTrans=FALSE)
LCSS16 <- LCSS(tra1, tra6, pointSpacing=-1, pointDistance=20, 
     errorMarg=10, returnTrans=FALSE)

comp_LCSS <- c("1-2", "1-3", "1-4", "1-5", "1-6")
LCSS <- c(LCSS12, LCSS13, LCSS14, LCSS15, LCSS16)

LCSS_comp <- tibble(comp_LCSS, LCSS)

plot_LCSS <- ggplot(LCSS_comp, aes(x = comp_LCSS, y = LCSS)) +
  geom_col(aes(fill = comp_LCSS)) +
  ggtitle("LCSS") +
              ylab("") +
              xlab("Comparison") +
              theme(
                legend.position = "none",  # Remove legend
                plot.title = element_text(hjust = 0.5)  # Center title
  )

Visualize results

plot_list <- list(
  plot_dtw,
  plot_ED,
  plot_F,
  plot_LCSS
)

combined_plot <- plot_list[[1]] + plot_list[[2]] + plot_list[[3]] + plot_list[[4]] + plot_layout(ncol = 2)
combined_plot