flightpathr

commit c4dc250d8eeb3bac3a8af8d4a2ad3492f0a803dc
parent 265142aebc332c730360a762817b2398bf94a195
Author: eamoncaddigan <eamon.caddigan@gmail.com>
Date:   Tue, 26 Apr 2016 11:46:09 -0400

coordsToBearing()

Diffstat:
M
NAMESPACE
 | 
1
+
A
R/coordsToBearing.R
 | 
16
++++++++++++++++
A
man/coordsToBearing.Rd
 | 
21
+++++++++++++++++++++
A
tests/testthat/test_coordsToBearing.R
 | 
38
++++++++++++++++++++++++++++++++++++++

4 files changed, 76 insertions(+), 0 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(coordsToBearing)
 export(distanceFromPath)
 export(maxDistanceFromPath)
 export(parseCoordinates)
diff --git a/R/coordsToBearing.R b/R/coordsToBearing.R
@@ -0,0 +1,16 @@
+#' Calculate the bearing between successive points in a trajectory.
+#'
+#' @param trajectory A matrix or SpatialPoints object indicating the trajectory
+#'   of an aircraft.
+#' @return The numeric vecotor giving the instantaneious bearing at each point
+#'   along the trajectory, in degrees. This will have the same length as the
+#'   trajectory, but the last element will be \code{NA}.
+#'
+#' @export
+coordsToBearing <- function(trajectory) {
+  trajectoryCoords <- get3dCoords(trajectory)
+  numCoords <- nrow(trajectoryCoords)
+  bearings <- geosphere::bearing(trajectoryCoords[1:(numCoords-1), 1:2],
+                                 trajectoryCoords[2:numCoords, 1:2])
+  return(c(bearings, NA))
+}
diff --git a/man/coordsToBearing.Rd b/man/coordsToBearing.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/coordsToBearing.R
+\name{coordsToBearing}
+\alias{coordsToBearing}
+\title{Calculate the bearing between successive points in a trajectory.}
+\usage{
+coordsToBearing(trajectory)
+}
+\arguments{
+\item{trajectory}{A matrix or SpatialPoints object indicating the trajectory
+of an aircraft.}
+}
+\value{
+The numeric vecotor giving the instantaneious bearing at each point
+  along the trajectory, in degrees. This will have the same length as the
+  trajectory, but the last element will be \code{NA}.
+}
+\description{
+Calculate the bearing between successive points in a trajectory.
+}
+
diff --git a/tests/testthat/test_coordsToBearing.R b/tests/testthat/test_coordsToBearing.R
@@ -0,0 +1,38 @@
+library(flightpathr)
+context("coordsToBearing")
+
+test_that("Equatorial routes have constant bearing", {
+  trajectory1 <- cbind(longitude = seq(-180, 180, length.out = 100),
+                       latitude = 0)
+  trajectory2 <- cbind(longitude = -74.6,
+                       latitude = seq(89, -89, length.out = 100))
+
+  expect_equal(coordsToBearing(trajectory1), c(rep(90, 99), NA))
+  expect_equal(coordsToBearing(trajectory2), c(rep(180, 99), NA))
+})
+
+test_that("Non-equatorial routes look OK", {
+  trajectory <- geosphere::gcIntermediate(c(-119.841499, 34.426194),
+                                          c(-74.577166, 39.457583),
+                                          100)
+
+  expect_equal(coordsToBearing(trajectory)[1],
+               geosphere::bearing(trajectory[1, ], trajectory[2, ]))
+  expect_equal(coordsToBearing(trajectory)[99],
+               geosphere::bearing(trajectory[99, ], trajectory[100, ]))
+  expect_true(is.na(coordsToBearing(trajectory)[100]))
+})
+
+test_that("Trajectories are somewhat reversable", {
+  trajectory <- geosphere::destPoint(c(-119.841499, 34.426194), b = 68.4,
+                                     d = seq(0, by = 40281.88, length.out = 100))
+  bearings <- coordsToBearing(trajectory)
+  destPoints <- matrix(NA, nrow = 100, ncol = 2)
+  destPoints[1, ] <- trajectory[1, ]
+  for (r in seq(2,100)) {
+    destPoints[r, ] <- geosphere::destPoint(trajectory[r-1, ], bearings[r-1],
+                                            40281.88)
+  }
+
+  expect_equal(destPoints[1:200], trajectory[1:200], tolerance = 1e-8)
+})