#Setup
rm(list=ls())
library(sf)
library(tmap)
library(tidyverse)
library(ggplot2)
library(ggmap)
#Import Data
gesamte_tracks <- read_csv("gesamte_tracks.csv")Exercise_4
#change to sf-object
tracks <- st_as_sf(gesamte_tracks,
coords = c("Längengrad", "Breitengrad"),
crs = 4326)
#transform in right coordinate system
tracks_2056 <- st_transform(tracks, 2056)
#set map mode to view
tmap_mode("view")
# #visualize points
# tm_shape(tracks_2056) +
# tm_dots()
# #create lines between points
# tracks_sample_line <- tracks_2056 |>
# # dissolve to a MULTIPOINT:
# summarise(do_union = FALSE) |>
# st_cast("LINESTRING")
# #visualize lines + points
# tm_shape(tracks_sample_line) +
# tm_lines() +
# tm_shape(tracks_2056) +
# tm_dots()Exercise A
#select days to visualize
f_days <- tracks_2056 |>
filter(
Zeitstempel >= "2025-03-14",
Zeitstempel < "2025-03-17"
)
#visualize
tm_shape(f_days) +
tm_dots()#create lines between points
tracks_sample_line_days <- f_days |>
# dissolve to a MULTIPOINT:
summarise(do_union = FALSE) |>
st_cast("LINESTRING")
#visualize lines + points
tm_shape(tracks_sample_line_days) +
tm_lines() +
tm_shape(f_days) +
tm_dots()#distance function
distance_by_element <- function(later, now) {
as.numeric(
st_distance(later, now, by_element = TRUE)
)
}
#calculate distances
f_days <- f_days |>
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))
)
#calculate step mean
f_days <- f_days |>
rowwise() |>
mutate(
stepMean = mean(c(nMinus2, nMinus1, nPlus1, nPlus2))
) |>
ungroup()
#show results
f_daysSimple feature collection with 3772 features and 8 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: 2635149 ymin: 1198503 xmax: 2777641 ymax: 1262786
Projected CRS: CH1903+ / LV95
# A tibble: 3,772 × 9
Datei Zeitstempel Höhe geometry nMinus2 nMinus1
<chr> <dttm> <dbl> <POINT [m]> <dbl> <dbl>
1 GPX_Teil… 2025-03-14 08:07:32 666 (2726374 1249120) NA NA
2 GPX_Teil… 2025-03-14 08:08:00 663 (2725855 1249292) NA 547.
3 GPX_Teil… 2025-03-14 08:08:14 657 (2725571 1249271) 817. 285.
4 GPX_Teil… 2025-03-14 08:08:28 669 (2725343 1249350) 515. 242.
5 GPX_Teil… 2025-03-14 08:08:42 679 (2725181 1249260) 390. 185.
6 GPX_Teil… 2025-03-14 08:08:56 669 (2724986 1249212) 383. 201.
7 GPX_Teil… 2025-03-14 08:09:10 659 (2724788 1249164) 405. 204.
8 GPX_Teil… 2025-03-14 08:09:24 654 (2724619 1249089) 387. 185.
9 GPX_Teil… 2025-03-14 08:09:38 651 (2724477 1248963) 370. 189.
10 GPX_Teil… 2025-03-14 08:09:52 649 (2724328 1248831) 389. 200.
# ℹ 3,762 more rows
# ℹ 3 more variables: nPlus1 <dbl>, nPlus2 <dbl>, stepMean <dbl>#create column indicating if point is static or not
f_days <- f_days |>
mutate(static = stepMean < mean(stepMean, na.rm = TRUE))
#select static points
f_days_filter <- f_days |>
filter(!static)
#visulize static points (red) and moving points (black)
f_days_filter |>
ggplot() +
geom_sf(data = f_days, aes(geometry = geometry), color = "red") +
geom_sf(aes(geometry = geometry)) +
coord_sf() +
theme(legend.position = "bottom")
# #same but in tmap
# tm_shape(f_days) +
# tm_dots(col = NULL, fill = "red", size=0.6) +
# tm_shape(f_days_filter) +
# tm_dots(size=0.6) +
# tm_layout(legend.position = c("BOTTOM", "RIGHT"))#extract coordinates out of geometry
f_days <- f_days %>%
mutate(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2])
# visulize trajecotories
ggplot(data = f_days) +
geom_path(data = f_days %>% filter(static == FALSE), #create lines only if moving
aes(x = x, y = y, colour = as.factor(static)), size = 1) +
geom_point(aes(x = x, y = y, colour = as.factor(static)), size = 2) + # add points
coord_equal() +
scale_color_manual(values = c("TRUE" = "red", "FALSE" = "blue"),
labels = c("TRUE" = "Static", "FALSE" = "Moving")) +
theme_minimal() +
labs(title = "Trajectories",
x = "Longitude",
y = "Latitude",
colour = "Speed") 
# #visualization in tmap
# tm_shape(f_days) +
# tm_lines(data = f_days %>% filter(static == FALSE),
# col = "static",
# lwd = 2,
# palette = c("blue", "red"),
# title.col = "Speed") +
# tm_dots(col = "static",
# size = 0.5,
# palette = c("blue", "red"),
# title = "Speed") + # Punkte hinzufügen
# tm_layout(title = "segmented trajectories",
# legend.position = c("left", "bottom"))#custom function
rle_id <- function(vec) {
x <- rle(vec)$lengths
as.factor(rep(seq_along(x), times = x))
}
#create IDs
f_days <- f_days |>
mutate(segment_id = rle_id(static))#calculate number of points per segment
f_days <- f_days |>
group_by(segment_id) |>
mutate(segment_duration = n()) |>
ungroup()
#remove short segments
f_days_filtered <- f_days |>
filter(segment_duration >= 4)
# #visualization in tmap
# tm_shape(f_days_filtered) +
# tm_lines(data = f_days_filtered %>% filter(static == FALSE),
# col = "static",
# lwd = 2,
# col.scale = tm_scale(values = c("blue", "red")),
# col.legend = tm_legend(title = "Trajectories")) +
# tm_dots(col = "static",
# size = 0.5,
# palette = c("blue", "red"),
# title = "Speed") +
# tm_title("segmented trajectories") +
# tm_layout(legend.position = c("left", "bottom"))
#same but in GGPlot
ggplot(data = f_days_filtered) +
geom_path(data = f_days_filtered %>% filter(static == FALSE),
aes(x = x, y = y, colour = "Moving"), size = 1) +
geom_point(aes(x = x, y = y, colour = as.factor(static)), size = 2) +
scale_color_manual(values = c("TRUE" = "red", "FALSE" = "blue"),
labels = c("TRUE" = "Static", "FALSE" = "Moving")) +
coord_equal() +
theme_minimal() +
labs(title = "segmented trajectories",
x = "Longitude",
y = "Latitude",
colour = "Speed")