flightpathr

Tools to analyze aircraft and flight path data.
git clone https://git.eamoncaddigan.net/flightpathr.git
Log | Files | Refs | README | LICENSE

identifyManeuvers.R (3966B)

      1 #' Identify the timepoints in a trajectory that correspond to a change in
      2 #' commanded heading.
      3 #'
      4 #' @param trajectory A \code{flighttrajectory} object (or input coercable to
      5 #'   one) indicating the trajectory of an aircraft.
      6 #' @param bearingThresh A bearing change threshold (in degrees).
      7 #' @param turnThresh A turn rate threshold (in degrees per second).
      8 #'
      9 #' @return A logical vector indicating whether each timepoint can be considered
     10 #'   a turn.
     11 #'
     12 #' @details A period is marked as a turn if the turn rate is greater than
     13 #'   \code{turnThresh} and the total bearing change is greater than
     14 #'   \code{bearingThresh}.
     15 #'
     16 #' @export
     17 identifyBearingChanges <- function(trajectory, bearingThresh, turnThresh) {
     18   traj <- as.flighttrajectory(trajectory)
     19 
     20   bearingChanges <- c(NA,
     21                       angleDiff(traj$bearing[1:(length(traj$bearing)-1)],
     22                                 traj$bearing[2:length(traj$bearing)])) /
     23     c(NA, diff(traj$time))
     24 
     25   isBearingChange <- identifyChanges(traj$bearing, bearingChanges,
     26                                      bearingThresh, turnThresh)
     27 
     28   return(isBearingChange)
     29 }
     30 
     31 #' Identify the timepoints in a trajectory that correspond to a change in
     32 #' altitude.
     33 #'
     34 #' @param trajectory A \code{flighttrajectory} object (or input coercable to
     35 #'   one) indicating the trajectory of an aircraft.
     36 #' @param altitudeThresh An altitude threshold (in feet).
     37 #' @param verticalSpeedThresh A vertical speed threshold (in feet per second).
     38 #'
     39 #' @return A logical vector indicating whether each timepoint can be considered
     40 #'   a climb or descent.
     41 #'
     42 #' @export
     43 identifyAltitudeChanges <- function(trajectory, altitudeThresh, verticalSpeedThresh) {
     44   traj <- as.flighttrajectory(trajectory)
     45   altitudeChanges <- c(NA, diff(traj$altitude)) / c(NA, diff(traj$time))
     46 
     47   isAltitudeChange <- identifyChanges(traj$altitude, altitudeChanges,
     48                                       altitudeThresh, verticalSpeedThresh)
     49 
     50   return(isAltitudeChange)
     51 }
     52 
     53 #' Identify the timepoints in a trajectory that correspond to a change in
     54 #' speed.
     55 #'
     56 #' @param trajectory A \code{flighttrajectory} object (or input coercable to
     57 #'   one) indicating the trajectory of an aircraft.
     58 #' @param speedThresh A speed threshold (in knots).
     59 #' @param accelerationThresh An accelaration threshold (in knots per second).
     60 #'
     61 #' @return A logical vector indicating whether each timepoint can be considered
     62 #'   a change in speed
     63 #'
     64 #' @export
     65 identifySpeedChanges <- function(trajectory, speedThresh, accelerationThresh) {
     66   traj <- as.flighttrajectory(trajectory)
     67   speedChanges <- c(NA, diff(traj$groundspeed)) / c(NA, diff(traj$time))
     68 
     69   isSpeedChange <- identifyChanges(traj$groundspeed, speedChanges,
     70                                    speedThresh, accelerationThresh)
     71 
     72   return(isSpeedChange)
     73 }
     74 
     75 #' Helper function for identifying changes based on change magnitude and change
     76 #' slope.
     77 identifyChanges <- function(x, dx, xThresh, dxThresh) {
     78   # First apply the threshold to the derivative (w.r.t. time) to identify
     79   # periods that may contain valid changes.
     80   aboveThresh <- abs(dx) > dxThresh
     81   aboveThresh[is.na(aboveThresh)] <- FALSE
     82 
     83   # Find the point before and after each of the change periods
     84   threshEdges <- diff(c(FALSE, aboveThresh, FALSE))
     85   regionStart <- which(threshEdges > 0) - 1
     86   regionEnd <- which(threshEdges < 0)
     87 
     88   # Deal with regions that start or end at the ends of the vector
     89   regionStart[1] <- max(regionStart[1], 1)
     90   regionEnd[length(regionEnd)] <- min(regionEnd[length(regionEnd)],
     91                                       length(dx))
     92 
     93   # Find the magnitude of the change in each region
     94   changeMagnitude <- x[regionEnd] - x[regionStart]
     95 
     96   # Censor the changes that aren't above the threshold
     97   censorChanges <- which(abs(changeMagnitude) < xThresh)
     98 
     99   # Loop through the below-threshold changes and censor them
    100   for (i in censorChanges) {
    101     aboveThresh[regionStart[i]:regionEnd[i]] <- FALSE
    102   }
    103 
    104   return(aboveThresh)
    105 }