Projektarbeit im Modul Patterns & Trends in Environmental Data FS25
library(dplyr)
library(tidyverse)
library(future.apply)
library(geosphere)
library(ggplot2)
library(ggsci)
library(pheatmap)
library(readr)
library(scales)
library(sf)
library(SimilarityMeasures)
library(stars)
library(tidyverse)
library(tmap)
library(purrr)
library(ggspatial)
library(viridis)
library(RColorBrewer)
library(leaflet)Text
Students have mastered the theory and use it for their argument, with references • Students show understanding of theory
What has been done in terms of literature review?
In dieser Projektarbeit untersuchen wir das Flugverhalten von Brieftauben auf Grundlage hochaufgelöster GPS-Daten. Mithilfe von Sinuosität, Geschwindigkeitsanalysen und Ähnlichkeitsmassen vergleichen wir die unterschiedlichen Flugphasen und Flugrouten. Zusätzlich analysieren wir das «Lead and Follow»-Muster innerhalb des Taubenschwarms. Ziel ist es, wiederkehrende Bewegungsmuster durch die Anwendung verschiedener Analysekonzepte zu identifizieren.
Das Ziel der Projektarbeit ist die Untersuchung der folgenden Forschungsfragen:
Wie lassen sich Flugbahnen von Brieftauben anhand von Sinuosität und Ähnlichkeitsmassen konzeptualisieren und vergleichen?
Gibt es wiederkehrende Muster in der Fluggeschwindigkeit von Brieftauben über unterschiedliche Flugphasen und wie können diese quantifiziert werden?
Kann in den Bewegungsmustern von Brieftauben eine «Lead and Follow»-Dynamik identifiziert werden?
Wir erwarten, dass die Brieftauben in der Nähe der Freilassungsstelle und des Taubenschlags eine kurvenreiche Flugbahn mit hoher Sinuosität zeigen [@laube2007] und nach einer Anfangsphase geradliniger und mit höherer Geschwindigkeit fliegen [@schiffner2009]. Trotz der leicht unterschiedlichen Freilassungsstellen und variierenden Flugrouten wird er- wartet, dass die aufgenommenen Flüge aufgrund ähnlicher Flugmuster hohe Ähnlichkeitsmasse aufweisen. Zudem erwarten wir, dass es innerhalb des Taubenschwarms Individuen gibt, welche deutlich häufiger die Führung des Schwarms übernehmen [@nagy2010].
Für die Bearbeitung der Forschungsfragen gehen wir wie folgt vor:
Datenaufbereitung und Resampling (Auflösung auf eine Sekunde hochskalieren)
Filterung des Datensatz auf die zu untersuchenden Individuen und Flüge:
Aufteilung und Bearbeitung der Forschungsfragen in R in die vier Teilanalysen zu den Themen Sinuosität, Ähnlichkeit, Geschwindigkeit und «Lead and Follow»
Wir verwenden einen Datensatz mit Bewegungsdaten zum Flugverhalten von Brieftauben aus dem Paper von [@santos2014]. Der Datensatz enthält GPS-Daten von fünf Heimflügen, die jeweils mit denselben 9-10 Individuen über einen Zeitraum von 12 Tagen durchgeführt wurden. Die Daten sind über die gesamte Flugzeit von durchschnittlich 15 bis 20 Minuten hochaufgelöst mit einer Lokalisierung jede Viertelsekunde pro Individuum. Die Fragestellungen beantworten wir mit den folgenden Attributen aus dem beschriebenen Datensatz: Zeitstempel, Koordinaten, Flugnummer und Individuum-Nummer. Der Datensatz enthält zusätzlich für jede Messung Angaben zur Flughöhe über dem Referenzellipsoid und der Fluggeschwindigkeit.
Resampling kurz begründen/erklären.
Die angegebene Fluggeschwindigkeit wird zur maximalen Kontrolle und Transparenz [@laube2014] nicht verwendet und selbst aus den Daten berechnet.
Begrenzung auf Flug 4 und Individuum «S» begründen / erklären.
Begrenzung unserer Berechnungen auf den zweidimensionalen Raum
Weitere Informationen / Erkenntnisse unsererseits zu den Daten: - Flugrichtung - Start und Ende der Flüge wurden aus dem Datensatz entfernt.
Für die Auswertung werden keine zusätzlichen Daten benötigt.
Der Datensatz von Santos et al. 2014 ist öffentlich über die Movebank Plattform [@kays2022] erhältlich.
# CSV-Datei importieren
Flugdaten = read_delim("Leadership in homing pigeon flocks.csv")
# Aufteilung in separate Flüge
Flugliste = split(Flugdaten, Flugdaten$comments)
for (name in names(Flugliste)) {
assign(paste0(name), Flugliste[[name]])
}
# Umbenennen der Data Frames
alte_namen <- ls(pattern = "^homing flight [1-5]$")
for (name in alte_namen) {
nummer <- strsplit(name, " ")[[1]][3]
neuer_name <- paste0("flug", nummer)
assign(neuer_name, get(name))
rm(list = name)
}
# Resample auf 1-Sekunden-Intervalle
resample <- function(df) {
gemeinsame_zeiten <- Reduce(intersect, split(df$timestamp, df$`tag-local-identifier`))
df |>
filter(timestamp %in% gemeinsame_zeiten) |>
group_by(`tag-local-identifier`) |>
arrange(timestamp) |>
mutate(rn = row_number()) |>
filter(rn %% 4 == 1) |>
ungroup() |>
select(-rn) |>
arrange(`tag-local-identifier`, timestamp)
}
# Anwenden auf alle Flüge
for (n in ls(pattern = "^flug[1-5]$")) {
assign(paste0(n, "_resample"), resample(get(n)))
}Die Daten liegen in hoher zeitlicher Auflösung mit Messwerten alle 0,25 Sekunden vor. Für die statistischen Analysen wird die Datenmenge durch Resampling auf eine Messung pro Sekunde reduziert. Dabei werden nur jene Zeitpunkte berücksichtigt, die bei allen Individuen eines Flugs vorhanden sind, um eine vergleichbare zeitliche Basis sicherzustellen.
# Analyse wird vereinfacht durchgeführt mit: Flug 4, Individuum "S"
Alle <- read_delim("Alle_Fluege_resample.csv")
Flug_4 <- Alle |>
filter(comments == "homing flight 4")
Ind_S <- Alle |>
filter(`individual-local-identifier` == "S")Zur Vereinfachung und Fokussierung der Analyse wurde aus den fünf verfügbaren Flügen zufällig ein einzelner Flug (Flug 4) ausgewählt, um die Flugtrajektorien der verschiedenen Individuen miteinander zu vergleichen. Analog dazu wurde für den Vergleich über alle fünf Flüge hinweg ein einzelnes Individuum (Individuum S) zufällig gewählt. Dies ermöglicht eine exemplarische Analyse im gegebenen zeitlichen und methodischen Rahmen und hält den Umfang der Untersuchung klar definiert.
Hier Bild Ausschnitt von Laupe 2014 «Moving Window» einfügen
Alle <- read_delim("Alle_Fluege_resample.csv")
# Functions moving windows
difftime_secs <- function(x, y){
as.numeric(difftime(x, y, units = "secs"))
}
distance_by_element <- function(later, now){
as.numeric(
st_distance(later, now, by_element = TRUE)
)
}
# SF Object ---------------------
Alle_geschw <- Alle |>
st_as_sf(coords = c('location-lat', 'location-long'), crs = 4326) |>
select('event-id', timestamp)
# Calculate speed at scale 1 (2s = offset 1) ---------------
# 1. timelag:
now <- Alle_geschw$timestamp
prev <- lag(now)
later <- lead(now)
Alle_geschw <- Alle_geschw |>
mutate(
timelag = difftime_secs(later, prev)
)
# 2. steplenght:
now <- Alle_geschw$geometry
prev <- lag(now)
later <- lead(now)
Alle_geschw <- Alle_geschw |>
mutate(
steplenght = distance_by_element(later, prev)
)
# 3. speed:
Alle_geschw <- Alle_geschw |>
mutate(
speed_2s = steplenght/timelag,
speed_2s = ifelse(speed_2s < 0, NA, speed_2s)
)
## Calculate speed at scale 2 (4s = offset 2) --------------
# 1. timelag:
now <- Alle_geschw$timestamp
prev <- lag(lag(now))
later <- lead(lead(now))
Alle_geschw <- Alle_geschw |>
mutate(
timelag2 = difftime_secs(later, prev)
)
# 2. steplenght:
now <- Alle_geschw$geometry
prev <- lag(lag(now))
later <- lead(lead(now))
Alle_geschw <- Alle_geschw |>
mutate(
steplenght2 = distance_by_element(later, prev)
)
# 3. speed:
Alle_geschw <- Alle_geschw |>
mutate(
speed_4s = steplenght2/timelag2,
speed_4s = ifelse(speed_4s < 0, NA, speed_4s)
)
## Calculate speed at scale 3 (8s = offset 4) -------------
# 1. timelag:
now <- Alle_geschw$timestamp
prev <- lag(now, n = 4) # use n = ... rather than lag(lag(...)).
later <- lead(now, n = 4)
Alle_geschw <- Alle_geschw |>
mutate(
timelag3 = difftime_secs(later, prev)
)
# 2. steplenght:
now <- Alle_geschw$geometry
prev <- lag(now, n = 4)
later <- lead(now, n = 4)
Alle_geschw <- Alle_geschw |>
mutate(
steplenght3 = distance_by_element(later, prev)
)
# 3. speed:
Alle_geschw <- Alle_geschw |>
mutate(
speed_8s = steplenght3/timelag3,
speed_8s = ifelse(speed_8s < 0, NA, speed_8s)
)
## Compare speed across scales ---------------
# Alle_geschw |>
# st_drop_geometry() |>
# select(timestamp, speed_2s, speed_4s, speed_8s)
# To compare with ggplot (Boxplots), we need a long format:
Alle_geschw_2 <- Alle_geschw |> # simplify dataframe
st_drop_geometry() |>
select(timestamp, speed_2s, speed_4s, speed_8s)
Alle_geschw_long <- Alle_geschw_2 |> # pivot long
pivot_longer(c(speed_2s, speed_4s, speed_8s))
# # ggplot:
# ggplot(Alle_geschw_long, aes(name, value)) +
# # we remove outliers to increase legibility, analogue
# # Laube and Purves (2011)
# geom_boxplot(outliers = FALSE) +
# labs(x = "Type of speed-(window)", y = "speed [m/s]") +
# theme_classic()
# Join back to Alle Dataset:
Alle_geschw_subset <- Alle_geschw |>
st_drop_geometry() |>
select('event-id', speed_2s, speed_4s, speed_8s)
# Left Join anhand der event-id
Alle <- Alle |>
left_join(Alle_geschw_subset, by = 'event-id')
Alle_geschw_comp <- Alle |>
select('event-id', timestamp, 'ground-speed', 'individual-local-identifier', speed_2s, speed_4s, speed_8s)
# ggplot:
Alle_geschw_long <- Alle |> # pivot long
pivot_longer(c('ground-speed', speed_2s, speed_4s, speed_8s))Die berechneten Geschwindigkeiten (speed_2s bis speed_8s) unterschieden sich signifikant von der Logger-Geschwindigkeit (ground-speed). Diese Differenz kann durch die vernachlässigte Dimension der Höhe sowie die unterschiedliche Schätzung/Berechnung der Geschwindigkeit im Vergleich zum GPS-Logger erklärt werden.
ggplot(Alle_geschw_long, aes(name, value)) +
# we remove outliers to increase legibility, analogue
# Laube and Purves (2011)
geom_boxplot(outliers = FALSE) +
labs(x = "Type of speed", y = "speed [m/s]") +
theme_classic()
Die durch die “Moving-Window-Methode” berechneten Geschwindigkeiten unterscheiden sich untereinander kaum. Die mittlere Geschwindigkeit nimmt vom “Window” von zwei Sekunden im Vergleich zum “Window” von acht Sekunden geringfügig etwas ab.
Alle <- Alle |>
mutate(`ground-speed` = speed_4s) |> # ground-speed überschreiben
select(-starts_with("speed_")) # alle anderen speed-Spalten löschenFür die weitere Analysen wird mit der Geschwindigkeit vom “Moving-Window” von vier Sekunden weitergearbeitet.
# -----------------------------------------------------------------------------
# Ähnlichkeitsmetriken
# -----------------------------------------------------------------------------
library(tidyverse)
library(SimilarityMeasures)
library(readr)
library(dplyr)
library(pheatmap)
library(sf)
library(future.apply)
# -----------------------------------------------------------------------------
# Daten laden
# -----------------------------------------------------------------------------
flug4 <- read_delim("flug4_resample.csv")
individuals <- unique(flug4$`tag-local-identifier`)
S_fluege <- read_delim("Alle_Fluege_resample.csv") %>%
filter(`tag-local-identifier` == "S")
# -----------------------------------------------------------------------------
# DTW Flug 4
# -----------------------------------------------------------------------------
# Messwerte
n_points <- 250
# Resample und Projektion
resample_traj <- function(id) {
coords <- flug4 |>
filter(`tag-local-identifier` == id) |>
select(`location-long`, `location-lat`) |>
as.matrix()
if (nrow(coords) < 2) return(NA)
traj <- st_linestring(coords) %>%
st_sfc(crs = 4326) %>%
st_transform(crs = 2056)
if (as.numeric(st_length(traj)) == 0) return(NA)
sampled_points <- st_line_sample(traj, sample = seq(0, 1, length.out = n_points))
st_coordinates(sampled_points)
}
# Trajektorienliste erstellen
trajectories <- setNames(lapply(individuals, resample_traj), individuals)
# DTW-Distanzmatrix berechnen
n <- length(trajectories)
dtw_matrix <- matrix(NA, n, n, dimnames = list(individuals, individuals))
for (i in 1:n) {
for (j in i:n) {
ti <- trajectories[[i]]
tj <- trajectories[[j]]
if (is.matrix(ti) && is.matrix(tj)) {
if (i == j) {
dtw_matrix[i, j] <- 0
} else {
dist <- DTW(ti, tj, pointSpacing = -1)
dtw_matrix[i, j] <- dtw_matrix[j, i] <- dist
}
}
}
}
# Skalierung
dtw_matrix_scaled <- dtw_matrix / max(dtw_matrix, na.rm = TRUE)
# Heatmap erstellen
pheatmap(dtw_matrix_scaled,
main = "DTW – Flug 4 (Sample 250, ohne log)",
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
# -----------------------------------------------------------------------------
# DTW Individuum S
# -----------------------------------------------------------------------------
# Messwerte
n_points <- 250
# Trajektorienliste erstellen
fluege <- unique(S_fluege$comments)
fluege_kurz <- paste("flug", seq_along(fluege))
traj_list <- setNames(lapply(fluege, function(flugname) {
coords <- S_fluege %>%
filter(comments == flugname) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
coords
}), fluege_kurz)
# DTW-Distanzmatrix berechnen
n <- length(traj_list)
dtw_matrix <- matrix(NA, n, n, dimnames = list(fluege_kurz, fluege_kurz))
for (i in 1:n) {
for (j in i:n) {
ti <- traj_list[[i]]
tj <- traj_list[[j]]
if (is.matrix(ti) && is.matrix(tj)) {
if (i == j) {
dtw_matrix[i, j] <- 0
} else {
dist <- DTW(ti, tj, pointSpacing = -1)
dtw_matrix[i, j] <- dtw_matrix[j, i] <- dist
}
}
}
}
# Skalierung auf 0–1
dtw_matrix_scaled <- dtw_matrix / max(dtw_matrix, na.rm = TRUE)
# Heatmap erstellen
pheatmap(dtw_matrix_scaled,
main = "DTW Individuum S (Sample 250, ohne log)",
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
# -----------------------------------------------------------------------------
# EditDist Flug 4
# -----------------------------------------------------------------------------
# Messwerte
n_points <- 250
# Resample- und Projektionsfunktion
resample_traj <- function(id) {
coords <- flug4 %>%
filter(`tag-local-identifier` == id) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
if (nrow(coords) < 2) return(NA)
traj <- st_linestring(coords) %>%
st_sfc(crs = 4326) %>%
st_transform(crs = 2056)
if (as.numeric(st_length(traj)) == 0) return(NA)
sampled_points <- st_line_sample(traj, sample = seq(0, 1, length.out = n_points))
st_coordinates(sampled_points)
}
# Trajektorienliste erstellen
traj_list <- setNames(lapply(individuals, resample_traj), individuals)
# EditDist-Distanzmatrix berechnen
n <- length(traj_list)
edit_matrix <- matrix(NA, n, n, dimnames = list(individuals, individuals))
for (i in 1:n) {
for (j in i:n) {
ti <- traj_list[[i]]
tj <- traj_list[[j]]
if (is.matrix(ti) && is.matrix(tj)) {
if (i == j) {
edit_matrix[i, j] <- 0
} else {
dist <- EditDist(ti, tj)
normed <- dist / n_points
edit_matrix[i, j] <- edit_matrix[j, i] <- normed
}
}
}
}
# Heatmap erstellen
pheatmap(edit_matrix,
main = "EditDist – Flug 4 (Sample 250, ohne log)",
color = colorRampPalette(c("blue", "lightblue", "salmon", "red"))(100),
na_col = "grey90",
breaks = seq(0, 1, length.out = 101))
# -----------------------------------------------------------------------------
# EditDist Individuum S
# -----------------------------------------------------------------------------
# Messwerte
n_points <- 250
# Trajektorienliste erstellen
fluege <- unique(S_fluege$comments)
fluege_kurz <- paste("flug", 1:5)
# Resample- und Projektionsfunktion
resample_traj <- function(flugname) {
coords <- S_fluege %>%
filter(comments == flugname) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
if (nrow(coords) < 2) return(NA)
traj <- st_linestring(coords) %>%
st_sfc(crs = 4326) %>%
st_transform(crs = 2056)
if (as.numeric(st_length(traj)) == 0) return(NA)
sampled_points <- st_line_sample(traj, sample = seq(0, 1, length.out = n_points))
st_coordinates(sampled_points)
}
# Trajektorienliste erstellen
traj_list <- setNames(lapply(fluege, resample_traj), fluege_kurz)
# EditDist-Distanzmatrix berechnen
n <- length(traj_list)
edit_matrix <- matrix(NA, n, n, dimnames = list(fluege_kurz, fluege_kurz))
for (i in 1:n) {
for (j in i:n) {
ti <- traj_list[[i]]
tj <- traj_list[[j]]
if (is.matrix(ti) && is.matrix(tj)) {
if (i == j) {
edit_matrix[i, j] <- 0
} else {
dist <- EditDist(ti, tj)
normed <- dist / max(nrow(ti), nrow(tj))
edit_matrix[i, j] <- edit_matrix[j, i] <- normed
}
}
}
}
# Heatmap erstellen
pheatmap(edit_matrix,
main = "EditDist Individuum S (Sample 250, ohne log)",
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
# -----------------------------------------------------------------------------
# Frechet Distance Flug 4
# -----------------------------------------------------------------------------
# Downsampling-Funktion
get_projected_downsampled_matrix <- function(coords, n_points = 250) {
if (nrow(coords) < 2) return(matrix(NA, nrow = 0, ncol = 2))
line <- st_linestring(coords)
sfc <- st_sfc(line, crs = 4326)
sfc_proj <- st_transform(sfc, crs = 2056)
line_proj <- st_cast(sfc_proj, "LINESTRING")
len <- st_length(line_proj)
if (as.numeric(len) == 0) return(matrix(NA, nrow = 0, ncol = 2))
fractions <- seq(0, 1, length.out = n_points)
sampled_points <- st_line_sample(line_proj, sample = fractions * as.numeric(len))
st_coordinates(sampled_points)
}
# Trajektorien aufbereiten
trajectories <- lapply(individuals, function(id) {
coords <- flug4 %>%
filter(`tag-local-identifier` == id) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
get_projected_downsampled_matrix(coords, n_points = 250)
})
names(trajectories) <- individuals
# Fréchet-Distanzen berechnen
n <- length(trajectories)
frechet_matrix <- matrix(NA, nrow = n, ncol = n)
rownames(frechet_matrix) <- individuals
colnames(frechet_matrix) <- individuals
pb <- txtProgressBar(min = 0, max = n, style = 3)
for (i in 1:n) {
for (j in i:n) {
traj_i <- trajectories[[i]]
traj_j <- trajectories[[j]]
if (nrow(traj_i) >= 2 && nrow(traj_j) >= 2) {
d <- if (i == j) 0 else Frechet(traj_i, traj_j)
frechet_matrix[i, j] <- d
frechet_matrix[j, i] <- d
}
}
setTxtProgressBar(pb, i)
}
close(pb)
# Log-Transformation
frechet_matrix_log <- log1p(frechet_matrix)
frechet_matrix_scaled <- frechet_matrix_log / max(frechet_matrix_log, na.rm = TRUE)
# Visualisierung als Heatmap
pheatmap(frechet_matrix_scaled,
main = "Fréchet – Flug 4 (Sample 250, log-transformiert)",
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100))
# -----------------------------------------------------------------------------
# Frechet Distance Flug 4 - Vergleich mit DTW
# -----------------------------------------------------------------------------
# Downsampling-Funktion
get_projected_downsampled_matrix <- function(coords, n_points = 250) {
if (nrow(coords) < 2) return(matrix(NA, nrow = 0, ncol = 2))
line <- st_linestring(coords)
sfc <- st_sfc(line, crs = 4326)
sfc_proj <- st_transform(sfc, crs = 2056)
line_proj <- st_cast(sfc_proj, "LINESTRING")
len <- st_length(line_proj)
if (as.numeric(len) == 0) return(matrix(NA, nrow = 0, ncol = 2))
fractions <- seq(0, 1, length.out = n_points)
sampled_points <- st_line_sample(line_proj, sample = fractions * as.numeric(len))
st_coordinates(sampled_points)
}
# Trajektorien aufbereiten
trajectories <- lapply(individuals, function(id) {
coords <- flug4 %>%
filter(`tag-local-identifier` == id) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
get_projected_downsampled_matrix(coords, n_points = 250)
})
names(trajectories) <- individuals
# Fréchet-Distanzen berechnen
n <- length(trajectories)
frechet_matrix <- matrix(NA, nrow = n, ncol = n)
rownames(frechet_matrix) <- individuals
colnames(frechet_matrix) <- individuals
pb <- txtProgressBar(min = 0, max = n, style = 3)
for (i in 1:n) {
for (j in i:n) {
traj_i <- trajectories[[i]]
traj_j <- trajectories[[j]]
if (nrow(traj_i) >= 2 && nrow(traj_j) >= 2) {
d <- if (i == j) 0 else Frechet(traj_i, traj_j)
frechet_matrix[i, j] <- d
frechet_matrix[j, i] <- d
}
}
setTxtProgressBar(pb, i)
}
close(pb)
# Log-Transformation & Skalierung
frechet_matrix_log <- log1p(frechet_matrix)
frechet_matrix_scaled <- frechet_matrix_log / max(frechet_matrix_log, na.rm = TRUE)
# Reihenfolge wie DTW-Heatmap
dtw_order <- c("N", "Q", "M", "U", "S", "P", "R", "O", "T")
frechet_matrix_sorted <- frechet_matrix_scaled[dtw_order, dtw_order]
# Visualisierung als Heatmap
pheatmap(frechet_matrix_sorted,
main = "Fréchet-Distanzen – Flug 4 (Sample 250, log-transformiert, DTW-Reihenfolge)",
cluster_rows = FALSE,
cluster_cols = FALSE,
color = colorRampPalette(c("blue", "mistyrose", "red"))(100))
# -----------------------------------------------------------------------------
# Frechet-Distance Individuum S
# -----------------------------------------------------------------------------
# Parameter
n_points <- 250
# Trajektorienliste erstellen
fluege <- unique(S_fluege$comments)
fluege_kurz <- paste("flug", seq_along(fluege))
# Resample- und Projektionsfunktion
get_projected_downsampled_matrix <- function(coords, n_points = 250) {
if (nrow(coords) < 2) return(matrix(NA, nrow = 0, ncol = 2))
line <- st_linestring(coords)
sfc <- st_sfc(line, crs = 4326)
sfc_proj <- st_transform(sfc, crs = 2056)
line_proj <- st_cast(sfc_proj, "LINESTRING")
len <- st_length(line_proj)
if (as.numeric(len) == 0) return(matrix(NA, nrow = 0, ncol = 2))
fractions <- seq(0, 1, length.out = n_points)
sampled_points <- st_line_sample(line_proj, sample = fractions * as.numeric(len))
st_coordinates(sampled_points)
}
# Trajektorienliste erstellen
traj_list <- list()
traj_lens <- numeric(length(fluege))
for (i in seq_along(fluege)) {
flug <- fluege[i]
coords <- S_fluege %>%
filter(comments == flug) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
traj_line <- st_linestring(coords) %>%
st_sfc(crs = 4326) %>%
st_transform(2056)
traj_lens[i] <- as.numeric(st_length(traj_line))
traj_list[[flug]] <- get_projected_downsampled_matrix(coords, n_points)
}
names(traj_list) <- fluege_kurz
names(traj_lens) <- fluege_kurz
# Fréchet-Distanzmatrix erstellen
n <- length(traj_list)
frechet_matrix <- matrix(NA, n, n, dimnames = list(fluege_kurz, fluege_kurz))
pb <- txtProgressBar(min = 0, max = n, style = 3)
for (i in 1:n) {
for (j in i:n) {
ti <- traj_list[[i]]
tj <- traj_list[[j]]
if (is.matrix(ti) && is.matrix(tj)) {
if (i == j) {
frechet_matrix[i, j] <- 0
} else {
d <- Frechet(ti, tj)
norm_factor <- mean(c(traj_lens[i], traj_lens[j]))
d_norm <- d / norm_factor
frechet_matrix[i, j] <- frechet_matrix[j, i] <- d_norm
}
}
}
setTxtProgressBar(pb, i)
}
close(pb)
# Log-Transformation + Skalierung
frechet_matrix_log <- log1p(frechet_matrix)
frechet_matrix_scaled <- frechet_matrix_log / max(frechet_matrix_log, na.rm = TRUE)
# Heatmap erstellen
pheatmap(frechet_matrix_scaled,
main = "Fréchet - Individuum S (Sample 250, log-transformiert)",
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
# -----------------------------------------------------------------------------
# LCSS Flug 4
# -----------------------------------------------------------------------------
# Downsampling-Funktion
get_projected_downsampled_matrix <- function(coords, n_points = 250) {
if (nrow(coords) < 2) return(matrix(NA, nrow = 0, ncol = 2))
line <- st_linestring(coords)
sfc <- st_sfc(line, crs = 4326)
sfc_proj <- st_transform(sfc, crs = 2056)
len <- st_length(sfc_proj)
if (as.numeric(len) == 0) return(matrix(NA, nrow = 0, ncol = 2))
sampled_points <- st_line_sample(sfc_proj, sample = seq(0, 1, length.out = n_points))
st_coordinates(sampled_points)
}
# Trajektorien erstellen
trajectories <- lapply(individuals, function(id) {
coords <- flug4 %>%
filter(`tag-local-identifier` == id) %>%
select(`location-long`, `location-lat`) %>%
as.matrix()
get_projected_downsampled_matrix(coords, n_points = 250)
})
names(trajectories) <- individuals
# LCSS-Distanzmatrix erstellen
n <- length(trajectories)
epsilon <- 0.1
lcss_matrix <- matrix(NA, nrow = n, ncol = n)
rownames(lcss_matrix) <- individuals
colnames(lcss_matrix) <- individuals
pb <- txtProgressBar(min = 0, max = n, style = 3)
for (i in 1:n) {
for (j in i:n) {
traj_i <- trajectories[[i]]
traj_j <- trajectories[[j]]
if (nrow(traj_i) >= 2 && nrow(traj_j) >= 2) {
if (i == j) {
lcss_matrix[i, j] <- 0
} else {
sim <- LCSS(traj_i, traj_j, epsilon)
dist <- 1 - (sim / max(nrow(traj_i), nrow(traj_j)))
lcss_matrix[i, j] <- dist
lcss_matrix[j, i] <- dist
}
}
}
setTxtProgressBar(pb, i)
}
close(pb)
# Visualisierung als Heatmap
pheatmap(lcss_matrix,
main = paste0("LCSS-Distanzen – Flug 4 (ε = ", epsilon, " m)"),
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")Zur Analyse der Trajektorienähnlichkeit wurden vier Ähnlichkeitsmasse eingesetzt: DTW, Edit Distance, Fréchet und LCSS. Die GPS-Daten wurden pro Trajektorie auf eine feste Punktzahl resampelt (n = 250). Die Berechnung erfolgte mit dem R-Paket SimilarityMeasures (Toohey, 2015). DTW und EditDist berechnen die kumulierte Punktdistanz entlang optimierter Vergleichspfade; Fréchet ermittelt die maximale Abweichung entlang des räumlichen Kurvenverlaufs zweier Trajektorien. LCSS zählt die Anzahl ähnlicher Punkte entlang monotoner Pfade, wobei innerhalb des Fluges 4 ein räumlicher Toleranzwert (ε = 0.1 m) verwendet wurde. Die LCSS-Analyse für die Anwendung auf mehrere Flüge (Individuum S) war zu rechenintensiv und konnte deshalb nicht durchgeführt werden.
Die verschiedenen Flüge des Individuums “S” Ind_S sowie alle Individuen aus Flug 4 Flug_4 wurden jeweils in gleiche Zeitsegmente eingeteilt. Dazu wurde die Funktion detect_segments_limited() eingesetzt, die auf jedem Flug oder Individuum die relative Zeit (time_rel) ermittelt und daraus gleich grosse Segmente bildet. Die Flüge wurden je in eine Anzahl von acht Segmenten unterteilt. Hierdurch konnten Flugverläufe unterschiedlicher Dauer vergleichbar gemacht werden. Für die Visualisierung wurden zwei Ansätze gewählt:
Zum einen wurden Trajektorien der Flüge kartiert, wobei die mittlere Geschwindigkeit pro Segment farblich abgestuft dargestellt wurde.
Zum anderen wurde die mittlere Segmentgeschwindigkeit in Abhängigkeit von der relativen Flugposition (Start bis Ende) geplottet. Zur Glättung der Geschwindigkeitsverläufe wurde ein loess-Glätter verwendet, ein nichtparametrisches Regressionsverfahren, das lokale lineare Fits anwendet.
# Folgend werden die Geschwindigkeitsmuster für die erste Analyseeinheit (alle Flüge des Individuums "S") berechnet:
# Max. Anzahl Segmente pro Flug
max_segments <- 8
max_cpts <- max_segments - 1
# Liste der Flüge
fluege <- unique(Ind_S$comments)
# Funktion zur Einteilung der Flüge in gleiche Zeitsegmente
detect_segments_limited <- function(flug_name) {
df <- Ind_S |>
filter(comments == flug_name) |>
arrange(timestamp)
if (nrow(df) < 5) return(NULL) # Optional: Wenn zu wenig Daten
df <- df |>
mutate(
total_time = as.numeric(difftime(max(timestamp), min(timestamp), units = "secs")),
time_rel = as.numeric(difftime(timestamp, min(timestamp), units = "secs")) / total_time,
segment = cut(time_rel, breaks = seq(0, 1, length.out = max_segments + 1),
labels = FALSE, include.lowest = TRUE),
flug = flug_name
)
return(df)
}
# Alle Flüge in Segmente aufteilen
seg_df_limited <- map_df(fluege, detect_segments_limited)
# Segmentindex als Grundlage für diverse Plots:
seg_summary <- seg_df_limited |>
group_by(flug, segment) |>
summarise(mean_speed = mean(`ground-speed`, na.rm = T),
segment_index = first(segment),
n_segments = n_distinct(segment),
.groups = "drop") |>
group_by(flug) |>
mutate(segment_position = segment_index / max(segment_index))
ggplot(Ind_S, aes(x = comments, y = `ground-speed`)) +
geom_boxplot(fill = "lightblue", alpha = 0.7) +
coord_flip() +
labs(title = "Geschwindigkeitsverteilung pro Flug",
x = "Flug", y = "Geschwindigkeit (m/s)") +
theme_minimal()
# Plot Segmentierung über alle Flüge inkl. Geschwindigkeitsverläufe:
ggplot(seg_df_limited, aes(x = timestamp, y = `ground-speed`)) +
geom_line(aes(group = segment, color = as.factor(segment)), size = 1) +
geom_vline(data = seg_df_limited |>
group_by(flug, segment) |>
summarise(x = min(timestamp), .groups = "drop"),
aes(xintercept = as.numeric(x)),
color = "black", linetype = "dashed") +
geom_segment(data = seg_df_limited |>
group_by(flug, segment) |>
summarise(x_start = min(timestamp),
x_end = max(timestamp),
y = mean(`ground-speed`, na.rm = T), .groups = "drop"),
aes(x = x_start, xend = x_end, y = y, yend = y),
inherit.aes = FALSE,
color = "black", linetype = "solid", size = 0.8) +
facet_wrap(~ flug, scales = "free_x", ncol = 1) +
scale_color_brewer(palette = "Set2") +
labs(title = "Relative Segmentierung mit 8 Segmenten pro Flug",
x = "Zeit", y = "Geschwindigkeit (m/s)", color = "Segment") +
theme_minimal(base_size = 14)
# Folgend werden die Geschwindigkeitsmuster für die zweite Analyseeinheit (Alle Individuen des Fluges 4) berechnet:
# Max. Anzahl Segmente pro Flug
max_segments <- 8
max_cpts <- max_segments - 1
# Liste der Flüge
fluege <- unique(Flug_4$`individual-local-identifier`)
# Funktion zur Einteilung der Flüge in gleiche Zeitsegmente
detect_segments_limited <- function(indiv_name) {
df <- Flug_4 |>
filter(`individual-local-identifier` == indiv_name) |>
arrange(timestamp)
if (nrow(df) < 5) return(NULL) # Optional: Wenn zu wenig Daten
df <- df |>
mutate(
total_time = as.numeric(difftime(max(timestamp), min(timestamp), units = "secs")),
time_rel = as.numeric(difftime(timestamp, min(timestamp), units = "secs")) / total_time,
segment = cut(time_rel, breaks = seq(0, 1, length.out = max_segments + 1),
labels = FALSE, include.lowest = TRUE),
indiv = indiv_name
)
return(df)
}
# Alle Flüge in Segmente aufteilen
seg_df_limited <- map_df(fluege, detect_segments_limited)
# Segmentindex als Grundlage für diverse Plots:
seg_summary <- seg_df_limited |>
group_by(indiv, segment) |>
summarise(mean_speed = mean(`ground-speed`, na.rm = T),
segment_index = first(segment),
n_segments = n_distinct(segment),
.groups = "drop") |>
group_by(indiv) |>
mutate(segment_position = segment_index / max(segment_index))
ggplot(Flug_4, aes(x = `individual-local-identifier`, y = `ground-speed`)) +
geom_boxplot(fill = "lightblue", alpha = 0.7) +
coord_flip() +
labs(title = "Geschwindigkeitsverteilung pro Individuum",
x = "ID", y = "Geschwindigkeit (m/s)") +
theme_minimal()
# Plot Segmentierung über alle Flüge inkl. Geschwindigkeitsverläufe:
ggplot(seg_df_limited, aes(x = timestamp, y = `ground-speed`)) +
geom_line(aes(group = segment, color = as.factor(segment)), size = 1) +
geom_vline(data = seg_df_limited |>
group_by(indiv, segment) |>
summarise(x = min(timestamp), .groups = "drop"),
aes(xintercept = as.numeric(x)),
color = "black", linetype = "dashed") +
geom_segment(data = seg_df_limited |>
group_by(indiv, segment) |>
summarise(x_start = min(timestamp),
x_end = max(timestamp),
y = mean(`ground-speed`, na.rm = T), .groups = "drop"),
aes(x = x_start, xend = x_end, y = y, yend = y),
inherit.aes = FALSE,
color = "black", linetype = "solid", size = 0.8) +
facet_wrap(~ indiv, scales = "free_x", ncol = 1) +
scale_color_brewer(palette = "Set2") +
labs(title = "Relative Segmentierung mit 8 Segmenten pro Individuum",
x = "Zeit", y = "Geschwindigkeit (m/s)", color = "Segment") +
theme_minimal(base_size = 14)
ChatGPT wurde beigezogen.
# -------------------------#
# Daten einlesen
# -------------------------#
# CSV-Dateien laden
flug4 <- read.csv("Flug4_Segmente.csv")
alle_fluege <- read.csv("Alle_Fluege_Segmente.csv")
# Spaltennamen vereinheitlichen
names(flug4) <- gsub("-", ".", names(flug4))
names(alle_fluege) <- gsub("-", ".", names(alle_fluege))
# Zeitformat konvertieren
flug4$timestamp <- as.POSIXct(flug4$timestamp, format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")
alle_fluege$timestamp <- as.POSIXct(alle_fluege$timestamp, format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")
# -------------------------#
# Funktion zur Sinuositätsberechnung
# -------------------------#
# Sinuosität = zurückgelegte Strecke / Luftlinie
berechne_sinuositaet <- function(df) {
df <- df |> arrange(timestamp)
coords <- df[, c("location.long", "location.lat")]
if (nrow(coords) < 2) return(NA)
luftlinie <- distHaversine(coords[1, ], coords[nrow(coords), ])
strecke <- sum(distHaversine(coords[-nrow(coords), ], coords[-1, ]), na.rm = TRUE)
if (luftlinie == 0) return(NA)
return(strecke / luftlinie)
}
# -------------------------#
# Vergleich innerhalb des Flugs 4
# -------------------------#
# Sinuosität pro Individuum und Segment berechnen
flug4_summary <- flug4 |>
group_by(tag.local.identifier, segment) |>
summarise(sinuosity = berechne_sinuositaet(cur_data()), .groups = "drop") |>
filter(!is.na(sinuosity))
# Mittelwerte der Sinuosität pro Segment berechnen
mittelwerte_flug4 <- flug4_summary |>
group_by(segment) |>
summarise(mean_sinuosity = mean(sinuosity), .groups = "drop")
# Plot mit Segment 3
ggplot(flug4_summary, aes(x = as.factor(segment), y = sinuosity, fill = tag.local.identifier)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7) +
geom_line(data = mittelwerte_flug4,
aes(x = as.factor(segment), y = mean_sinuosity, group = 1, color = "Mittelwert"),
inherit.aes = FALSE, linewidth = 1.2) +
geom_point(data = mittelwerte_flug4,
aes(x = as.factor(segment), y = mean_sinuosity, color = "Mittelwert"),
inherit.aes = FALSE, size = 2) +
labs(x = "Flugsegmente", y = "Sinuosität (log2)", fill = "Individuen", color = "") +
scale_y_continuous(trans = "log2") +
scale_fill_d3("category20") +
scale_color_manual(values = "black", labels = "Mittelwert") +
theme_minimal(base_size = 14) +
theme(legend.position = "right") +
ggtitle("Sinuosität Flug 4 - Übersichtsplot")
# Segment 3 ausschließen
flug4_summary_filtered <- flug4_summary |> filter(segment != 3)
mittelwerte_flug4_filtered <- mittelwerte_flug4 |> filter(segment != 3)
# Plot ohne Segment 3
ggplot(flug4_summary_filtered, aes(x = as.factor(segment), y = sinuosity, fill = tag.local.identifier)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7) +
geom_line(data = mittelwerte_flug4_filtered,
aes(x = as.factor(segment), y = mean_sinuosity, group = 1, color = "Mittelwert"),
inherit.aes = FALSE, linewidth = 1.2) +
geom_point(data = mittelwerte_flug4_filtered,
aes(x = as.factor(segment), y = mean_sinuosity, color = "Mittelwert"),
inherit.aes = FALSE, size = 2) +
labs(x = "Flugsegmente", y = "Sinuosität (log2)", fill = "Individuen", color = "") +
scale_y_continuous(trans = "log2", breaks = c(1, 1.25, 1.5, 1.75, 2), limits = c(1, 2)) +
scale_fill_d3("category20") +
scale_color_manual(values = "black", labels = "Mittelwert") +
theme_minimal(base_size = 14) +
theme(legend.position = "right") +
ggtitle("Sinuosität Flug 4 - fokussierter Plot")
# -------------------------#
# Sinuosität des Individuums S auf Flug 4 - Karte
# -------------------------#
# Filter nach Flug 4 und Individuum S
ind_s_flug4 <- flug4 |>
filter(tag.local.identifier == "S") |>
arrange(timestamp)
# Sinuosität pro Segment berechnen
s_sinuo <- ind_s_flug4 |>
group_by(segment) |>
summarise(sinuosity = berechne_sinuositaet(cur_data()), .groups = "drop")
# Sinuositätswerte mit Segmentdaten verknüpfen
ind_s_flug4 <- ind_s_flug4 |>
left_join(s_sinuo, by = "segment")
# Farbverlauf und Skalierung festlegen
farben <- c("blue", "skyblue", "lightblue", "mistyrose", "red")
max_sinuo <- max(ind_s_flug4$sinuosity, na.rm = TRUE)
werte <- c(1, 1.15, 1.5, 2, max_sinuo)
werte_log <- scales::rescale(log(werte), to = c(0, 1))
# Mittelpunkte für Segmentbeschriftung berechnen
labels <- ind_s_flug4 |>
group_by(segment) |>
summarise(
lon = mean(location.long),
lat = mean(location.lat),
label = as.character(segment),
.groups = "drop"
)
# Plot
ggplot(ind_s_flug4, aes(x = location.long, y = location.lat, group = segment, color = sinuosity)) +
geom_path(linewidth = 1.2) +
geom_text(data = labels,
aes(x = lon, y = lat, label = label),
inherit.aes = FALSE,
size = 4.5, fontface = "bold", color = "black") +
coord_equal() +
scale_color_gradientn(
colours = farben,
values = werte_log,
trans = "log2",
limits = c(1, max_sinuo),
breaks = c(1, 2, 5, 10, round(max_sinuo)),
labels = c("1", "2", "5", "10", as.character(round(max_sinuo))),
oob = squish,
name = "Sinuosität (log2)"
) +
labs(x = "Longitude", y = "Latitude") +
theme_minimal(base_size = 14)
# -------------------------#
# Vergleich: Individuum S über alle Flüge
# -------------------------#
# Filter nach Individuum S
ind_s <- alle_fluege |>
filter(tag.local.identifier == "S")
# Sinuosität pro Segment und Flug berechnen
s_summary <- ind_s |>
group_by(comments, segment) |>
summarise(sinuosity = berechne_sinuositaet(cur_data()), .groups = "drop") |>
filter(!is.na(sinuosity) & sinuosity >= 1)
# Flugbezeichnungen umcodieren
s_summary <- s_summary |>
mutate(comments = recode(comments,
"homing flight 1" = "Flug 1",
"homing flight 2" = "Flug 2",
"homing flight 3" = "Flug 3",
"homing flight 4" = "Flug 4",
"homing flight 5" = "Flug 5"
))
# Mittelwerte pro Segment berechnen
mittelwerte_s <- s_summary |>
group_by(segment) |>
summarise(sinuosity = mean(sinuosity), .groups = "drop") |>
mutate(comments = "Mittelwert")
# Plotdaten zusammenführen
s_plotdata <- bind_rows(s_summary, mittelwerte_s)
# Plot
ggplot(s_plotdata, aes(x = segment, y = sinuosity, color = comments, group = comments)) +
geom_line(linewidth = 1.2) +
geom_point(size = 2) +
scale_color_manual(
values = c(
setNames(RColorBrewer::brewer.pal(5, "Set1"), paste0("Flug ", 1:5)),
"Mittelwert" = "black"
)
) +
scale_x_continuous(breaks = 1:8, labels = as.character(1:8)) +
scale_y_continuous(
trans = "log2",
breaks = c(1, 1.5, 2, 4, 8, 16),
labels = c("1", "1.5", "2", "4", "8", "16")
) +
labs(
x = "Flugsegmente",
y = "Sinuosität (log2)",
color = "Flug"
) +
theme_minimal(base_size = 14)
# -------------------------#
# Karte: Individuum S über alle Flüge
# -------------------------#
# Filter nach Individuum S
ind_s_all <- alle_fluege |>
filter(tag.local.identifier == "S") |>
arrange(comments, timestamp)
# Sinuosität pro Segment und Flug berechnen
sinuo_s_all <- ind_s_all |>
group_by(comments, segment) |>
summarise(sinuosity = berechne_sinuositaet(cur_data()), .groups = "drop") |>
filter(!is.na(sinuosity))
# Sinuositätswerte mit Segmentdaten verknüpfen
ind_s_all <- ind_s_all |>
left_join(sinuo_s_all, by = c("comments", "segment"))
# Farbverlauf und Skalierung definieren
farben <- c("blue", "skyblue", "lightblue", "mistyrose", "red")
werte <- c(1, 1.25, 1.5, 2, 22)
werte_log <- scales::rescale(log2(werte), to = c(0, 1))
# Farbskalen-Beschriftungen definieren
breaks_custom <- c(1, 2, 5, 10, 22)
labels_custom <- as.character(breaks_custom)
# Plot
ggplot(ind_s_all, aes(x = location.long, y = location.lat, group = interaction(comments, segment))) +
geom_path(aes(color = sinuosity), linewidth = 0.8, alpha = 0.95) +
scale_color_gradientn(
colours = farben,
values = werte_log,
trans = "log2",
limits = c(1, 22),
breaks = breaks_custom,
labels = labels_custom,
oob = squish,
name = "Sinuosität (log2)"
) +
coord_equal() +
labs(x = "Longitude", y = "Latitude") +
theme_minimal(base_size = 14)Die Sinuosität wurde als Mass für die Richtungsabweichung innerhalb von Flugtrajektorien berechnet. Sie ergibt sich aus dem Verhältnis der tatsächlich zurückgelegten Strecke zur Luftlinie zwischen Start- und Endpunkt eines Segments. Die Berechnung erfolgte segmentweise für jeweils acht vordefinierte Abschnitte pro Flug. Innerhalb jedes Segments wurde die Streckenlänge als Summe der Haversine-Distanzen zwischen aufeinanderfolgenden Punkten berechnet (distHaversine(), Paket geosphere), und die Luftliniendistanz ebenfalls mit distHaversine() bestimmt. Die Auswertung erfolgte in R, gruppiert nach Segment und Individuum (Flug 4) bzw. nach Segment und Flug (Individuum S), um Unterschiede in der Sinuosität sowohl zwischen Individuen als auch zwischen Flügen zu vergleichen.
Der Datensatz des Fluges Nr. 4 aller Individuen wurde zunächst nach der individuellen Kennung individual-local-indentifier der Tauben und dem Zeitstempel timestamp sortiert, um eine klare zeitliche Reihenfolge zu gewährleisten. Anschliessend wurde für jedes Individuum der Positionsunterschied zwischen aufeinander folgenden Zeitpunkten berechnet, indem die geographische Koordinate des nächsten Punktes (location-long, location-lat) für jede Taube ermittelt wurde. Dies ermöglichte es, die Bewegungsrichtung der einzelnen Individuen durch Berechnung der Differenzwerte dx und dy festzulegen.
Im nächsten Schritt wurde der mittlere Schwarmvektor für jeden Zeitstempel berechnet, um die allgemeine Flugrichtung des gesamten Schwarms zu bestimmen. Dieser Schwarmvektor setzte sich aus dem Mittelwert der Bewegungsdifferenzen (dx, dy) aller Individuen zu einem bestimmten Zeitpunkt zusammen. Um zu erfassen, wie sich jedes Individuum im Verhältnis zum Schwarm verhält, wurde für jedes Individuum der relative Positionsvektor zum Schwarmmittelpunkt berechnet. Mit diesem Vektor wurde die Projektion auf die Schwarmbewegungsrichtung berechnet, um zu ermitteln, wie stark jedes Individuum in die Richtung des Schwarms fliegt.
Anschliessend wurde für jeden Zeitstempel das Individuum identifiziert, dessen Projektionswert den höchsten Wert aufwies, was darauf hinweist, dass es sich in diesem Zeitraum in der Führungsposition befand. Diese Informationen ermöglichten es, zu bestimmen, welche Taube zu welchem Zeitpunkt die Führungsrolle übernahm.
Zur Visualisierung des Führungsverhaltens wurden die Führungsanteile über die Zeit in einem Histogramm dargestellt. Zusätzlich wurden die Führungspositionen auf einer Karte mit leaflet visualisiert, wobei die Individuen durch unterschiedliche Farben dargestellt wurden. Eine statische Darstellung mit ggplot2 und sf ermöglichte eine detaillierte Analyse der Führungsmarkierungen über den gesamten Flugverlauf hinweg.
ChatGPT wurde beigezogen.
What was achieved overall?
How well are the results presented?
How well are the results discussed in the light of the theory?
Für den Flug 4 lassen sich die Trajektorien auf Basis ihres räumlichen Verlaufs in drei grobe Klassen einteilen, wobei insbesondere die Individuen N und Q räumliche Abweichungen zu den anderen Individuen zeigen, aber jeweils einen ähnlichen Verlauf haben. Die weiteren beiden Cluster, welche untereinander ähnliche räumliche Trajektorien aufweisen, sind zum einen R, S und U und zum anderen M, O, P und T. Der Vergleich zwischen den Flügen zeigt, dass sich der räumliche Verlauf der Trajektorien der Flüge 3, 4 und 5 sehr ähnlich sind, während sich die Flüge 1 und 2 von den anderen Flügen unterscheiden und insbesondere auch voneinander sehr unterschiedlich sind.
Für den Flug 4 lassen lassen sich die Trajektorien wie bereits bei DTW in drei grobe Cluster einteilen, basierend auf der raum-zeitlichen Ähnlichkeit von GPS-Messpunkten. Wiederum unterscheiden sich die Trajektorien der Individuen N und Q raum-zeitlich von den anderen Individuen und haben im Vergleich zueinander einen ähnlichen Verlauf. Auch die beiden anderen Cluster - R, S und U sowie M, O, P und T – stimmen mit den Ergebnissen des DTW überein. Der Vergleich zwischen den Flügen zeigt, dass mit EditDist keine raum-zeitliche Ähnlichkeit der GPS-Messpunkte erfasst wird.
Anders als bei den bisherigen Ähnlichkeitsmassen lassen sich die Trajektorien für den Flug 4 in zwei grobe Cluster einteilen, P, R, S und U sowie M, N, O, Q und T. Die neuen Cluster sind erklärbar dadurch, dass die Fréchet-Distance als Methode sich von den bisherigen Ähnlichkeitsmassen stark unterscheidet und sich über den maximalen minimalen Abstand der Trajektorien definiert. Der Vergleich zwischen den Flügen zeigt jedoch ein ähnliches Muster wie DTW, der maximale minimale Abstand zwischen den Flügen 3, 4 und 5 ist vergleichsweise gering, bei den Flügen 1 und 2 im Vergleich mit den anderen Flügen ist er hoch und sehr hoch zwischen den Flügen 1 und 2.
Für den Flug 4 lassen sich die Trajektorien auf Basis der Länge von gemeinsamen Teilsequenzen wiederum in die drei Cluster einteilen, welche mit den Clustern von DTW und EditDist übereinstimmen. Auffällig ist wiederum, dass sich die Trajektorien N und Q stark von den anderen Trajektorien unterscheiden, untereinander jedoch sehr ähnlich sind. Der Vergleich zwischen den Flügen konnte aufgrund des hohen Rechenaufwands der Methode nicht durchgeführt werden.
Text im Entwurf Zur Analyse der Fluggeschwindigkeit wurden die mittleren Segmentgeschwindigkeiten in Abhängigkeit der relativen Position im Flugverlauf untersucht. In den entsprechenden Abbildungen (Verweis) ist erkennbar, dass die Geschwindigkeit der Brieftauben typischerweise einem wiederkehrenden Muster folgt: Zu Beginn des Fluges ist die Geschwindigkeit meist relativ gering, was vermutlich auf eine Orientierungsphase in der Nähe der Freilassungsstelle zurückzuführen ist. Im weiteren Verlauf steigt die Geschwindigkeit deutlich an und erreicht häufig im mittleren Abschnitt des Fluges ein Maximum. Gegen Ende des Fluges zeigt sich bei vielen Flügen wieder ein leichter Abfall der Geschwindigkeit. Dieses Muster ist sowohl bei der gruppenübergreifenden Betrachtung verschiedener Flüge (Verweis Scatterplot Ind S) als auch bei den Einzelflügen aller Individuen eines Fluges (Verweis Scatterplot Flug 4) deutlich zu erkennen. Insgesamt bestätigen diese Befunde die in der Literatur und in unseren Erwartungen formulierte Annahme, dass Brieftauben nach einer kurvenreicheren Anfangsphase zunehmend geradliniger und schneller fliegen, bevor sie in der Endphase möglicherweise wieder Tempo verlieren [vgl. @schiffner2009].
# Liste der Flüge
fluege <- unique(Ind_S$comments)
# Funktion zur Einteilung der Flüge in gleiche Zeitsegmente
detect_segments_limited <- function(flug_name) {
df <- Ind_S |>
filter(comments == flug_name) |>
arrange(timestamp)
if (nrow(df) < 5) return(NULL) # Optional: Wenn zu wenig Daten
df <- df |>
mutate(
total_time = as.numeric(difftime(max(timestamp), min(timestamp), units = "secs")),
time_rel = as.numeric(difftime(timestamp, min(timestamp), units = "secs")) / total_time,
segment = cut(time_rel, breaks = seq(0, 1, length.out = max_segments + 1),
labels = FALSE, include.lowest = TRUE),
flug = flug_name
)
return(df)
}
# Alle Flüge in Segmente aufteilen
seg_df_limited <- map_df(fluege, detect_segments_limited)
# Segmentindex als Grundlage für diverse Plots:
seg_summary <- seg_df_limited |>
group_by(flug, segment) |>
summarise(mean_speed = mean(`ground-speed`, na.rm = T),
segment_index = first(segment),
n_segments = n_distinct(segment),
.groups = "drop") |>
group_by(flug) |>
mutate(segment_position = segment_index / max(segment_index))
# Plot: Trajektorien einfärben nach der mittleren Segment-Geschwindigkeit
seg_avg_speed <- seg_df_limited |>
group_by(flug, segment) |>
summarise(avg_speed = mean(`ground-speed`, na.rm = TRUE)) |>
ungroup()
seg_df_limited <- seg_df_limited |>
left_join(seg_avg_speed, by = c("comments" = "flug", "segment" = "segment"))
ggplot(seg_df_limited |>
arrange(timestamp),
aes(x = `location-long`, y = `location-lat`, color = avg_speed)) +
geom_path(aes(group = comments), size = 1.2) +
scale_color_gradientn(colors = c("blue", "lightblue", "mistyrose", "red")) +
labs(title = "Flugtrajektorien mit mittlerer Segment-Geschwindigkeit",
x = "Längengrad", y = "Breitengrad", color = "Mittlere Geschwindigkeit (m/s)") +
theme_minimal(base_size = 14) +
theme(legend.position = "right")
ggplot(seg_summary, aes(x = segment_position, y = mean_speed, color = flug)) +
geom_point(size = 3) +
geom_smooth(method = "loess", se = FALSE) +
scale_color_brewer(palette = "Set1") +
labs(title = "Mittlere Segmentgeschwindigkeit relativ zur Flugposition",
x = "Relative Position im Flug (0 = Start, 1 = Ende)",
y = "Mittlere Geschwindigkeit (m/s)", color = "Flug") +
theme_minimal(base_size = 14)
# Liste der Flüge
fluege <- unique(Flug_4$`individual-local-identifier`)
# Funktion zur Einteilung der Flüge in gleiche Zeitsegmente
detect_segments_limited <- function(indiv_name) {
df <- Flug_4 |>
filter(`individual-local-identifier` == indiv_name) |>
arrange(timestamp)
if (nrow(df) < 5) return(NULL) # Optional: Wenn zu wenig Daten
df <- df |>
mutate(
total_time = as.numeric(difftime(max(timestamp), min(timestamp), units = "secs")),
time_rel = as.numeric(difftime(timestamp, min(timestamp), units = "secs")) / total_time,
segment = cut(time_rel, breaks = seq(0, 1, length.out = max_segments + 1),
labels = FALSE, include.lowest = TRUE),
indiv = indiv_name
)
return(df)
}
# Alle Flüge in Segmente aufteilen
seg_df_limited <- map_df(fluege, detect_segments_limited)
# Segmentindex als Grundlage für diverse Plots:
seg_summary <- seg_df_limited |>
group_by(indiv, segment) |>
summarise(mean_speed = mean(`ground-speed`, na.rm = T),
segment_index = first(segment),
n_segments = n_distinct(segment),
.groups = "drop") |>
group_by(indiv) |>
mutate(segment_position = segment_index / max(segment_index))
# Plot: Trajektorien einfärben nach der mittleren Segment-Geschwindigkeit
seg_avg_speed <- seg_df_limited |>
group_by(indiv, segment) |>
summarise(avg_speed = mean(`ground-speed`, na.rm = TRUE)) |>
ungroup()
seg_df_limited <- seg_df_limited |>
left_join(seg_avg_speed, by = c("individual-local-identifier" = "indiv", "segment" = "segment"))
ggplot(seg_df_limited,
aes(x = `location-long`, y = `location-lat`, color = avg_speed)) +
geom_path(aes(group = `individual-local-identifier`), size = 1.2) +
facet_wrap(~`individual-local-identifier`) +
scale_color_gradientn(colors = c("blue", "lightblue", "mistyrose", "red")) +
labs(title = "Flugtrajektorien mit mittlerer Segment-Geschwindigkeit",
x = "Längengrad", y = "Breitengrad", color = "Mittlere Geschwindigkeit (m/s)") +
theme_minimal(base_size = 14) +
theme(legend.position = "right")
ggplot(seg_summary, aes(x = segment_position, y = mean_speed, color = indiv)) +
geom_point(size = 3) +
geom_smooth(method = "loess", se = FALSE) +
scale_color_brewer(palette = "Set1") +
labs(title = "Mittlere Segmentgeschwindigkeit relativ zur Flugposition",
x = "Relative Position im Flug (0 = Start, 1 = Ende)",
y = "Mittlere Geschwindigkeit (m/s)", color = "Flug") +
theme_minimal(base_size = 14)
Die Sinuosität im Flug 4 ist insbesondere in den Flugsegmenten 1 und 3, Segemente zu Beginn des Fluges, sehr hoch (Verlinkung). Zugleich ist ersichtlich, dass sich die Individuen untereinander kaum in der Sinuosität der Flugtrajektorien unterscheiden.
Die Karte der Flugtrajektorie des Fluges 4, Individuum S zeigt, dass die hohe Sinuosität des Segements 3 durch eine geflogene Schleife verursacht wird. Weiter ist die hohe Sinuosität des Flugsegmentes 1 ersichtlich. 
Die Sinuosität der Flugtrajektorien des Individuums S über alle Flüge zeigt das tendenzielle Muster aus dem Flug 4, dass sie Sinuosität zu Beginn des Fluges sehr hoch ist und danach abnimmt, sehr deutlich. Insbesondere die Flüge 2 und 4 haben in den ersten Flugphasen eine hohe Sinuosität. Einzig bei Flug 1 zeigt sich zu Beginn des Fluges keine höhere Sinuosität. 
Das gleiche Muster der hohen Sinuosität zu Beginn des Fluges ist wiederum in der Karte der Sinuosität der Flugtrajektorien des Individuum S ersichtlich. 
Text folgt Die Auswertung der Führungszeiten zeigt eine deutliche Hierarchie: Das Individuum «M» übernahm mit Abstand am häufigsten die Führungsposition, gefolgt von den Individuen «O» und «T». Demgegenüber zeigten andere Individuen wie «N» oder «R» nur selten Führungsverhalten. Diese klaren Unterschiede stützen die Hypothese, dass innerhalb des Schwarms stabile „Lead and Follow“-Dynamiken existieren, wie sie auch in früheren Studien beschrieben wurden [vgl. @nagy2010]. Die Resultate deuten darauf hin, dass bestimmte Individuen überproportional häufig die Navigation des Schwarms übernehmen.
# Anwendung auf Flug 4 - braucht mehrere Individuen zur Analyse.
Flug_4 <- Flug_4 |>
arrange(`individual-local-identifier`, timestamp) |>
group_by(`individual-local-identifier`) |>
mutate(
lon_next = lead(`location-long`),
lat_next = lead(`location-lat`),
dx = lon_next - `location-long`,
dy = lat_next - `location-lat`
) |>
ungroup()
# Berechne pro Zeitstempel den mittleren Schwarmvektor
schwarm <- Flug_4 |>
group_by(timestamp) |>
summarise(
mean_dx = mean(dx, na.rm = TRUE),
mean_dy = mean(dy, na.rm = TRUE),
center_lon = mean(`location-long`, na.rm = TRUE),
center_lat = mean(`location-lat`, na.rm = TRUE)
)
# Join Schwarmrichtung wieder zurück
Flug_4 <- Flug_4 |>
left_join(schwarm, by = "timestamp") |>
rowwise() |>
mutate(
rel_lon = `location-long` - center_lon,
rel_lat = `location-lat` - center_lat,
projection = (rel_lon * mean_dx + rel_lat * mean_dy) /
sqrt(mean_dx^2 + mean_dy^2)
) |>
ungroup()
# Wer hat pro Zeit den höchsten Projektionswert?
Flug_4 <- Flug_4 |>
group_by(timestamp) |>
mutate(
is_leader = projection == max(projection, na.rm = TRUE)
)
# Farbzuordnung für jedes individuelle Identifikationsmerkmal
color_palette <- scale_fill_manual(values = RColorBrewer::brewer.pal(length(unique(Flug_4$`individual-local-identifier`)), "Set1"))
Flug_4 |>
filter(is_leader) |>
count(`individual-local-identifier`) |>
ggplot(aes(x = reorder(`individual-local-identifier`, -n), y = n, fill = `individual-local-identifier`)) +
geom_col() +
color_palette +
labs(title = "Führungsanteile über die Zeit", x = "Taube", y = "Anzahl Sekunden in Führung") +
theme_minimal() +
theme(legend.position = "none") 
Flug_4 |>
filter(is_leader) |>
count(timestamp, `individual-local-identifier`) |>
ggplot(aes(x = timestamp, fill = `individual-local-identifier`)) +
geom_histogram(binwidth = 5, position = "stack") +
color_palette +
labs(title = "Führungszeitpunkte je Taube", x = "Zeit", y = "Anzahl Zeitpunkte (pro Bin)") +
theme_minimal() +
theme(legend.position = "bottom")
# Farbzuordnung für jedes individuelle Identifikationsmerkmal
color_palette <- colorFactor(palette = "Set1", domain = unique(Flug_4$`individual-local-identifier`))
# Visualisierung mit Leaflet: Nur die Punkte der Führer einfärben
leaflet(data = Flug_4 |> filter(is_leader)) |>
addTiles() |>
addCircleMarkers(
lng = ~`location-long`,
lat = ~`location-lat`,
color = ~color_palette(`individual-local-identifier`),
radius = 5,
stroke = FALSE,
fillOpacity = 0.7,
label = ~paste("Leader: ", `individual-local-identifier`,
"<br>Time: ", timestamp)
) |>
addLegend(
position = "bottomright",
pal = color_palette,
values = unique(Flug_4$`individual-local-identifier`),
title = "Individuen"
)# Konvertiere die Daten in ein sf-Objekt für ggplot2
Flug_4_sf <- Flug_4 |>
filter(is_leader) |>
st_as_sf(coords = c("location-long", "location-lat"), crs = 4326)Are the conclusions drawn from the project adequate and coherent?
Are problems that showed up been reported and alternative solutions proposed?
Have data science choices been discussed in the light of the theory?
Ähnlichkeit hat gezeigt, dass insbesondere 2 Individuen (N und Q) sich von den anderen Individuen unterscheiden im Flug 4. Bei den Flügen unterscheiden sich Flug 1 und 2 von den sich ähnelnden Flügen 3-5, wobei Flug 1 und 2 sehr unterschiedlich voneinander sind. Herausfordernd war, dass die Unterschiede zwischen den Individuen eines Fluges sehr gering sind und zwischen den Flügen sehr hoch, was nur durch Logarithmisieren lösbar war. Als besonders geeignet für die vorliegende Untersuchung wird das Dynamic Time Warping beurteilt.
Hohe Sinuosität zu Beginn, deckt sich mit Literatur (Orientierungsphase). Keine Sinuosität zum Schluss, warum? Nur Gruppenflug in den Daten, Individuen haben sich gegen Ende aufgeteilt – letzter Teil des Fluges ist in den Daten nicht verfügbar – Aussage
How was research implemented addressing the Research questions?
What about problems and limitations and strategies overcoming these?
Simple solutions vs. own original techniques
Is the code properly commented/annotated?
Verwendung von AI transparent dokumentiert?
XX ## Wordcount
# wordcountaddin::word_count("index.qmd")How much effort was put in documenting the work?
Is the structure reasonable and clear? Length of report (approx. 15000 char (incl. spaces, incl. References list, excl. Code listing), 20000 char max)
Is the language clear and correct?
Are references used, correctly cited and listed?
If used, is the use of Generative AI (e.g. ChatGPT) documented and transparent?
Are figures and tables clear and produced to high standards?
Overall effort and investment