flightpathr

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

commit 22a4ee17e5776b4ccdb608d3a9ac0a8636577425
parent 91fc900865c1a8168d8c13e46a145e9bfbffd99e
Author: eamoncaddigan <eamon.caddigan@gmail.com>
Date:   Tue, 11 Oct 2016 09:28:02 -0400

Trying to integrate hysteresis thresholding and airspeed changes.

Diffstat:
MNAMESPACE | 1+
MR/identifyManeuvers.R | 87+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------
Aman/hysteresisThresh.Rd | 16++++++++++++++++
Mman/identifyAltitudeChanges.Rd | 8++++----
Mman/identifyBearingChanges.Rd | 10++++++----
Aman/identifySpeedChanges.Rd | 26++++++++++++++++++++++++++
6 files changed, 125 insertions(+), 23 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE @@ -14,6 +14,7 @@ export(createTrajectory) export(distanceFromPath) export(identifyAltitudeChanges) export(identifyBearingChanges) +export(identifySpeedChanges) export(interpolateTrajectory) export(is.flightpath) export(is.flighttrajectory) diff --git a/R/identifyManeuvers.R b/R/identifyManeuvers.R @@ -3,20 +3,22 @@ #' #' @param trajectory A \code{flighttrajectory} object (or input coercable to #' one) indicating the trajectory of an aircraft. -#' @param hiThresh A bearing change (in degrees); any time point associated with -#' a change in bearing greater than this value will definitely be labeled a -#' turn. +#' @param loThresh A bearing change (in degrees per second) +#' @param hiThresh A bearing change (in degrees per second); any time point +#' associated with a change in bearing greater than this value will definitely +#' be labeled a turn. #' #' @return A logical vector indicating whether each timepoint can be considered #' a turn. #' #' @export -identifyBearingChanges <- function(trajectory, hiThresh) { - bearings <- as.flighttrajectory(trajectory)$bearing +identifyBearingChanges <- function(trajectory, loThresh, hiThresh = NA) { + t <- as.flighttrajectory(trajectory) - bearingChanges <- c(angleDiff(bearings[1:(length(bearings)-1)], - bearings[2:length(bearings)]), - NA) + bearingChanges <- c(NA, + angleDiff(t$bearing[1:(length(t$bearing)-1)], + t$bearing[2:length(t$bearing)])) / + c(NA, diff(t$time)) isBearingChange <- abs(bearingChanges) > hiThresh @@ -28,19 +30,74 @@ identifyBearingChanges <- function(trajectory, hiThresh) { #' #' @param trajectory A \code{flighttrajectory} object (or input coercable to #' one) indicating the trajectory of an aircraft. -#' @param hiThresh An altitude change (in feet); any time point associated with -#' a change in altitude greater than this value will definitely be labeled a -#' climb or descent. +#' @param hiThresh An altitude change (in feet per second); any time point +#' associated with a change in altitude greater than this value will +#' definitely be labeled a climb or descent. #' #' @return A logical vector indicating whether each timepoint can be considered #' a climb or descent. #' #' @export -identifyAltitudeChanges <- function(trajectory, hiThresh) { - trajectoryCoords <- get3dCoords(as.flighttrajectory(trajectory)) - altitudeChanges <- c(diff(trajectoryCoords[, 3]), 0) +identifyAltitudeChanges <- function(trajectory, loThresh, hiThresh = NA) { + t <- as.flighttrajectory(trajectory) + altitudeChanges <- c(NA, diff(t$altitude)) / c(NA, diff(t$time)) - isAltitudeChange <- abs(altitudeChanges) > hiThresh + isAltitudeChange <- hysteresisThresh(altitudeChanges, max(loThresh), max(hiThresh)) + if (length(loThresh) > 1) { + isAltitudeChange <- isAltitudeChange | + hysteresisThresh(-altitudeChanges, -min(loThresh), -min(hiThresh)) + } return(isAltitudeChange) } + +#' Identify the timepoints in a trajectory that correspond to a change in +#' altitude. +#' +#' @param trajectory A \code{flighttrajectory} object (or input coercable to +#' one) indicating the trajectory of an aircraft. +#' @param hiThresh An altitude change (in feet per second); any time point +#' associated with a change in altitude greater than this value will +#' definitely be labeled a climb or descent. +#' +#' @return A logical vector indicating whether each timepoint can be considered +#' a climb or descent. +#' +#' @export +identifySpeedChanges <- function(trajectory, loThresh, hiThresh = NA) { + t <- as.flighttrajectory(trajectory) + speedChanges <- c(NA, diff(t$groundspeed)) / c(NA, diff(t$time)) + + isSpeedChange <- hysteresisThresh(speedChanges, max(loThresh), max(hiThresh)) + if (length(loThresh) > 1) { + isSpeedChange <- isSpeedChange | + hysteresisThresh(-speedChanges, -min(loThresh), -min(hiThresh)) + } + + return(isSpeedChange) +} + +#' Helper function for hysteresis thresholding: if a group of neighboring +#' segments are all above the low threshold and neighbor a segment above the +#' high threshold, they're "above threshold". +hysteresisThresh <- function(x, lo, hi = NA) { + # Reduces to simple thresholding when a hi threshold isn't specified + if (is.na(hi)) { + hi = lo + } + + # Find the beginning and end of all the regions above the low threshold + threshEdges <- diff(c(FALSE, x > lo, FALSE)) + regionStart <- which(threshEdges > 0) + regionEnd <- which(threshEdges < 0) - 1 + + # For each region, set to TRUE iff anything inside is above the high threshold + aboveThresh <- rep(FALSE, length(x)) + for (i in seq_along(regionStart)) { + if (any(x[regionStart[i]:regionEnd[i]] > hi)) { + aboveThresh[regionStart[i]:regionEnd[i]] <- TRUE + } + } + + return(aboveThresh) +} diff --git a/man/hysteresisThresh.Rd b/man/hysteresisThresh.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/identifyManeuvers.R +\name{hysteresisThresh} +\alias{hysteresisThresh} +\title{Helper function for hysteresis thresholding: if a group of neighboring +segments are all above the low threshold and neighbor a segment above the +high threshold, they're "above threshold".} +\usage{ +hysteresisThresh(x, lo, hi = NA) +} +\description{ +Helper function for hysteresis thresholding: if a group of neighboring +segments are all above the low threshold and neighbor a segment above the +high threshold, they're "above threshold". +} + diff --git a/man/identifyAltitudeChanges.Rd b/man/identifyAltitudeChanges.Rd @@ -5,15 +5,15 @@ \title{Identify the timepoints in a trajectory that correspond to a change in altitude.} \usage{ -identifyAltitudeChanges(trajectory, hiThresh) +identifyAltitudeChanges(trajectory, loThresh, hiThresh = NA) } \arguments{ \item{trajectory}{A \code{flighttrajectory} object (or input coercable to one) indicating the trajectory of an aircraft.} -\item{hiThresh}{An altitude change (in feet); any time point associated with -a change in altitude greater than this value will definitely be labeled a -climb or descent.} +\item{hiThresh}{An altitude change (in feet per second); any time point +associated with a change in altitude greater than this value will +definitely be labeled a climb or descent.} } \value{ A logical vector indicating whether each timepoint can be considered diff --git a/man/identifyBearingChanges.Rd b/man/identifyBearingChanges.Rd @@ -5,15 +5,17 @@ \title{Identify the timepoints in a trajectory that correspond to a change in commanded heading.} \usage{ -identifyBearingChanges(trajectory, hiThresh) +identifyBearingChanges(trajectory, loThresh, hiThresh = NA) } \arguments{ \item{trajectory}{A \code{flighttrajectory} object (or input coercable to one) indicating the trajectory of an aircraft.} -\item{hiThresh}{A bearing change (in degrees); any time point associated with -a change in bearing greater than this value will definitely be labeled a -turn.} +\item{loThresh}{A bearing change (in degrees per second)} + +\item{hiThresh}{A bearing change (in degrees per second); any time point +associated with a change in bearing greater than this value will definitely +be labeled a turn.} } \value{ A logical vector indicating whether each timepoint can be considered diff --git a/man/identifySpeedChanges.Rd b/man/identifySpeedChanges.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/identifyManeuvers.R +\name{identifySpeedChanges} +\alias{identifySpeedChanges} +\title{Identify the timepoints in a trajectory that correspond to a change in +altitude.} +\usage{ +identifySpeedChanges(trajectory, loThresh, hiThresh = NA) +} +\arguments{ +\item{trajectory}{A \code{flighttrajectory} object (or input coercable to +one) indicating the trajectory of an aircraft.} + +\item{hiThresh}{An altitude change (in feet per second); any time point +associated with a change in altitude greater than this value will +definitely be labeled a climb or descent.} +} +\value{ +A logical vector indicating whether each timepoint can be considered + a climb or descent. +} +\description{ +Identify the timepoints in a trajectory that correspond to a change in +altitude. +} +