flightpathr

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:
M
R/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)
 }