add interactive map with leaflet

src/app.Rmd

@@ -39,7 +39,7 @@ ui <- fluidPage(
       hr(),
       
       h4("Batch Analysis"),
-      numericInput("batch_size", "Days of flights to analyze:", value = 5, min = 1, max = 30),
+      numericInput("batch_size", "Number of flights to analyze:", value = 10, min = 2, max = 50),
       actionButton("batch_analyze", "Run Batch Analysis", class = "btn-warning"),
       
       hr(),
@@ -60,7 +60,7 @@ ui <- fluidPage(
         
         tabPanel("Single Flight Analysis",
                  fluidRow(
-                   column(6, plotOutput("route_plot", height = "400px")),
+                   column(6, leafletOutput("route_plot", height = "400px")),
                    column(6, plotOutput("altitude_plot", height = "400px"))
                  ),
                  fluidRow(
@@ -144,7 +144,6 @@ server <- function(input, output, session) {
           data.frame(
             Index = i,
             ICAO24 = dep[["ICAO24"]] %||% NA,
-            #FIXME Callsign, Origin, Destination
             Callsign = dep[["callsign"]] %||% NA,
             Origin = dep[["estDepartureAirport"]] %||% NA,
             Destination = dep[["estArrivalAirport"]] %||% NA,
@@ -215,11 +214,9 @@ server <- function(input, output, session) {
   })
   
   # Route plot
-  output$route_plot <- renderPlot({
+  output$route_plot <- renderLeaflet({
     req(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")
+    createInteractiveMap(rv$current_route)
   })
   
   # Altitude plot
@@ -249,9 +246,28 @@ server <- function(input, output, session) {
     status("Running batch analysis...")
     
     tryCatch({
+      all_trajectories <- list()
+      n_departures <- min(length(rv$departures), input$batch_size)
       
       withProgress(message = 'Analyzing flights', value = 0, {
-        all_trajectories <- getAircraftTrajectories(rv$current_icao, time = Sys.time(), creds, days = input$batch_size)
+        for (i in 1:n_departures) {
+          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) {

src/main.Rmd

@@ -2,18 +2,13 @@
 title: "Topic 8 - Flight Trajectory Analysis"
 subtitle: "Erik Neller, Patrik Mišura, Lukas Adrion"
 output:
-  pdf_document: default
   html_document: default
+  pdf_document: default
 date: "`r Sys.Date()`"
 ---
 
 ```{r setup, include=FALSE}
 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}
@@ -28,6 +23,7 @@ library(httr)
 library(jsonlite)
 library(trajr)
 library(shiny)
+library(leaflet)
 ```
 
 ```{r opensky, include=FALSE}
@@ -56,8 +52,6 @@ getAircraftTrack <- function(icao, time, creds) {
   }
   return(NULL)
 }
-
-
 ```
 
 ```{r trajectory-functions, include=FALSE}
@@ -93,6 +87,7 @@ getTrajFromRoute <- function(route_df) {
 # Calculate trajectory characteristics
 # 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
+# FIXME for batch analysis: use the same aircraft
 calculateTrajectoryStats <- function(input, icao = NULL, format = "row") {
   # Determine if input is route_df or trj
   if (inherits(input, "Trajectory")) {
@@ -171,21 +166,6 @@ calculate_trajectory_params <- function(icao, departure_time, creds) {
     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}
@@ -229,6 +209,27 @@ calculateStatsSummary <- function(trajectory_stats_df) {
 ```{r viz-functions, include=FALSE}
 # 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
 createBoxplots <- function(trajectory_stats_df) {
   p <- getTrajectoryParams()
@@ -388,7 +389,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.
 
-```{r, purl=FALSE}
+```r
 creds <- getCredentials(
   client_id = Sys.getenv("OPENSKY_CLIENT_ID"),
   client_secret = Sys.getenv("OPENSKY_CLIENT_SECRET")
@@ -399,7 +400,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.
 
-```{r demo-departures, purl=FALSE}
+```{r demo-departures}
 time_now <- Sys.time()
 departures <- getAirportDepartures(
   airport = "EDDF", 
@@ -414,7 +415,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.
 
-```{r demo-track, purl=FALSE}
+```{r demo-track}
 route_df <- NULL
 icao <- "N/A"
 
@@ -428,7 +429,6 @@ if (length(departures) > 0) {
       cat("Track points acquired:", nrow(route_df), "\n")
       break
     }
-    Sys.sleep(1)
   }
 }
 
@@ -439,17 +439,11 @@ if (is.null(route_df)) {
 
 ## Step 4: Spatial Visualization
 
-The geographic trajectory is visualized in a Cartesian coordinate system. 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, purl=FALSE}
+```{r demo-route-plot, fig.width=7, fig.height=5}
 if (!is.null(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"))
+  createInteractiveMap(route_df)
 } else {
   cat("Insufficient data for visualization\n")
 }
@@ -459,7 +453,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.
 
-```{r demo-altitude-plot, fig.width=7, fig.height=4, purl=FALSE}
+```{r demo-altitude-plot, fig.width=7, fig.height=4}
 if (!is.null(route_df)) {
   time_minutes <- (route_df$time - route_df$time[1]) / 60
   plot(time_minutes, route_df$alt, type = "l", col = "red", lwd = 2,
@@ -475,7 +469,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.
 
-```{r demo-trajectory-plot, fig.width=7, fig.height=5, purl=FALSE}
+```{r demo-trajectory-plot, fig.width=7, fig.height=5}
 if (!is.null(route_df)) {
   trj <- getTrajFromRoute(route_df)
   plot(trj, main = paste("Metric Trajectory -", icao))
@@ -489,7 +483,7 @@ if (!is.null(route_df)) {
 
 The `calculateTrajectoryStats()` function computes comprehensive trajectory metrics. The table format provides a clear overview of individual flight characteristics.
 
-```{r demo-stats-table, purl=FALSE}
+```{r demo-stats-table}
 if (!is.null(route_df)) {
   stats_table <- calculateTrajectoryStats(route_df, icao = icao, format = "table")
   knitr::kable(stats_table, caption = paste("Trajectory Metrics for Aircraft", icao))
@@ -502,7 +496,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.
 
-```{r demo-multiple-tracks, purl=FALSE}
+```{r demo-multiple-tracks}
 flight_data <- list()
 successful_flights <- 0
 
@@ -547,7 +541,7 @@ if (length(departures) > 0) {
 
 The following table presents computed metrics for all successfully analyzed flights.
 
-```{r demo-all-stats-table, purl=FALSE}
+```{r demo-all-stats-table}
 if (!is.null(all_flights_stats)) {
   display_stats <- all_flights_stats
   display_stats$diffusion_distance_km <- round(display_stats$diffusion_distance_km, 2)
@@ -569,7 +563,7 @@ if (!is.null(all_flights_stats)) {
 
 The `calculateStatsSummary()` function computes central tendency and dispersion measures for each trajectory parameter.
 
-```{r demo-summary-stats, purl=FALSE}
+```{r demo-summary-stats}
 if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
   summary_stats <- calculateStatsSummary(all_flights_stats)
   knitr::kable(summary_stats, caption = "Descriptive Statistics Summary")
@@ -582,7 +576,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.
 
-```{r demo-boxplots, fig.width=10, fig.height=8, purl=FALSE}
+```{r demo-boxplots, fig.width=10, fig.height=8}
 if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
   createBoxplots(all_flights_stats)
 } else {
@@ -594,7 +588,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).
 
-```{r demo-density, fig.width=10, fig.height=8, purl=FALSE}
+```{r demo-density, fig.width=10, fig.height=8}
 if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
   createDensityPlots(all_flights_stats)
 } else {
@@ -606,7 +600,7 @@ if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
 
 Histograms with overlaid density curves provide an alternative visualization of parameter distributions.
 
-```{r demo-histograms, fig.width=10, fig.height=8, purl=FALSE}
+```{r demo-histograms, fig.width=10, fig.height=8}
 if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
   createHistograms(all_flights_stats)
 } else {
@@ -618,7 +612,7 @@ if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 3) {
 
 The `generateInterpretation()` function provides contextual analysis of the computed trajectory metrics.
 
-```{r demo-interpretation, purl=FALSE}
+```{r demo-interpretation}
 if (!is.null(all_flights_stats) && nrow(all_flights_stats) >= 2) {
   interpretation <- generateInterpretation(all_flights_stats)
   cat(interpretation)