flightpathr

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

commit 90a0d5a5400400f9bdf6040e6bca9d1c2fffffb6
parent 117b1a2c1dbc492584a44ea0bff3ee1ffef595d0
Author: eamoncaddigan <eamon.caddigan@gmail.com>
Date:   Fri, 21 Oct 2016 15:35:22 -0400

Giving up on hysteresis thresholding for now. :(

Diffstat:
MR/identifyManeuvers.R | 65+++++++++++++++++++++++++++++++++++++++--------------------------
1 file changed, 39 insertions(+), 26 deletions(-)

diff --git a/R/identifyManeuvers.R b/R/identifyManeuvers.R @@ -20,11 +20,11 @@ identifyBearingChanges <- function(trajectory, loThresh, hiThresh = NA) { t$bearing[2:length(t$bearing)])) / c(NA, diff(t$time)) - isBearingChange <- hysteresisThresh(bearingChanges, max(loThresh), max(hiThresh)) - if (length(loThresh) > 1) { - isBearingChange <- isBearingChange | - hysteresisThresh(-bearingChanges, -min(loThresh), -min(hiThresh)) - } + isBearingChange <- hysteresisThresh(bearingChanges, loThresh, hiThresh) + # if (length(loThresh) > 1) { + # isBearingChange <- isBearingChange | + # hysteresisThresh(-bearingChanges, -min(loThresh), -min(hiThresh)) + # } return(isBearingChange) } @@ -46,11 +46,11 @@ identifyAltitudeChanges <- function(trajectory, loThresh, hiThresh = NA) { t <- as.flighttrajectory(trajectory) altitudeChanges <- c(NA, diff(t$altitude)) / c(NA, diff(t$time)) - isAltitudeChange <- hysteresisThresh(altitudeChanges, max(loThresh), max(hiThresh)) - if (length(loThresh) > 1) { - isAltitudeChange <- isAltitudeChange | - hysteresisThresh(-altitudeChanges, -min(loThresh), -min(hiThresh)) - } + isAltitudeChange <- hysteresisThresh(altitudeChanges, loThresh, hiThresh) + # if (length(loThresh) > 1) { + # isAltitudeChange <- isAltitudeChange | + # hysteresisThresh(-altitudeChanges, -min(loThresh), -min(hiThresh)) + # } return(isAltitudeChange) } @@ -72,11 +72,11 @@ 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)) - } + isSpeedChange <- hysteresisThresh(speedChanges, loThresh, hiThresh) + # if (length(loThresh) > 1) { + # isSpeedChange <- isSpeedChange | + # hysteresisThresh(-speedChanges, -min(loThresh), -min(hiThresh)) + # } return(isSpeedChange) } @@ -90,18 +90,31 @@ hysteresisThresh <- function(x, lo, hi = NA) { 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 + aboveThresh <- abs(x) > hi - # 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 - } - } + ## Having trouble with thresholding for this analysis. Giving up for now. I + ## apologize to all of the user of this package. + + # x <- abs(x) + # + # # 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 + # + # # If the sequence ends with a low-threshold region, make sure to capture the + # # endpoint. + # if (length(regionEnd) < length(regionStart)) { + # regionEnd[length(regionStart)] <- length(x) + # } + # + # # 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) }