track_intermediate

[mdsumner]

  library(traipse)

#' Track intermediate points
#' 
#' Calculate great circle intermediate points on longitude, latitude input vectors
#'
#' To use on multiple track ids, use a grouped data frame with tidyverse code like 
#' `inter <- data %>% group_by(id) %>% 
#'                                  mutate(inter = track_intermediate(lon, lat, distance = )`
#' 
#' Then, un-nest this result for further use (the inter above retains the information 
#' about the parent locations for custom usage if needed), so the final location of each 
#' group has invalid intermediates: 
#' `dd <- inter %>% slice(-1) %>% unnest()`
#' @param x longitude 
#' @param y latitude
#' @param date NOT IMPLEMENTED
#' @param distance optional minimum distance between input points
#'
#' @return a list of data frames of intermediate points (for use with unnest)
#' @export
#'
#' @examples 
#' track_intermediate(trips0$x[1:10], trips0$y[1:10], distance = 15000)
track_intermediate <- function(x, y, distance = NULL) {
  n <- length(x)
  if (is.null(distance)) {
    npoints <- 15
  } else {
    npoints <- pmax(3, ceiling(track_distance(x, y) / distance))[-1]
  }
  

  listm <- geosphere::gcIntermediate(cbind(x[-n], y[-n]), cbind(x[-1], y[-1]), 
                                     n = npoints, addStartEnd = TRUE, sp = FALSE)
  
  if (n == 2)   listm <- list(listm)

  c(lapply(listm, function(a) tibble::tibble(int_x = a[,1], int_y = a[,2])), list(tibble::tibble()))
}
library(dplyr)

d <- trips0 %>% group_by(id) %>% mutate(inter = track_intermediate(x, y, distance = 100000))
library(tidyr)
dd <- d %>% slice(-1) %>% unnest()
plot(dd$int_x, dd$int_y, pch = ".", type = "l")
points(dd$int_x, dd$int_y, pch = ".", col = "firebrick", cex = 4)

library(ggplot2)
ggplot(dd, aes(int_x, int_y, colour = date)) + geom_path() + facet_wrap(~id) + coord_fixed(1/cos(mean(trips0$y) * pi/180))

## still need to interpolate between datesd
ggplot(dd, aes(int_x, int_y, colour = date)) + geom_point() + facet_wrap(~id) + coord_fixed(1/cos(mean(trips0$y) * pi/180))

^{Created on 2019-08-20 by the reprex package (v0.3.0)}

[mdsumner]

Now in branch https://github.com/Trackage/traipse/tree/track-intermediate

Includes optional date intput, and Suggests-examples in dontrun

[mdsumner]

Could be better vectorized like this? This is derived from geosphere::.interm() and doesn't allow any antipodal checks or break at dateline and so on

.vectorize_interm <- function(p1, p2, n) {
  stopifnot(nrow(p1) == nrow(p2))
  stopifnot(length(n) == 1L || length(n) == nrow(p1))
  if (length(n) == 1L) n <- rep(n,nrow(p1))
  toRad <- pi / 180
  
  d <- rep(distCosine(p1, p2, r=1), n)
  
  lon1 <- rep(p1[,1] * toRad, n)
  lat1 <- rep(p1[,2] * toRad, n)
  lon2 <- rep(p2[,1] * toRad, n)
  lat2 <- rep(p2[,2] * toRad, n)
  
  n <- pmax(round(n), 1)

## todo this is repeating each point, need to drop each end
  f <- unlist(lapply(n, function(nn) seq(0, 1, length.out = nn)))
  A <- sin((1-f)*d) / sin(d)
  B <- sin(f*d) / sin(d)
  x <- A*cos(lat1)*cos(lon1) +  B*cos(lat2)*cos(lon2)
  y <- A*cos(lat1)*sin(lon1) +  B*cos(lat2)*sin(lon2)
  z <- A*sin(lat1)           +  B*sin(lat2)
  lat <- atan2(z,sqrt(x^2+y^2))
  lon <- atan2(y,x)
  
  cbind(lon,lat)/toRad
}