Question

对于事故分析，我必须检查来自另一个系统的日志中是否存在来自一个系统的记录事故。问题是两个系统都是手动填充的，因此可能会出现（小？）位置和时间的差异。

目前，我已经通过一个功能解决了这个问题，我打电话给他们：

sys1log.df["match_1_900"] <- apply(sys1log.df, 1, bestMatch, marginLocation = 1, marginTime = 900)

marginLocation 是我想用于事件位置的保证金。在这种情况下，边距为1，因此syslog2.df中记录的0到2之间的所有事件都是匹配的候选对象。 marginTime 也是如此，在此示例中设置为900秒。来自syslog1.df的所有事件都是在syslog1.df事件发生之前（或之后）的四分之一小时之间记录的，这些事件都是可能的匹配。我唯一想要匹配的东西“难以”＃39;是道路号码。

bestMatch函数是：

bestMatch <- function (x, marginLocation, marginTime) {
  location <- as.numeric( x[10] )                                
  roadnumber  <- as.numeric( x[9] )                                 
  time <- as.POSIXct( strptime(x[4], "%Y-%m-%d %H:%M:%S") )  

  require("dplyr")
  df <- sys2log.df %>%
    #filter rows that match criteria (within margins)
    filter(road == roadnumber, 
           loc < location + marginLocation, 
           loc > location - marginLocation, 
           starttime < time + marginTime, 
           starttime > time - marginTime) %>%
    #create column with absolute difference between time system1 and time system2
    mutate(timeDifference = abs( as.numeric(time) - as.numeric(starttime) )) %>%
    #sort on timeDifference
    arrange(timeDifference)
    #if a match is found, return the value in column 15 from the row with the smallest timeDifference)
    if (length(df)) {
      return(df[1,15])
    } else {
      return(NA)
    }
}

这样可以正常工作，但问题是日志包含＆gt; 100.000行，因此apply-function运行大约需要15-30分钟。我使用多个位置/时间边距组合，所以我真的想加快速度。

我认为使用data.table的滚动连接可以更快地完成。我的问题＆＃34;是我想加入三个键，其中两个键应包含滚动窗口/边距。 Data.table只允许您在一个（最后一个）键上应用滚动连接。

我确定有一种方法可以通过data.table（或其他软件包）实现我的目标，但我已经迷失了。谁能指出我正确的方向？

Answer 1

通常情况下，您不应该使用apply，而是将data.frame转换为matrix，然后在每次迭代时重新转换每一次值。

使用purrr::pmap代替迭代选定的列。

当您仅查找最小值时，请不要对数据进行排序，请使用which.min，（并且只保留多个解决方案时的第一个结果）。

你对length(df))的测试是计算data.frame的列，所以它永远不会失败，我认为你的意思是测试nrows。我刚跳过它，因为你可以在之后测试你收到的对象。

由于你没有提供可重现的例子，我无法保证它能像我一个糟糕的盲人编码器一样工作:)。但它应该指出你的解决方案。

# I'm supposing that the indices 10 9 and 4 are for loc, road, and starttime, and that in the original format the columns are well formatted

get_new_col <- function(marginLocation = 1, marginTime = 900){
sys1log.df["match_1_900"] <- sys1log.df %>% select(loc,road,starttime) %>%
  pmap(function(location,road_number,time){
    filter(sys1log.df %>%
             filter(road == roadnumber, 
                   loc < location + marginLocation, 
                   loc > location - marginLocation, 
                   starttime < time + marginTime, 
                   starttime > time - marginTime) %>%
             %>% {.[which.min(abs(time-starttime))[1],"timeDifference"]}
  }
}

sys1log.df["match_1_900"] <- get_new_col()

加入两列/键，带边距

1 个答案: