Compare commits
5 Commits
133827c2bd
...
feat/traje
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f4955af7f4 | ||
|
|
2757a86383 | ||
|
|
a7aa5025ea | ||
|
|
74292bd0ec | ||
|
|
ec51069f1d |
32
src/app.Rmd
32
src/app.Rmd
@@ -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(),
|
||||||
@@ -60,7 +60,7 @@ ui <- fluidPage(
|
|||||||
|
|
||||||
tabPanel("Single Flight Analysis",
|
tabPanel("Single Flight Analysis",
|
||||||
fluidRow(
|
fluidRow(
|
||||||
column(6, leafletOutput("route_plot", height = "400px")),
|
column(6, plotOutput("route_plot", height = "400px")),
|
||||||
column(6, plotOutput("altitude_plot", height = "400px"))
|
column(6, plotOutput("altitude_plot", height = "400px"))
|
||||||
),
|
),
|
||||||
fluidRow(
|
fluidRow(
|
||||||
@@ -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,
|
||||||
@@ -214,9 +215,11 @@ server <- function(input, output, session) {
|
|||||||
})
|
})
|
||||||
|
|
||||||
# Route plot
|
# Route plot
|
||||||
output$route_plot <- renderLeaflet({
|
output$route_plot <- renderPlot({
|
||||||
req(rv$current_route)
|
req(rv$current_route)
|
||||||
createInteractiveMap(rv$current_route)
|
plot(rv$current_route$lon, rv$current_route$lat, type = "o", pch = 20, col = "blue",
|
||||||
|
main = paste("Geographic Route of", rv$current_icao),
|
||||||
|
xlab = "Longitude", ylab = "Latitude")
|
||||||
})
|
})
|
||||||
|
|
||||||
# Altitude plot
|
# Altitude plot
|
||||||
@@ -246,28 +249,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) {
|
||||||
|
|||||||
86
src/main.Rmd
86
src/main.Rmd
@@ -2,13 +2,18 @@
|
|||||||
title: "Topic 8 - Flight Trajectory Analysis"
|
title: "Topic 8 - Flight Trajectory Analysis"
|
||||||
subtitle: "Erik Neller, Patrik Mišura, Lukas Adrion"
|
subtitle: "Erik Neller, Patrik Mišura, Lukas Adrion"
|
||||||
output:
|
output:
|
||||||
html_document: default
|
|
||||||
pdf_document: default
|
pdf_document: default
|
||||||
|
html_document: default
|
||||||
date: "`r Sys.Date()`"
|
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}
|
||||||
@@ -23,7 +28,6 @@ library(httr)
|
|||||||
library(jsonlite)
|
library(jsonlite)
|
||||||
library(trajr)
|
library(trajr)
|
||||||
library(shiny)
|
library(shiny)
|
||||||
library(leaflet)
|
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r opensky, include=FALSE}
|
```{r opensky, include=FALSE}
|
||||||
@@ -52,6 +56,8 @@ getAircraftTrack <- function(icao, time, creds) {
|
|||||||
}
|
}
|
||||||
return(NULL)
|
return(NULL)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r trajectory-functions, include=FALSE}
|
```{r trajectory-functions, include=FALSE}
|
||||||
@@ -87,7 +93,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 +171,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}
|
||||||
@@ -209,27 +229,6 @@ calculateStatsSummary <- function(trajectory_stats_df) {
|
|||||||
```{r viz-functions, include=FALSE}
|
```{r viz-functions, include=FALSE}
|
||||||
# Visualization Functions
|
# Visualization Functions
|
||||||
|
|
||||||
# Create interactive map with leaflet
|
|
||||||
createInteractiveMap <- function(route) {
|
|
||||||
leaflet(route) %>%
|
|
||||||
addTiles() %>%
|
|
||||||
addPolylines(lng=~lon, lat=~lat, color="blue", weight=3, opacity=0.8) %>%
|
|
||||||
addCircleMarkers(
|
|
||||||
lng = ~lon[1],
|
|
||||||
lat = ~lat[1],
|
|
||||||
color = "green",
|
|
||||||
radius = 6,
|
|
||||||
popup = "Origin"
|
|
||||||
) %>%
|
|
||||||
addCircleMarkers(
|
|
||||||
lng = ~lon[nrow(route)],
|
|
||||||
lat = ~lat[nrow(route)],
|
|
||||||
color = "red",
|
|
||||||
radius = 6,
|
|
||||||
popup = "Destination"
|
|
||||||
)
|
|
||||||
}
|
|
||||||
|
|
||||||
# Create boxplots for trajectory statistics
|
# Create boxplots for trajectory statistics
|
||||||
createBoxplots <- function(trajectory_stats_df) {
|
createBoxplots <- function(trajectory_stats_df) {
|
||||||
p <- getTrajectoryParams()
|
p <- getTrajectoryParams()
|
||||||
@@ -389,7 +388,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 +399,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 +414,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 +428,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)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -439,11 +439,17 @@ if (is.null(route_df)) {
|
|||||||
|
|
||||||
## Step 4: Spatial Visualization
|
## Step 4: Spatial Visualization
|
||||||
|
|
||||||
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 in a Cartesian coordinate system. 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)
|
plot(route_df$lon, route_df$lat, type = "o", pch = 20, col = "blue",
|
||||||
|
main = paste("Flight Trajectory -", icao),
|
||||||
|
xlab = "Longitude (°)", ylab = "Latitude (°)")
|
||||||
|
points(route_df$lon[1], route_df$lat[1], pch = 17, col = "green", cex = 2)
|
||||||
|
points(route_df$lon[nrow(route_df)], route_df$lat[nrow(route_df)], pch = 15, col = "red", cex = 2)
|
||||||
|
legend("topright", legend = c("Origin", "Destination", "Trajectory"),
|
||||||
|
pch = c(17, 15, 20), col = c("green", "red", "blue"))
|
||||||
} else {
|
} else {
|
||||||
cat("Insufficient data for visualization\n")
|
cat("Insufficient data for visualization\n")
|
||||||
}
|
}
|
||||||
@@ -453,7 +459,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 +475,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 +489,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 +502,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 +547,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 +569,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 +582,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 +594,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 +606,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 +618,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)
|
||||||
|
|||||||
Reference in New Issue
Block a user