commit 654b56bdc2c306b81f1a9689063fcb2c9ef5477f
parent fe14d30d757816c94dd0dea86fc63cf8cc1cda95
Author: eamoncaddigan <eamon.caddigan@gmail.com>
Date: Fri, 15 Apr 2016 15:59:17 -0400
Almost done with distanceFromPath()
Diffstat:
10 files changed, 198 insertions(+), 0 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -9,3 +9,8 @@ Description: This package provides functions for analyzing flight track and
License: MIT
LazyData: TRUE
RoxygenNote: 5.0.1
+Imports:
+ geosphere
+Suggests:
+ sp,
+ testthat
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,2 +1,3 @@
# Generated by roxygen2: do not edit by hand
+export(distanceFromPath)
diff --git a/R/distanceFromPath.R b/R/distanceFromPath.R
@@ -0,0 +1,57 @@
+#' Calculate the distance of a flight trajectory from a flight path.
+#'
+#' @param trajectory A matrix or SpatialPoints object indicating the trajectory
+#' of an aircraft.
+#' @param path A matrix or SpatialPoints object indicating the ordered waypoints
+#' a pre-defined flight path.
+#' @return A data.frame containing two columns representing the distance between
+#' the aircraft and its planned flight path (in feet): \code{horizontal}
+#' indicates the horizontal distance and \code{vertical} indicates the
+#' vertical distance.
+#'
+#' @export
+distanceFromPath <- function(trajectory, path) {
+ # Check inputs and get 3D coordinates
+ trajectoryCoords <- get3dCoords(trajectory)
+ pathCoords <- get3dCoords(path)
+
+ numLegs <- nrow(pathCoords)-1
+
+ # Given n points and m legs, store horizontal and vertical distance in an
+ # n x m x 2 array
+ distanceToLeg <- array(NA, dim = c(nrow(trajectory), 2, numLegs))
+ # And the squared "slant range" (euclidean distance) in an n x m array
+ slantToLeg <- array(NA, dim = c(nrow(trajectoryCoords), numLegs))
+
+ for (legIdx in seq_len(numLegs)) {
+ # For each pair of adjascent waypoints, calculate the horizontal distance
+ # from the great circle defined by the pair and all points in the
+ # trajectory.
+ distanceToLeg[, i, 1] <- geosphere::dist2gc(path[i, c(1,2)],
+ path[i+1, c(1,2)],
+ trajectory[, c(1,2)],
+ r = 2.0904e+7)
+
+ # If the waypoints are at the same altitude, just calculate the deviation
+ # from this altitude. Easy.
+ # XXX - Not actually handling the case where they don't match.
+ if (!isTRUE(all.equal(altitudes(path[i]), altitudes(path[i+1])))) {
+ warning("Pretending that waypoint altitudes match when they don't")
+ }
+ distanceToLeg[, i, 2] <- trajectory[, 3] - path[i, 3]
+
+ # Squared euclidean distance
+ slantToLeg[, i] <- distanceToLeg[, i, 1]^2 + distanceToLeg[, i, 2]^2
+ }
+
+ # Figure out which leg is closer to each point in the trajectory.
+ # Note: I can imagine a tortuous path that would result in the closest path
+ # alternating between legs. This would need to be rewritten to handle that.
+ closestLeg <- apply(slantToLeg, 1, which.min)
+
+ # Return the horizontal and vertical distance to the flight path (distance to
+ # the closest leg) as a data.frame.
+ distanceToPath <- as.data.frame(drop(distanceToLeg[, closestLeg, ]))
+ colnames(distanceToPath) <- c("horizontal", "vertical")
+ return(distanceToPath)
+}
diff --git a/R/flightpathr.R b/R/flightpathr.R
@@ -3,6 +3,10 @@
#' This package provides functions for analyzing flight track and flight path
#' data. Useful for studies of pilot and controller performance.
#'
+#' @section Functions:
+#' \code{distanceFromPath()} Measures the distance between an aircraft
+#' trajectory and a flight path.
+#'
#' @docType package
#' @name flightpathr
NULL
diff --git a/R/get3dCoords.R b/R/get3dCoords.R
@@ -0,0 +1,33 @@
+#' Checks for appropriate input and coerces it into a nx3 coordinate matrix.
+#'
+#' @param obj An object that hopefully contains some coordinates.
+#' @return A nx3 coordinate matrix
+get3dCoords <- function(obj) {
+ # Get/check for a matrix representation
+ if (is(obj, "SpatialPoints")) {
+ if (!requireNamespace("sp", quietly = TRUE)) {
+ # I have no idea how this would happen, but people do funky things.
+ stop("Package sp must be installed to handle SpatialPoints objects")
+ }
+ # TODO: check projection string to make sure this is latitude/longitude and
+ # not easting/northing data.
+ warning("Assuming lat/long data in SpatialPoints object's coordinates")
+ coordMat <- sp::coordinates(obj)
+ } else if (is.data.frame(obj)) {
+ coordMat <- as.matrix.data.frame(obj)
+ } else if (is.matrix(obj)) {
+ coordMat <- obj
+ } else {
+ stop("obj must be an object of class SpatialPoints (or subclass), data.frame, or matrix")
+ }
+
+ # Check the dimensions, adding altitude if necessary
+ if (ncol(coordMat) == 2) {
+ # Add fake altitude info (AGL)
+ coordMat <- cbind(coordMat, 0)
+ } else if (ncol(coordMat) != 3) {
+ stop("Coordinates must be in 2D or 3D")
+ }
+
+ return(coordMat)
+}
diff --git a/man/distanceFromPath.Rd b/man/distanceFromPath.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/distanceFromPath.R
+\name{distanceFromPath}
+\alias{distanceFromPath}
+\title{Calculate the distance of a flight trajectory from a flight path.}
+\usage{
+distanceFromPath(trajectory, path)
+}
+\arguments{
+\item{trajectory}{A matrix or SpatialPoints object indicating the trajectory
+of an aircraft.}
+
+\item{path}{A matrix or SpatialPoints object indicating the ordered waypoints
+a pre-defined flight path.}
+}
+\value{
+A data.frame containing two columns representing the distance between
+ the aircraft and its planned flight path (in feet): \code{horizontal}
+ indicates the horizontal distance and \code{vertical} indicates the
+ vertical distance.
+}
+\description{
+Calculate the distance of a flight trajectory from a flight path.
+}
+
diff --git a/man/flightpathr.Rd b/man/flightpathr.Rd
@@ -9,4 +9,9 @@
This package provides functions for analyzing flight track and flight path
data. Useful for studies of pilot and controller performance.
}
+\section{Functions}{
+
+\code{distanceFromPath()} Measures the distance between an aircraft
+ trajectory and a flight path.
+}
diff --git a/man/get3dCoords.Rd b/man/get3dCoords.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get3dCoords.R
+\name{get3dCoords}
+\alias{get3dCoords}
+\title{Checks for appropriate input and coerces it into a nx3 coordinate matrix.}
+\usage{
+get3dCoords(obj)
+}
+\arguments{
+\item{obj}{An object that hopefully contains some coordinates.}
+}
+\value{
+A nx3 coordinate matrix
+}
+\description{
+Checks for appropriate input and coerces it into a nx3 coordinate matrix.
+}
+
diff --git a/tests/testthat.R b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(flightpathr)
+
+test_check("flightpathr")
diff --git a/tests/testthat/test_get3dCoords.R b/tests/testthat/test_get3dCoords.R
@@ -0,0 +1,46 @@
+library(flightpathr)
+context("get3dCoords")
+
+
+# data and helper functions -----------------------------------------------
+
+coords3d <- matrix(rnorm(100*3), ncol = 3)
+
+check_sp <- function () {
+ if (!requireNamespace("sp", quietly = TRUE)) {
+ skip("sp is not available")
+ }
+}
+
+expect_unnamed_equal <- function(mat1, mat2) {
+ eval(bquote(expect_equal(unname(.(mat1)), unname(.(mat2)))))
+}
+
+
+# tests -------------------------------------------------------------------
+
+test_that("different input objects are handled", {
+ expect_equal(get3dCoords(coords3d), coords3d)
+ expect_unnamed_equal(get3dCoords(as.data.frame(coords3d)), coords3d)
+ expect_error(get3dCoords(as.numeric(coords3d)))
+})
+
+test_that("different dimensions are handled", {
+ coords2d <- coords3d[, c(1,2)]
+ coords2dFixed <- cbind(coords2d, 0)
+
+ expect_equal(get3dCoords(coords2d), coords2dFixed)
+ expect_error(get3dCoords(coords3d[, 1, drop = FALSE]),
+ "Coordinates must be in 2D or 3D")
+})
+
+test_that("SpatialPoints are handled", {
+ check_sp()
+ coordsSP <- sp::SpatialPoints(coords3d)
+ coordsSPDF <- sp::SpatialPointsDataFrame(coords3d, as.data.frame(coords3d))
+
+ expect_warning(get3dCoords(coordsSP))
+ expect_unnamed_equal(get3dCoords(coordsSP), coords3d)
+ expect_unnamed_equal(get3dCoords(coordsSPDF), coords3d)
+})
+
