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)In dieser Projektarbeit analysieren wir die Bewegungsmuster und Führungsdynamiken bei Brieftauben anhand hochaufgelösten GPS-Daten in R (R Core Team, 2024). Dazu verwenden wir einen Datensatz von (Santos et al., 2014) mit fünf Heimflügen mit je 9-10 Individuen. Die Bewegungsmuster Ähnlichkeit, Geschwindigkeit und Sinuosität werden sowohl innerhalb eines Flugs als auch flugübergreifend untersucht und verglichen.
Die vier untersuchten Ähnlichkeitsmasse zeigen, dass sich sowohl die Trajektorien der Individuen auf einem Flug als auch die Trajektorien aller Flüge in zwei bis drei grobe Cluster einteilen und sich somit Ähnlichkeiten gut berechnen lassen. Sowohl Geschwindigkeit als auch Sinuosität verändern sich im Verlauf der Flüge und lassen auf eine Orientierungsphase schliessen. Nach dieser Phase nimmt die Sinuosität der Trajektorien ab und die Fluggeschwindigkeit nimmt zu. Das Führungsverhalten zeigt, dass manche Individuen deutlich öfter eine Führungsposition einnehmen als andere.
Unsere Ergebnisse bestätigen weitgehend die in der Literatur beschriebenen Muster einer Orientierungsphase und anschliessendem beschleunigtem, geradlinigem Heimflug.
GPS-basierte Bewegungsdaten ermöglichen es, das Verhalten von Menschen und Tieren mit hoher raumzeitlicher Auflösung zu analysieren. Mit hochaufgelösten GPS-Daten können auch Bewegungsmustern und Führungsdynamiken von sich schnell bewegenden Arten wie der Brieftaube (Columba livia) erfasst werden (Guilford et al., 2004), (Laube, 2014). Methodische Ansätze der computergestützten Bewegungsanalyse nutzen diese Daten, um Flugmuster quantifizierbar zu machen (Laube et al., 2007), etwa anhand von Sinuosität, Geschwindigkeit oder Trajektorienähnlichkeit.
Bekannt ist, dass Brieftauben nach dem Freilassen zu Beginn des Heimflugs zunächst ein ungerichtetes, kurviges Bewegungsmuster zeigen (Orientierungsphase), bevor sie in eine zielgerichtete Heimflugphase übergehen (Schiffner & Wiltschko, 2009). Diese Übergänge spiegeln sich in Metriken wie Sinuosität oder Geschwindigkeit wider. Ergänzend lassen sich über Ähnlichkeitsmasse Vergleiche innerhalb und zwischen Flügen anstellen, etwa durch Dynamic Time Warping, Fréchet-Distance oder Edit Distance (Laube, 2014).
Auch das soziale Verhalten spielt beim Heimflug eine wichtige Rolle. Die Führungsrollen im Taubenschwarm werden wiederholt von denselben Individuen eingenommen (Nagy et al., 2010), (Santos et al., 2014). Solche hierarchischen Strukturen können über zeitlich versetzte Richtungsentscheidungen und Flugpositionen identifiziert werden (Santos et al., 2014).
Im Zentrum dieser Analyse steht nicht nur das Verhalten der Brieftauben, sondern insbesondere auch die Anwendung methodischer Ansätze zur Analyse raumzeitlicher Bewegungsdaten.
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 Führungsdynamik identifiziert werden?
Wir verwenden einen Datensatz mit Bewegungsdaten zum Flugverhalten von Brieftauben aus dem Paper von (Santos et al., 2014), welcher öffentlich über die Movebank Plattform (Kays et al., 2022) erhältlich ist. 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 Brieftauben wurden ungefähr 15 km östlich von ihrem Heimatschlag in Seuzach freigelassen. Die Flugrichtung aller fünf Flüge ist von Ost nach West.
Der Datensatz enthält zusätzlich für jede Messung Angaben zur Flughöhe über dem Referenzellipsoid und der Fluggeschwindigkeit. Die Fluggeschwindigkeit aus den Daten verwenden wir jedoch nicht und leiten diese zur maximalen Kontrolle und Transparenz in der Datenvorverarbeitung selbst her und vergleichen diese mit der gegebenen Fluggeschwindigkeit (ground-speed) der GPS-Logger. Für die Berechnung der Fluggeschwindigkeit und der weiteren Bewegungsmuster beschränken wir uns auf den zweidimensionalen Raum.
Für unsere Auswertungen ziehen wir keine zusätzlichen Grundlagen, wie beispielsweise Umweltdaten, bei.
# -----------------------------------------------------------------------------
# Karte der Flugtrajektorien
# -----------------------------------------------------------------------------
# Daten laden
Flugverhalten = read_delim("Alle_Fluege_resample.csv")
# Erzeugung eines räumlichen Objekts
Flugverhalten = st_as_sf(Flugverhalten, coords = c("location-long","location-lat"),crs =4326)
Flugverhalten <- st_transform(Flugverhalten, crs = 2056)
Flugverhalten$flugnummer = recode(Flugverhalten$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")
Flugverhalten <- Flugverhalten |>
filter(`individual-local-identifier` == "S")
# Interaktive Karte erstellen
tmap_mode("view")
tm_basemap("Esri.WorldImagery") +
tm_shape(Flugverhalten) +
tm_dots(
col = "flugnummer",
palette = "Set1",
size = 0.05,
title = "Flugrouten"
) +
tm_scale_bar(position = c("left", "bottom")) +
tm_compass(type = "arrow", size = 2, position = c("right", "top")) +
tm_layout(legend.outside = TRUE)Wir arbeiteten mit hochaufgelösten GPS-Daten, die alle 0,25 Sekunden eine Messung enthalten. Für unsere statistischen Analysen reduzierten wir die Datenmenge durch Resampling auf ein Intervall von einer Sekunde.
# 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)))
}Der Code für das Resampling wurde unter Beizug von ChatGPT und der Unterrichtsunterlagen erstellt
Zur Fokussierung der Analyse wählten wir aus den fünf verfügbaren Flügen zufällig einen Flug aus (Flug 4), um die Flugtrajektorien der einzelnen Individuen innerhalb dieses Flugs miteinander zu vergleichen. Für den flugübergreifenden Vergleich bestimmten wir ebenfalls per Zufallsprinzip ein Individuum (Individuum S).
# -----------------------------------------------------------------------------
# Filtern auf Flug 4 und Individuum S
# -----------------------------------------------------------------------------
# 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")Wir nehmen für unsere Ableitung der Geschwindigkeit Bezug auf die Literatur von (Laube, 2014). Dabei wurde die Geschwindigkeit in verschiedenen Massstäben analysiert und diese unterschiedlichen Werte verglichen.
In unseren Skalen gingen wir von folgenden Intervalloperator-Breiten aus:
Zwei Sekunden (speed_2s)
Vier Sekunden (speed_4s)
Acht Sekunden (speed_8s)
Unsere daraus berechneten Geschwindigkeiten (speed_2s bis speed_8s) unterschieden sich signifikant von der Logger-Geschwindigkeit (ground-speed). Die Unterschiede der Geschwindigkeiten innerhalb der drei verwendeten Intervalloperator-Breiten sind jedoch gering. Die mittlere Geschwindigkeit vonspeed_2s nimmt im Vergleich zu speed_8s geringfügig ab, wie es (Laube, 2014) in Abbildung 2 festgehalten hat.
# -----------------------------------------------------------------------------
# Berechnung der Geschwindigkeiten anhand der drei Intervalle
# -----------------------------------------------------------------------------
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)
)
}
Alle_geschw <- Alle |>
st_as_sf(coords = c('location-lat', 'location-long'), crs = 4326) |>
select('event-id', timestamp)
# -----------------------------------------------------------------------------
# Intervall 1: Zwei Sekunden (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)
)
# -----------------------------------------------------------------------------
# Intervall 2: Vier Sekunden (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)
)
# -----------------------------------------------------------------------------
# Intervall 3: Acht Sekunden (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)
)
# -----------------------------------------------------------------------------
# Vergleich der Geschwindigkeiten
# -----------------------------------------------------------------------------
Alle_geschw_2 <- Alle_geschw |>
st_drop_geometry() |>
select(timestamp, speed_2s, speed_4s, speed_8s)
Alle_geschw_long <- Alle_geschw_2 |>
pivot_longer(c(speed_2s, speed_4s, speed_8s))
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)
# Plot:
Alle_geschw_long <- Alle |>
pivot_longer(c('ground-speed', speed_2s, speed_4s, speed_8s))
ggplot(Alle_geschw_long, aes(name, value)) +
geom_boxplot(outliers = FALSE) +
labs(x = "Type of speed", y = "speed [m/s]") +
theme_classic()
Für die weiteren Analysen verwendeten wir die Geschwindigkeit des Berechnungsintervalls von vier Sekunden speed_4s.
Alle <- Alle |>
mutate(`ground-speed` = speed_4s) |>
select(-starts_with("speed_"))Der Code zum Vergleich der Intervalle zur Geschwindigkeitsberechnung basiert auf der Übung 2B des Moduls Patterns & Trends in Environmental Data FS25.
Zur Analyse der Trajektorienähnlichkeit setzten wir vier Ähnlichkeitsmasse ein: DTW, Edit Distance, Fréchet und LCSS. Die GPS-Daten jeder Trajektorie reduzierten wir auf eine feste Punktzahl (n = 250). Die Berechnungen erfolgte mit dem R-Paket SimilarityMeasures(Toohey, 2015). Die Anwendung von LCSS auf mehrere Flüge erwies sich als zu rechenintensiv und wurde deshalb nicht durchgeführt.
# -----------------------------------------------------------------------------
# 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
# -----------------------------------------------------------------------------
# Messpunkte
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
# -----------------------------------------------------------------------------
# Messpunkte
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
dtw_matrix_scaled <- dtw_matrix / max(dtw_matrix, na.rm = TRUE)
# -----------------------------------------------------------------------------
# EditDist Flug 4
# -----------------------------------------------------------------------------
# Messpunkte
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
}
}
}
}
# -----------------------------------------------------------------------------
# EditDist Individuum S
# -----------------------------------------------------------------------------
# Messpunkte
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
}
}
}
}
# -----------------------------------------------------------------------------
# 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)
# -----------------------------------------------------------------------------
# Frechet-Distance Individuum S
# -----------------------------------------------------------------------------
# Messpunkte
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 und Skalierung
frechet_matrix_log <- log1p(frechet_matrix)
frechet_matrix_scaled <- frechet_matrix_log / max(frechet_matrix_log, na.rm = TRUE)
# -----------------------------------------------------------------------------
# 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)Der Code zur Analyse der Trajektorienähnlichkeit wurde unter Beizug von ChatGPT erstellt.
Zur Vergleichbarkeit der Flüge haben wir jeden Flugverlauf jeweils in acht Segmenten unterteilt. Dies erfolgte mithilfe der Funktion detect_segments_limited() ein, die auf Basis der relativen Zeit (time_rel) gleich grosse Segmente erstellt.
Für die Visualisierung wählten wir zwei Ansätze:
Wir stellten die Flugtrajektorien auf Karten dar, wobei die mittlere Geschwindigkeit pro Segment farblich abgestuft dargestellt wurde.
Wir stellten die mittlere Segmentgeschwindigkeit in Abhängigkeit der relativen Flugpositionen auf Scatterplots dar. Zur Glättung der Geschwindigkeitsverläufe verwendeten wir einen loess-Glätter.
# -----------------------------------------------------------------------------
# Segmentierung der Trajektorien aller fünf Flüge des Individuums S
# -----------------------------------------------------------------------------
Flug_4 <- Alle |>
filter(comments == "homing flight 4")
Ind_S <- Alle |>
filter(`individual-local-identifier` == "S")
# 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))
# -----------------------------------------------------------------------------
# Übersicht Geschwindigkeitsverteilung (Boxplots) aller fünf Flüge des Individuums S
# -----------------------------------------------------------------------------
ggplot(Ind_S, aes(x = comments, y = `ground-speed`)) +
geom_boxplot(fill = "lightblue", alpha = 0.7) +
coord_flip() +
labs(x = "Flug", y = "Geschwindigkeit (m/s)") +
theme_minimal()
# -----------------------------------------------------------------------------
# Plot der Segmentierung der Trajektorien aller fünf Flüge des Individuums S
# -----------------------------------------------------------------------------
# Plot:
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(x = "Zeit", y = "Geschwindigkeit (m/s)", color = "Segment") +
theme_minimal(base_size = 14)
# -----------------------------------------------------------------------------
# Segmentierung der Trajektorien der Trajektorien aller Individuen auf Flug 4
# -----------------------------------------------------------------------------
# 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))
# -----------------------------------------------------------------------------
# Übersicht Geschwindigkeitsverteilung (Boxplots) aller Individuen auf Flug 4
# -----------------------------------------------------------------------------
ggplot(Flug_4, aes(x = `individual-local-identifier`, y = `ground-speed`)) +
geom_boxplot(fill = "lightblue", alpha = 0.7) +
coord_flip() +
labs(x = "ID", y = "Geschwindigkeit (m/s)") +
theme_minimal()
# -----------------------------------------------------------------------------
# Plot der Segmentierung der Trajektorien aller Individuen auf Flug 4
# -----------------------------------------------------------------------------
# Plot:
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(x = "Zeit", y = "Geschwindigkeit (m/s)", color = "Segment") +
theme_minimal(base_size = 14)
Der Code zur Analyse der Geschwindigkeit bzw. der Segmentierung wurde unter Beizug von ChatGPT erstellt.
Wir berechneten die Sinuosität innerhalb von Flugtrajektorien. Sie ergab sich aus dem Verhältnis der tatsächlich zurückgelegten Strecke zur Luftliniendistanz zwischen Start- und Endpunkt eines Segments. Die Berechnung erfolgte segmentweise für jeweils acht vordefinierte Abschnitte pro Flug. Innerhalb jedes Segments summierten wir die Haversine-Distanzen zwischen aufeinanderfolgenden Punkten zur Ermittlung der Streckenlänge und der Luftliniendistanz (Funktion distHaversine(), Paket geosphere).
# -------------------------#
# 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)
# -------------------------#
# 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)Der Code für die Analyse der Sinuosität wurde unter Beizug von ChatGPT erstellt.
Zunächst bestimmten wir für jedes Individuum den Positionsunterschied zwischen aufeinanderfolgenden Zeitpunkten durch Berechnung der Differenzwerte dx und dy. Im nächsten Schritt berechneten wir den mittleren Schwarmvektor für jeden Zeitstempel. Wir projizierten den relativen Positionsvektor jedes Individuums auf die Schwarmrichtung, um dessen Führungsposition zu bestimmen. Das Individuum, dessen Projektionswert den höchsten Wert aufwies, galt als führend.
Zur Visualisierung des Führungsverhaltens stellten wir die Führungsanteile über die Zeit in einem Histogramm dar. Zusätzlich visualisierten wir die Führungspositionen auf einer Karte mit leaflet, wobei wir die Individuen durch unterschiedliche Farben darstellten.
Der Code zur Analyse der Führungsdynamik wurde unter Beizug von ChatGPT erstellt.
Für Flug 4 identifizieren wir auf Basis der DTW-Distanzen drei Cluster mit ähnlichem räumlichen Verlauf (siehe Abbildung 8). Die Individuen N und Q bilden einen eigenständigen Cluster mit abweichenden, aber untereinander ähnlichen Trajektorien. Die weiteren beiden Cluster umfassen R, S und U sowie M, O, P und T. Beim Vergleich der Flüge des Individuum S (Abbildung 9) zeigen Flüge 3,4 und 5 einen ähnlichen Verlauf, während sich die Flüge 1 und 2 von den anderen Flügen unterscheiden und insbesondere voneinander sehr unterschiedlich sind.
# -----------------------------------------------------------------------------
# DTW Flug 4
# -----------------------------------------------------------------------------
# Heatmap erstellen
pheatmap(dtw_matrix_scaled,
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
# -----------------------------------------------------------------------------
# DTW Individuum S
# -----------------------------------------------------------------------------
# Heatmap erstellen
pheatmap(dtw_matrix_scaled,
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
Für Flug 4 ergeben sich ebenfalls die drei grobe Cluster (Abbildung 10), welche mit den DTW-Clustern übereinstimmen. Die Individuen N und Q weichen erneut deutlich von den übrigen ab. Der flugübergreifende Vergleich mit Edit Distance zeigt jedoch durchgehend maximale Distanzen (Abbildung 11), sodass keine Ähnlichkeit zwischen den Flügen erkannt wird.
# -----------------------------------------------------------------------------
# EditDist Flug 4
# -----------------------------------------------------------------------------
# Heatmap erstellen
pheatmap(edit_matrix,
color = colorRampPalette(c("blue", "lightblue", "salmon", "red"))(100),
na_col = "grey90",
breaks = seq(0, 1, length.out = 101))
# -----------------------------------------------------------------------------
# EditDist Individuum S
# -----------------------------------------------------------------------------
# Heatmap erstellen
pheatmap(edit_matrix,
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
Anders als bei den bisherigen Ähnlichkeitsmassen lassen sich die Trajektorien für den Flug 4 in zwei grobe Cluster einteilen, einerseits die Individuen P, R, S und U, andererseits M, N, O, Q und T (Abbildung 12). Die Fréchet-Distance unterscheidet sich von den bisherigen Ähnlichkeitsmassen stark und definiert Ähnlichkeit über den grössten minimalen Abstand. Der Vergleich zwischen den Flügen (Abbildung 13) zeigt jedoch ein ähnliches Muster wie DTW: Der grösste minimale Abstand zwischen den Flügen 3, 4 und 5 ist vergleichsweise gering. Bei den Flügen 1 und 2 ist er im Vergleich mit den anderen Flügen hoch und zwischen den Flügen 1 und 2 besonders hoch.
# -----------------------------------------------------------------------------
# Frechet Distance Flug 4
# -----------------------------------------------------------------------------
# Visualisierung als Heatmap
pheatmap(frechet_matrix_scaled,
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100))
# -----------------------------------------------------------------------------
# Frechet-Distance Individuum S
# -----------------------------------------------------------------------------
# Heatmap erstellen
pheatmap(frechet_matrix_scaled,
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
Für Flug 4 lassen sich die Trajektorien auf Basis der Länge von gemeinsamen Teilsequenzen wiederum in die drei Cluster einteilen (Abbildung 14), welche mit den Clustern von DTW und EditDist übereinstimmen. Den flugübergreifenden Vergleich konnten wir aufgrund des hohen Rechenaufwands dieser Methode nicht durchführen.
# -----------------------------------------------------------------------------
# LCSS Flug 4
# -----------------------------------------------------------------------------
# Visualisierung als Heatmap
pheatmap(lcss_matrix,
color = colorRampPalette(c("blue", "lightblue", "mistyrose", "red"))(100),
na_col = "grey90")
Die Geschwindigkeit der Brieftauben folgt einem wiederkehrenden Muster. Zu Beginn des Fluges ist die Geschwindigkeit meist gering und steigt im weiteren Verlauf an.Sie erreicht häufig im mittleren Abschnitt des Fluges ein Maximum und fällt gegen Ende des Fluges leicht ab (vgl. Abbildung 16 und Abbildung 18). Dieses Muster ist sowohl bei der gruppenübergreifenden Betrachtung verschiedener Flüge (Abbildung 16) als auch bei den Einzelflügen aller Individuen des Fluges Nr. 4 (Abbildung 18) zu erkennen.
# -----------------------------------------------------------------------------
# Erneutes Durchführen der Segmentierung (bereinigte Datengrundlage) - Individuum S
# -----------------------------------------------------------------------------
# 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))
# -----------------------------------------------------------------------------
# Trajektorien einfärben auf Karte nach der mittleren Segment-Geschwindigkeit
# -----------------------------------------------------------------------------
# Plot:
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(x = "Längengrad", y = "Breitengrad", color = "Mittlere Geschwindigkeit (m/s)") +
theme_minimal(base_size = 14) +
theme(legend.position = "bottom")
# -----------------------------------------------------------------------------
# Scatterplot: Mittlere Segment-Geschwindigkeit aller fünf Flüge des Individuums S relativ zur Flugposition
# -----------------------------------------------------------------------------
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(x = "Relative Position im Flug (0 = Start, 1 = Ende)",
y = "Mittlere Geschwindigkeit (m/s)", color = "Flug") +
theme_minimal(base_size = 14)
# -----------------------------------------------------------------------------
# Erneutes Durchführen der Segmentierung (bereinigte Datengrundlage) - Flug 4
# -----------------------------------------------------------------------------
# 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))
# -----------------------------------------------------------------------------
# Trajektorien einfärben nach der mittleren Segment-Geschwindigkeit - Facet-Wrap
# -----------------------------------------------------------------------------
# Plot:
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(x = "Längengrad", y = "Breitengrad", color = "Mittlere Geschwindigkeit (m/s)") +
theme_minimal(base_size = 14) +
theme(legend.position = "bottom")
# -----------------------------------------------------------------------------
# Scatterplot: Mittlere Segment-Geschwindigkeit aller Individuen auf Flug 4 relativ zur Flugposition
# -----------------------------------------------------------------------------
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(x = "Relative Position im Flug (0 = Start, 1 = Ende)",
y = "Mittlere Geschwindigkeit (m/s)", color = "Flug") +
theme_minimal(base_size = 14)
Der Code zur Darstellung der Resultate der Geschwindigkeitsanalysen wurde unter Beizug von ChatGPT erstellt.
Die Sinuosität im Flug 4 ist zu Beginn des Fluges sehr hoch (Abbildung 19). Im weiteren Verlauf des Fluges nimmt die Sinuosität deutlich ab. Um die Unterschiede der Sinuosität der Individuen ohne Verzerrung darzustellen, haben wir in einer zweiten Abbildung (Abbildung 20) das Segment 3 entfernt. Die Sinuositätsverläufe der einzelnen Individuen ähneln sich stark und es treten nur minimale Abweichungen auf.
# -------------------------#
# Vergleich innerhalb des Flugs 4
# -------------------------#
# 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")
# 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")
Die hohe Sinuosität in Segment 3 wird durch eine geflogene Schleife verursacht (Abbildung 21). Weiter ist auf der Karte eine hohe Sinuosität im Segment 1 erkennbar.
# -------------------------#
# Sinuosität des Individuums S auf Flug 4 - Karte
# -------------------------#
# 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)
Die Sinuosität der Flugtrajektorien von Individuum S über alle Flüge zeigt, dass zu Beginn des Flugs die Sinuosität hoch ist und im weiteren Verlauf deutlich abnimmt (Abbildung 22).
# -------------------------#
# Individuum S über alle Flüge
# -------------------------#
# 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)
Das Muster der hohen Sinuosität zu Beginn des Fluges ist auch auf der Karte der Sinuosität der Flugtrajektorien des Individuum S ersichtlich (Abbildung 23).
# -------------------------#
# Karte: Individuum S über alle Flüge
# -------------------------#
# 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)
Zur Erstellung der Plots wurde ChatGPT beigezogen, um die Gestaltung zu optimieren und eine Logarithmierung der Achsen umzusetzen.
Die Auswertung der Führungszeiten (Abbildung 24) zeigt eine deutliche Hierarchie: Das Individuum «M» übernimmt mit Abstand am häufigsten die Führungsposition, gefolgt von den Individuen «O» und «T». Demgegenüber zeigen andere Individuen wie «N» oder «R» nur selten Führungsverhalten. Die Resultate deuten darauf hin, dass bestimmte Individuen überproportional häufig die Navigation des Schwarms übernehmen.
# -----------------------------------------------------------------------------
# Führungsdynamik aller Individuen auf Flug 4 - Führungsanteile über die Zeit verteilt
# -----------------------------------------------------------------------------
# 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"))
# -----------------------------------------------------------------------------
# Plot - Führungsanteile über die Zeit verteilt
# -----------------------------------------------------------------------------
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(x = "Taube", y = "Anzahl Sekunden in Führung") +
theme_minimal() +
theme(legend.position = "none") 
# -----------------------------------------------------------------------------
# Plot - Führungszeitpunkte je Individuum
# -----------------------------------------------------------------------------
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(x = "Zeit", y = "Anzahl Zeitpunkte (pro Bin)") +
theme_minimal() +
theme(legend.position = "bottom")
# -----------------------------------------------------------------------------
# Interaktive Karte - Übersicht Führung je Schwarmmittelpunkt und Zeitpunkt
# -----------------------------------------------------------------------------
# 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"
)Der Code zur Darstellung der Resultate der Führungsdynamik wurde unter Beizug von ChatGPT erstellt.
Unsere Analysen bestätigen weitgehend die in der Literatur beschriebenen Muster im Bewegungsverhalten von Brieftauben. Sowohl Geschwindigkeits- als auch Sinuositätsverläufe zeigen eine zwei- bzw. dreiphasige Flugstruktur. Nach einer initialen Orientierungsphase mit geringer Geschwindigkeit und erhöhter Sinuosität folgt ein zielgerichteter, geradliniger und beschleunigter Heimflug. In der Geschwindigkeit ist zudem gegen Ende des Fluges eine leichte Verlangsamung erkennbar. Dasselbe Muster wurde durch (Schiffner & Wiltschko, 2009) identifiziert, die einen deutlichen Anstieg der Linearität und Fluggeschwindigkeit als Entscheidungszeitpunkt für den Heimflug identifizieren. Unsere Annahme einer initialen Orientierungsphase wird durch(Laube et al., 2007) ebenfalls gestützt und durch die Möglichkeit einer Schwarmkoordination ergänzt.
In unseren Schlussfolgerungen zu der Flugstruktur muss berücksichtigt werden, dass die tatsächlichen Start- und Endphasen in den zugrundeliegenden Daten von (Santos et al., 2014) entfernt wurden. (Santos et al., 2014) interessierten sich in ihrer Auswertung ausschliesslich für das Verhalten der Brieftauben im Gruppenflug, weshalb die Flugsegmente, in denen sich die Individuen aufteilten, entfernt wurden. Daher können keine belastbaren Aussagen über spezifische Muster, insbesondere im letzten Flugabschnitt, gemacht werden.
Zu beachten ist weiterhin, dass die Geschwindigkeitsberechnungen ausschliesslich auf zweidimensionaler Basis erfolgten, wodurch insbesondere bei vertikalen Flugbewegungen Verzerrungen nicht ausgeschlossen werden können.
Auch unsere Analyse der Führungsdynamik zeigt ein Muster, welches in der Literatur wiederholt beschrieben wurde. Bestimmte Individuen, in Flug 4 insbesondere das Individuum M, nehmen wiederholt eine führende Position ein, was auf stabile Führungsstrukturen im Schwarmverhalten hinweist, wie sie auch von (Santos et al., 2014) und (Nagy et al., 2010) identifiziert wurden. Beiden Studien zeigen, dass sich in Taubenschwärmen konsistente Leader-Follower-Beziehungen herausbilden können, die unabhängig von der Flugroute bestehen bleiben. Unsere Methode zur Bestimmung der Führung erfolgt über die Projektion individueller Bewegungsrichtungen auf den mittleren Schwarmvektor. Dieses Verfahren erlaubt jedoch keine Aussage darüber, welches Individuum wem konkret folgt und inwiefern Richtungsentscheidungen beeinflusst werden, sondern identifiziert lediglich jenes Individuum, das sich zu einem gegebenen Zeitpunkt in Richtung und Distanz am stärksten in Flugrichtung vom Schwarmmittelpunkt entfernt hat. Es kann daher nicht ausgeschlossen werden, dass es sich beim als führend identifizierten Individuum um ein ausreissendes Tier handelt, das nicht zwangsläufig eine leitende Rolle im Schwarmverhalten einnimmt. Eine solche Interpretation steht im Einklang mit (Pettit et al., 2015), die darauf hinweisen, dass Führung nicht zwingend durch Navigationsfähigkeit motiviert sein muss, sondern auch durch individuelle Initiative oder Positionierung entstehen kann.
wordcountaddin::word_count("Report_krieg_erni.qmd")[1] 1176