commit fe419c4b3e0452e718c91e3b98822d671969caad
parent 722ae8e34cbb29656a6bd980201c0bdf3c3d58f8
Author: eamoncaddigan <eamon.caddigan@gmail.com>
Date: Tue, 24 May 2016 10:11:41 -0400
Interpolating trajectories in time.
Diffstat:
4 files changed, 92 insertions(+), 0 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
@@ -4,4 +4,5 @@ export(calculateSLoWC)
export(createTrajectory)
export(identifyLoWC)
export(identifyNMAC)
+export(interpolateTrajectory)
export(is.flighttrajectory)
diff --git a/R/interpolateTrajectory.R b/R/interpolateTrajectory.R
@@ -0,0 +1,31 @@
+#' Interpolate a trajectory (in time)
+#'
+#' @param trajectory A \code{flighttrajectory} object.
+#' @param timestamp The new timestamp along which the data should be
+#' interpolated.
+#' @return A new \code{flighttrajectory} with the given \code{timestamp}
+#'
+#' @details This just performs linear interpolation for all of the values in the
+#' trajectory. A better approach would make use of the bearing and velocity
+#' information to smoothly interpolate the coordinates.
+#'
+#' @export
+interpolateTrajectory <- function(trajectory, timestamp) {
+ # We'll interpolate all of the features (except the timestamp, which is
+ # specified).
+ trajectoryFeatures <- names(trajectory)
+ trajectoryFeatures <- trajectoryFeatures[trajectoryFeatures != "timestamp"]
+
+ # Create a new trajectory with
+ newTrajectory <- list()
+ for (trajectoryFeature in trajectoryFeatures) {
+ newTrajectory[[trajectoryFeature]] <- approx(x = trajectory$timestamp,
+ y = trajectory[[trajectoryFeature]],
+ xout = timestamp,
+ method = "linear",
+ rule = 2)$y
+ }
+ newTrajectory[["timestamp"]] <- timestamp
+
+ return(do.call(createTrajectory, newTrajectory))
+}
diff --git a/man/interpolateTrajectory.Rd b/man/interpolateTrajectory.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/interpolateTrajectory.R
+\name{interpolateTrajectory}
+\alias{interpolateTrajectory}
+\title{Interpolate a trajectory (in time)}
+\usage{
+interpolateTrajectory(trajectory, timestamp)
+}
+\arguments{
+\item{trajectory}{A \code{flighttrajectory} object.}
+
+\item{timestamp}{The new timestamp along which the data should be
+interpolated.}
+}
+\value{
+A new \code{flighttrajectory} with the given \code{timestamp}
+}
+\description{
+Interpolate a trajectory (in time)
+}
+\details{
+This just performs linear interpolation for all of the values in the
+ trajectory. A better approach would make use of the bearing and velocity
+ information to smoothly interpolate the coordinates.
+}
+
diff --git a/tests/testthat/test_interpolateTrajectory.R b/tests/testthat/test_interpolateTrajectory.R
@@ -0,0 +1,34 @@
+library(flightconflicts)
+context("interpolateTrajectory")
+
+library(geosphere)
+
+kacy <- c(-74.5771667, 39.4575833)
+k17n <- c(-75.0330031, 39.7054758)
+
+# Two identical trajectories with different sampling rates
+coords1 <- gcIntermediate(kacy, k17n, n = 61)
+trajectory1 <-createTrajectory(coords1[, 1], coords1[, 2], altitude = 3500,
+ timestamp = seq(0, 800, length.out = 61))
+coords2 <- gcIntermediate(kacy, k17n, n = 229)
+trajectory2 <-createTrajectory(coords2[, 1], coords2[, 2], altitude = 3500,
+ timestamp = seq(0, 800, length.out = 229))
+
+test_that("Interpolated trajectory is close to correct", {
+ trajectoryInterpolated <- interpolateTrajectory(trajectory1,
+ trajectory2$timestamp)
+
+ for (tf in names(trajectoryInterpolated)) {
+ expect_equal(trajectoryInterpolated[[tf]], trajectory2[[tf]], tolerance = 1)
+ }
+})
+
+test_that("Correctly handling times outside original range", {
+ trajectoryInterpolated <- interpolateTrajectory(trajectory1,
+ c(-100, 0, 800, 900))
+
+ for (tf in names(trajectoryInterpolated)[names(trajectoryInterpolated) != "timestamp"]) {
+ expect_equal(trajectoryInterpolated[[tf]][1], trajectoryInterpolated[[tf]][2])
+ expect_equal(trajectoryInterpolated[[tf]][3], trajectoryInterpolated[[tf]][4])
+ }
+})
