R/Optimize 循环中的备用循环函数

Question

我正在尝试找出关联交易。从第一个 TRUE 到最后一个 TRUE，它被认为是一个事务，并在事务中找出 tpt_mode 是混合的还是纯的。然后，插入一个包含新数据的新列，但目前 for 循环正在处理少量数据，当涉及大量数据时，它往往运行得非常慢。如何优化 for 循环以加快性能？

firstid<-1
currTpt <- 'NA'
count<-0
n <- nrow(tnx)
for (i in 1:n) {

  if(tnx$FIRST[i]){

    firstid<-i
    currTpt <-tnx$mode[i]
   count <-1
  }
   else{
   count <- count + 1
  }
  if(as.character(tnx$mode[i])!= as.character(currTpt)){
    currTpt <- 'both'
  }
  if(tnx$LAST[i])
  {
    tnx$final_end_loc[firstid]<-tnx$end_loc[i]    
    tnx$final_end_date[firstid]<-as.character(tnx$end_date[i])  
    tnx$final_end_time[firstid]<-as.character(tnx$end_time[i])
    tnx$final_mode[firstid]<-as.character(currTpt)
    tnx$final_count[firstid] <- count
  }
  }
final_tnx<-subset(tnx,FIRST==TRUE,c("id","start_date","start_time","final_end_date","final_end_time","start_loc","final_end_loc","final_mode","final_count"))

示例数据：编辑

   tnx<- data.frame(
  id=c("A","A","A","A","C","C","D","D","E"),
  mode=c("on","on","off","on","on","off","off","off","on"),
  start_time=c("8:20:22","17:20:22","17:45:22","18:20:22","16:35:22","17:20:22","15:20:22","16:00:22","12:20:22"),
  end_time=c("8:45:22","17:30:22","18:00:22","18:30:22","17:00:22","17:50:22","15:45:22","16:14:22","27:50:22"),
  start_loc=c("12","12","207","12","11","65","222","32","12"),
  end_loc=c(31,31,29,11,22,12,45,31,11),
  start_date=c("6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012"),
  end_date=c("6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012","6/3/2012"),
  FIRST=c(T,T,F,F,T,F,T,F,T),
  LAST=c(T,F,F,T,F,T,F,T,T)
)

图片形式的样本数据集：

预期结果：

提前致谢。

Answer 1

要获得结果，您不需要循环。如果您检查交易的开始和结束位置并相应地编制索引，您的代码将简化为

nLAST <- which(tnx$LAST)
nFIRST <- which(tnx$FIRST)
count <- sapply(1:length(nFIRST),FUN = function(i){nFIRST[i]:nLAST[i]})
mode <- unlist(lapply(count,FUN=function(x){ifelse(length(unique(tnx$mode[x]))==1,
                      as.character(unique(tnx$mode[x])),'both')}))
final_tnx <- data.frame(id = tnx$id[nFIRST],start_date = tnx$start_date[nFIRST],
    start_time = tnx$start_time[nFIRST],final_end_date = tnx$end_date[nLAST],
    final_end_time = tnx$end_time[nLAST], start_loc=tnx$start_loc[nFIRST], 
    final_end_loc = tnx$end_loc[nLAST],final_mode =  mode, 
    final_count = nLAST - nFIRST +1)

这肯定会加快速度，并在更大的数据集上表现良好。

编辑：当允许模式多次更改时，您必须检查所有子集的唯一性。在count 中，我为每条记录构建了一个索引序列列表。然后在索引列表上应用一个函数来检查子集中是否存在一种或多种模式。

Answer 2

我确信还有更多改进要做，但如果您在循环中尽可能少地索引并将数据指定为向量，您会看到一些改进。

require("rbenchmark")

###Specify data as vectors
FIRST <- tnx$FIRST
mode <- tnx$mode
LAST <- tnx$LAST
final_end_loc <- tnx$final_end_loc
final_end_date <- tnx$final_end_date
final_end_time <- tnx$final_end_time
final_mode <- tnx$final_mode
final_count <- tnx$final_count
end_date <- tnx$end_date
end_time <- tnx$end_time
end_loc <- tnx$end_loc

benchmark(for (i in 1:n) {

   if(FIRST[i]){

    firstid<-i
    currTpt <-mode[i]
    count <-1
}
else{
    count <- count + 1
}
if(as.character(mode[i])!= as.character(currTpt)){
    currTpt <- 'both'
}
if(LAST[i])
{
    final_end_loc[firstid]<-end_loc[i]    
    final_end_date[firstid]<-as.character(end_date[i])  
    final_end_time[firstid]<-as.character(end_time[i])
    final_mode[firstid]<-as.character(currTpt)
    final_count[firstid] <- count
}
})

 replications elapsed relative user.self sys.self user.child sys.child
1          100    0.11        1      0.11        0         NA        NA

现在你的循环

   replications elapsed relative user.self sys.self user.child sys.child
1          100    0.18        1      0.19        0         NA        NA

无法确定这是否会在大型数据集上表现良好，但过去将索引保持在最低限度对我有用。如果这对您来说速度不够快或不适用于大数据，可以在这里找到一篇好帖子Speed up the loop operation in R。