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:
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.
+}
+
