问一种跨越多个依赖条件的有效索引/加入data.table的停止检测算法

EN

data <- data.table(id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
                   latlon = c(0, 50, 80, 90, 90, 100, 190, 110, 110, 110),
                   time = c(0, 60, 120, 180, 240, 300, 360, 420, 480, 520))

nrows <- nrow(data)

latlon_dist <- outer(data$latlon, data$latlon, `-`)
latlon_dist[upper.tri(latlon_dist)] <- NA
time_window <- outer(data$time, data$time, `-`)
time_window[upper.tri(time_window)] <- NA

foo <- function(x){
  mindist <- min(which(x[, 1] > 80), nrows)
  if (mindist >= min(which(x[, 2] > 180), nrows + 1)) mindist else NA
}

bar <- array(c(latlon_dist, time_window),
  dim = c(nrows, nrows, 2))


apply(bar, 2, foo)

threshholds <- apply(bar, 2, foo) - 1

previous_threshhold <- 0
for (i in seq_along(threshholds)) {
  current_threshhold <- threshholds[i]
  
  if (!is.na(current_threshhold) && current_threshhold > previous_threshhold) {
    data[i:current_threshhold, stop_id := i]
    previous_threshhold <- current_threshhold
  }
}

stopFinder <- function(dt){
  
  nrows <- nrow(dt)
  
  if (nrows < 20000){
    return(quickStopFinder(dt))
  }
  i <- 1
  remove_indices <- 0
  while (i < nrows) {
    this_ends  <- dt[!remove_indices,
                     Position(
                       geodist_vec(rep(longitude[1], .N),
                                   rep(latitude[1], .N),
                                   longitude,
                                   latitude,
                                   paired = TRUE),
                       f = function(x) x > 80,
                       nomatch = .N + 1) ] + i - 1
    # A) Do some number of points occur within the distance?
    # B) If so, is it at least three minutes out?
    if (this_ends > (i + 1) && dt[c(i, (this_ends - 1)), timestamp[.N] > time_window[1]]) {
      # Last index is the one before the distance is broken
      last_index_of_stop <- this_ends - 1
      
      # Next run, we will remove all prior considerations
      remove_indices <- c(1:last_index_of_stop)
      
      # Set the point itself
      dt[i,
         `:=`(candidate_stop = TRUE,
              stop_id = id,
              within_stop = TRUE)]
      # Set the attached points
      dt[(i + 1):last_index_of_stop,
         `:=`(within_stop = TRUE,
              stop_id = i)]
      
      # Start iterating again on the point that broke the distance
      i <- this_ends
    } else {
      # If no stop, move on and leave out this point
      remove_indices <- c(1:i)
      i <- i + 1
    }
  }
  dt[]
}

  res <- dt[dt,
            on = .(timestamp >= timestamp_dup,
                   timestamp <= time_window)]
  res[, dist := geodist_vec(x1 = longitude,
                            y1 = latitude,
                            x2 = i.longitude,
                            y2 = i.latitude,
                            paired = TRUE,
                            measure = "haversine")]
  res[, candidate_stop := all(dist <= 80), i.id]

sm2 <- read.csv(file = "http://daniellemc.cool/sm.csv", row.names = NULL)
sm <- copy(sm2)
setDT(sm)
sm <- sm[, .(timestamp, longitude, latitude, id)]
sm[, timestamp := as.POSIXct(timestamp)]
sm[, id2 := id]

# This is problematic on my data because of how quickly it grows.
test <- sm[sm, on = .(id >= id)]
test[, i.id2 := NULL]
setnames(test, c("time.2", "longitude.2", "latitude.2", "id.1",
                 "id.2", "time.1", "longitude.1", "latitude.1"))


# Time and distance differences calculated between each pair
test[, distdiff := geodist_vec(longitude.1, latitude.1,
                               longitude.2, latitude.2,
                               paired = TRUE)]
test[, timediff := time.2 - time.1]

# Include the next distance to make sure there's at least one within distance and 
# over 180 timediff.
test[, nextdistdiff := shift(distdiff, -1), id.1]

# Are all distances within 180 sec within 80, and is the next following also < 80
test[, dist_met := FALSE]
test[timediff < 180, dist_met := all(distdiff < 80 & nextdistdiff < 80), id.1]
test[, dist_met := any(dist_met), id.1]

# Test how many occur consecutively 
# This keeps us from having > 80 dist but then coming back within 80
test[, consecutive := FALSE]
test[distdiff < 80, consecutive :=  c(TRUE, cummin(diff(id.2) == 1) == 1), id.1]
test[consecutive == TRUE & dist_met == TRUE, stop_id := min(id.1), id.2]
test[test[consecutive == TRUE & dist_met == TRUE], stop_id := i.stop_id, on = .(id.1 = id.2)]
test <- unique(test[, .(stop_id, id.1)])

# Join it back to the data.
sm[test, stop_id := stop_id, on = .(id = id.1)]