R加速此代码，该代码沿道路连接计算中间XY坐标

我有一个函数，它每隔5秒计算一次道路连接的XY坐标。这段代码运行良好。然而，在1%的样本上获得结果大约需要3分钟。请注意，1%的样本有大约195万行数据。假设采用线性标度，100%样本可能需要约5小时。因此，我有兴趣加速这段代码以节省运行时间

下面是代码

routeptcalc <- function (pid, time1, time2, x1, y1, x2, y2, speed) {
  theta <- asin((y2-y1)/sqrt((x2-x1)^2+(y2-y1)^2))
  segtime <- 5
  i <- 1
  k <- vector("list")
  while (time1+5<time2)
  {
    len <- speed*segtime
    k[[i]] <- c(pid, x1+len*cos(theta), y1+len*sin(theta), time1+5)
    segtime <- segtime+5
    time1 <- time1+5 
    i <- i+1
  }    
  k
}

dt <- mapply(routeptcalc, x2$person, x2$time1, x2$time2, x2$STRTX, x2$STRTY, x2$ENDX, x2$ENDY, x2$trvlspeed)
dt <- matrix(unlist(dt), ncol = 4, byrow = TRUE) 

数据的简要说明：

---

数据帧中的每一行对应于一条独立记录，该记录给出了人员id（人员）、人员进入链路（时间1）、人员退出链路（时间2）、链路长度（长度）、链路的开始和结束UTM坐标（STRTX、STRTY、ENDX、ENDY）以及链路上的行驶速度（trvlspeed）的信息。您不必担心其余的列。

上述例程执行缓慢的原因是函数中的while循环。看起来您正在对循环的每个迭代手动积分移动距离。由于假设是以恒定速度从点A到点B的直线旅行，问题简化为简单的算法，然后可以在R中矢量化

试试这个：

routefast <- function (pid, time1, time2, x1, y1, x2, y2, speed) {
  segtime <- 5       #5 sec interals
  dt<-(time2-time1)  #total number of seconds
  seqs<-dt %/% segtime #integer number of 5 sec intervals
  deltax<-(x2-x1)
  deltay<-(y2-y1)
  xspeed<-deltax/dt  
  yspeed<-deltay/dt
  x<-xspeed*segtime*c(1:seqs)+x1
  y<-yspeed*segtime*c(1:seqs)+y1
  t<-segtime*c(1:seqs)+time1
  data.frame(pid,x,y,t)
}

---

routefast我还应该用
dk调用这个函数吗谢谢你指出了错误，我做了更正。我对你的结果感到困惑。在7行上快6倍，但在较大的样本上慢3倍。。。我想知道合并步骤post-mapply是否导致了问题。我不知道该怎么解释这些区别。代码刚刚完成运行，总共花了大约18分钟。我也是。令人费解的是，函数在大样本上会变慢。我会尝试使用cbind而不是在每次调用结束时创建数据帧，然后使用do.call（rbind，dt）将所有矩阵绑定在一起。也许这会是一个进步。正如您所建议的，我使用了
cbind（pid，x，y，t）
而不是
data.frame（pid，x，y，t）
。现在，与我的原始函数（对于7行示例）相比，您的函数执行速度快65倍。对于1%的样本，大约需要40秒。显然，这比早期的结果要好得多。但是，与我针对1%样本编写的代码相比，这并没有快65倍，对吗？我不知道速度是否可以线性缩放。此外，是否有一种方法可以只应用一次函数，而不是使用mapply重复调用它？
routefast <- function (pid, time1, time2, x1, y1, x2, y2, speed) {
  segtime <- 5       #5 sec interals
  dt<-(time2-time1)  #total number of seconds
  seqs<-dt %/% segtime #integer number of 5 sec intervals
  deltax<-(x2-x1)
  deltay<-(y2-y1)
  xspeed<-deltax/dt  
  yspeed<-deltay/dt
  x<-xspeed*segtime*c(1:seqs)+x1
  y<-yspeed*segtime*c(1:seqs)+y1
  t<-segtime*c(1:seqs)+time1
  data.frame(pid,x,y,t)
}