Merge branch 'feat/trajectories-and-alternative-gui' into feat/add-osm-for-trajectory

This commit is contained in:
eneller
2026-01-21 15:14:32 +01:00
2 changed files with 40 additions and 36 deletions

View File

@@ -39,7 +39,7 @@ ui <- fluidPage(
hr(), hr(),
h4("Batch Analysis"), h4("Batch Analysis"),
numericInput("batch_size", "Number of flights to analyze:", value = 10, min = 2, max = 50), numericInput("batch_size", "Days of flights to analyze:", value = 5, min = 1, max = 30),
actionButton("batch_analyze", "Run Batch Analysis", class = "btn-warning"), actionButton("batch_analyze", "Run Batch Analysis", class = "btn-warning"),
hr(), hr(),
@@ -144,6 +144,7 @@ server <- function(input, output, session) {
data.frame( data.frame(
Index = i, Index = i,
ICAO24 = dep[["ICAO24"]] %||% NA, ICAO24 = dep[["ICAO24"]] %||% NA,
#FIXME Callsign, Origin, Destination
Callsign = dep[["callsign"]] %||% NA, Callsign = dep[["callsign"]] %||% NA,
Origin = dep[["estDepartureAirport"]] %||% NA, Origin = dep[["estDepartureAirport"]] %||% NA,
Destination = dep[["estArrivalAirport"]] %||% NA, Destination = dep[["estArrivalAirport"]] %||% NA,
@@ -246,28 +247,9 @@ server <- function(input, output, session) {
status("Running batch analysis...") status("Running batch analysis...")
tryCatch({ tryCatch({
all_trajectories <- list()
n_departures <- min(length(rv$departures), input$batch_size)
withProgress(message = 'Analyzing flights', value = 0, { withProgress(message = 'Analyzing flights', value = 0, {
for (i in 1:n_departures) { all_trajectories <- getAircraftTrajectories(rv$current_icao, time = Sys.time(), creds, days = input$batch_size)
dep <- rv$departures[[i]]
icao24 <- dep[["ICAO24"]]
dep_time <- dep[["departure_time"]]
incProgress(1/n_departures, detail = paste("Processing", icao24))
if (is.null(dep_time)) next
# Use calculate_trajectory_params from main.Rmd
params <- calculate_trajectory_params(icao24, dep_time, rv$creds)
if (!is.null(params)) {
all_trajectories[[length(all_trajectories) + 1]] <- params
}
Sys.sleep(0.3)
}
}) })
if (length(all_trajectories) > 0) { if (length(all_trajectories) > 0) {

View File

@@ -9,6 +9,11 @@ date: "`r Sys.Date()`"
```{r setup, include=FALSE} ```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE) knitr::opts_chunk$set(echo = TRUE)
# include `eval=isArtifact()` to check if pdf/html is being produced
isArtifact <- function(){
isOutput <-knitr::is_html_output() || knitr::is_latex_output()
return(isOutput)
}
``` ```
```{r preamble, message=FALSE, include=FALSE} ```{r preamble, message=FALSE, include=FALSE}
@@ -52,6 +57,8 @@ getAircraftTrack <- function(icao, time, creds) {
} }
return(NULL) return(NULL)
} }
``` ```
```{r trajectory-functions, include=FALSE} ```{r trajectory-functions, include=FALSE}
@@ -87,7 +94,6 @@ getTrajFromRoute <- function(route_df) {
# Calculate trajectory characteristics # Calculate trajectory characteristics
# Input: either route_df (data.frame with lat/lon) or trj (trajr object) # Input: either route_df (data.frame with lat/lon) or trj (trajr object)
# format: "row" for batch analysis (one row per flight), "table" for single flight display # format: "row" for batch analysis (one row per flight), "table" for single flight display
# FIXME for batch analysis: use the same aircraft
calculateTrajectoryStats <- function(input, icao = NULL, format = "row") { calculateTrajectoryStats <- function(input, icao = NULL, format = "row") {
# Determine if input is route_df or trj # Determine if input is route_df or trj
if (inherits(input, "Trajectory")) { if (inherits(input, "Trajectory")) {
@@ -166,6 +172,21 @@ calculate_trajectory_params <- function(icao, departure_time, creds) {
return(NULL) return(NULL)
}) })
} }
getAircraftTrajectories <- function(icao, time, creds, days = 5){
tracks <- list()
for (i in 0: (days-1)) {
flights <- getFlights(icao,time - days(i),creds)
for (f in flights){
track <- calculate_trajectory_params(icao, f[["departure_time"]], creds)
if (!is.null(track)){
tracks[[length(tracks)+1]] <- track
}
Sys.sleep(0.5) # API courtesy
}
}
return(tracks)
}
``` ```
```{r stat-functions, include=FALSE} ```{r stat-functions, include=FALSE}
@@ -389,7 +410,7 @@ The full analysis is also available in the GUI-based Shiny application.
The `getCredentials()` function retrieves API credentials from environment variables, ensuring secure credential management. The `getCredentials()` function retrieves API credentials from environment variables, ensuring secure credential management.
```r ```{r, purl=FALSE}
creds <- getCredentials( creds <- getCredentials(
client_id = Sys.getenv("OPENSKY_CLIENT_ID"), client_id = Sys.getenv("OPENSKY_CLIENT_ID"),
client_secret = Sys.getenv("OPENSKY_CLIENT_SECRET") client_secret = Sys.getenv("OPENSKY_CLIENT_SECRET")
@@ -400,7 +421,7 @@ creds <- getCredentials(
Recent departures from Frankfurt Airport (ICAO: EDDF) are queried for a two-hour time window. This airport was selected due to its high traffic volume, ensuring sufficient data availability. Recent departures from Frankfurt Airport (ICAO: EDDF) are queried for a two-hour time window. This airport was selected due to its high traffic volume, ensuring sufficient data availability.
```{r demo-departures} ```{r demo-departures, purl=FALSE}
time_now <- Sys.time() time_now <- Sys.time()
departures <- getAirportDepartures( departures <- getAirportDepartures(
airport = "EDDF", airport = "EDDF",
@@ -415,7 +436,7 @@ cat("Departures retrieved:", length(departures), "\n")
The `getAircraftTrack()` function retrieves detailed waypoint data for individual aircraft. The function iterates through available departures until valid track data is obtained. The `getAircraftTrack()` function retrieves detailed waypoint data for individual aircraft. The function iterates through available departures until valid track data is obtained.
```{r demo-track} ```{r demo-track, purl=FALSE}
route_df <- NULL route_df <- NULL
icao <- "N/A" icao <- "N/A"
@@ -429,6 +450,7 @@ if (length(departures) > 0) {
cat("Track points acquired:", nrow(route_df), "\n") cat("Track points acquired:", nrow(route_df), "\n")
break break
} }
Sys.sleep(1)
} }
} }
@@ -441,7 +463,7 @@ if (is.null(route_df)) {
The geographic trajectory is visualized on an interactive map with leaflet using the `createInteractiveMap()` function. Green and red markers indicate departure and current/final position, respectively. The geographic trajectory is visualized on an interactive map with leaflet using the `createInteractiveMap()` function. Green and red markers indicate departure and current/final position, respectively.
```{r demo-route-plot, fig.width=7, fig.height=5} ```{r demo-route-plot, fig.width=7, fig.height=5, purl=FALSE}
if (!is.null(route_df)) { if (!is.null(route_df)) {
createInteractiveMap(route_df) createInteractiveMap(route_df)
} else { } else {
@@ -453,7 +475,7 @@ if (!is.null(route_df)) {
The altitude profile reveals distinct flight phases: climb, cruise, and descent. This temporal representation provides insight into vertical movement patterns. The altitude profile reveals distinct flight phases: climb, cruise, and descent. This temporal representation provides insight into vertical movement patterns.
```{r demo-altitude-plot, fig.width=7, fig.height=4} ```{r demo-altitude-plot, fig.width=7, fig.height=4, purl=FALSE}
if (!is.null(route_df)) { if (!is.null(route_df)) {
time_minutes <- (route_df$time - route_df$time[1]) / 60 time_minutes <- (route_df$time - route_df$time[1]) / 60
plot(time_minutes, route_df$alt, type = "l", col = "red", lwd = 2, plot(time_minutes, route_df$alt, type = "l", col = "red", lwd = 2,
@@ -469,7 +491,7 @@ if (!is.null(route_df)) {
The `getTrajFromRoute()` function transforms geographic coordinates into a metric coordinate system and constructs a `trajr` trajectory object. This transformation is necessary for accurate distance calculations. The `getTrajFromRoute()` function transforms geographic coordinates into a metric coordinate system and constructs a `trajr` trajectory object. This transformation is necessary for accurate distance calculations.
```{r demo-trajectory-plot, fig.width=7, fig.height=5} ```{r demo-trajectory-plot, fig.width=7, fig.height=5, purl=FALSE}
if (!is.null(route_df)) { if (!is.null(route_df)) {
trj <- getTrajFromRoute(route_df) trj <- getTrajFromRoute(route_df)
plot(trj, main = paste("Metric Trajectory -", icao)) plot(trj, main = paste("Metric Trajectory -", icao))
@@ -483,7 +505,7 @@ if (!is.null(route_df)) {
The `calculateTrajectoryStats()` function computes comprehensive trajectory metrics. The table format provides a clear overview of individual flight characteristics. The `calculateTrajectoryStats()` function computes comprehensive trajectory metrics. The table format provides a clear overview of individual flight characteristics.
```{r demo-stats-table} ```{r demo-stats-table, purl=FALSE}
if (!is.null(route_df)) { if (!is.null(route_df)) {
stats_table <- calculateTrajectoryStats(route_df, icao = icao, format = "table") stats_table <- calculateTrajectoryStats(route_df, icao = icao, format = "table")
knitr::kable(stats_table, caption = paste("Trajectory Metrics for Aircraft", icao)) knitr::kable(stats_table, caption = paste("Trajectory Metrics for Aircraft", icao))
@@ -496,7 +518,7 @@ if (!is.null(route_df)) {
To enable statistical inference, trajectory data is collected for multiple flights. The algorithm attempts to retrieve valid track data for up to five departures in this example. To enable statistical inference, trajectory data is collected for multiple flights. The algorithm attempts to retrieve valid track data for up to five departures in this example.
```{r demo-multiple-tracks} ```{r demo-multiple-tracks, purl=FALSE}
flight_data <- list() flight_data <- list()
successful_flights <- 0 successful_flights <- 0
@@ -541,7 +563,7 @@ if (length(departures) > 0) {
The following table presents computed metrics for all successfully analyzed flights. The following table presents computed metrics for all successfully analyzed flights.
```{r demo-all-stats-table} ```{r demo-all-stats-table, purl=FALSE}
if (!is.null(all_flights_stats)) { if (!is.null(all_flights_stats)) {
display_stats <- all_flights_stats display_stats <- all_flights_stats
display_stats$diffusion_distance_km <- round(display_stats$diffusion_distance_km, 2) display_stats$diffusion_distance_km <- round(display_stats$diffusion_distance_km, 2)
@@ -563,7 +585,7 @@ if (!is.null(all_flights_stats)) {
The `calculateStatsSummary()` function computes central tendency and dispersion measures for each trajectory parameter. The `calculateStatsSummary()` function computes central tendency and dispersion measures for each trajectory parameter.
```{r demo-summary-stats} ```{r demo-summary-stats, purl=FALSE}
if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) { if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
summary_stats <- calculateStatsSummary(all_flights_stats) summary_stats <- calculateStatsSummary(all_flights_stats)
knitr::kable(summary_stats, caption = "Descriptive Statistics Summary") knitr::kable(summary_stats, caption = "Descriptive Statistics Summary")
@@ -576,7 +598,7 @@ if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
Boxplots provide a robust visualization of parameter distributions, displaying median, interquartile range, and potential outliers. The red diamond indicates the arithmetic mean. Boxplots provide a robust visualization of parameter distributions, displaying median, interquartile range, and potential outliers. The red diamond indicates the arithmetic mean.
```{r demo-boxplots, fig.width=10, fig.height=8} ```{r demo-boxplots, fig.width=10, fig.height=8, purl=FALSE}
if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) { if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
createBoxplots(all_flights_stats) createBoxplots(all_flights_stats)
} else { } else {
@@ -588,7 +610,7 @@ if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
Density plots employ kernel density estimation to approximate the probability distribution of each parameter. Vertical lines indicate mean (red, dashed) and median (green, dotted). Density plots employ kernel density estimation to approximate the probability distribution of each parameter. Vertical lines indicate mean (red, dashed) and median (green, dotted).
```{r demo-density, fig.width=10, fig.height=8} ```{r demo-density, fig.width=10, fig.height=8, purl=FALSE}
if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) { if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
createDensityPlots(all_flights_stats) createDensityPlots(all_flights_stats)
} else { } else {
@@ -600,7 +622,7 @@ if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
Histograms with overlaid density curves provide an alternative visualization of parameter distributions. Histograms with overlaid density curves provide an alternative visualization of parameter distributions.
```{r demo-histograms, fig.width=10, fig.height=8} ```{r demo-histograms, fig.width=10, fig.height=8, purl=FALSE}
if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) { if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
createHistograms(all_flights_stats) createHistograms(all_flights_stats)
} else { } else {
@@ -612,7 +634,7 @@ if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
The `generateInterpretation()` function provides contextual analysis of the computed trajectory metrics. The `generateInterpretation()` function provides contextual analysis of the computed trajectory metrics.
```{r demo-interpretation} ```{r demo-interpretation, purl=FALSE}
if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) { if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
interpretation <- generateInterpretation(all_flights_stats) interpretation <- generateInterpretation(all_flights_stats)
cat(interpretation) cat(interpretation)