使用 R 中的 if 条件删除嵌套的 for 循环

Remove nested for loop with if condition in R

我正在尝试通过使用矢量化删除嵌套 for 循环来优化我的 R 代码。我的嵌套 for 循环包括基于 if 条件的 rbind。但是,当使用 rbind 的 运行 向量化代码不填充新数据帧时,嵌套 for 循环代码有效。

对于背景,我有两个数据框-'ip','ip_error'。维度为“469 5”的数据框“ip”。数据框“ip_error”的维度是“9 11”。在比较任务开始和结束与会话开始和结束的特定列上的两个数据帧后,我的输出是从数据帧“ip”中选择的行。

这是我使用嵌套 for 循环的工作代码

for(j in 1:length(ip$RUID_KEY)){
 for(i in 1:length(ip_error$RUID_KEY)){
  if(isTRUE(ip_error$RUID_KEY[i]==ip$RUID_KEY[j]&&ip_error$TASK_START[i]>=ip$sess_start[j]&&ip_error$TASK_END[i]<ip$sess_end[j])){
    ev_ip_error<-rbind(ev_ip_error,ip[j,])
  }
}
}

我的矢量化代码如下,不起作用

al<-1:length(ip$RUID_KEY)
bl<-1:length(ip_error$RUID_KEY)

f<- function(i,j){
  if(isTRUE(ip_error$RUID_KEY[i]==ip$RUID_KEY[j]&&ip_error$TASK_START[i]>=ip$sess_start[j]&&ip_error$TASK_END[i]<ip$sess_end[j])){
    ev_ip_error<-rbind(ev_ip_error,ip[j,])
  }
}

mapply(f,al,bl)

这是我的数据框示例,其中 'ip_error' 中的第 1 行和第 3 行满足 if 条件

No.     RUID_KEY    sess_start  sess_end
1   101 2018-12-01 22:48:18.827 2018-12-01 22:55:18.900
2   201 2018-12-01 13:10:20.100 2018-12-01 13:50:10.000
3   201 2018-12-12 11:10:10.100 2018-12-12 11:20:00.100

‘ip_error’数据框

No. RUID_KEY    TASK_START  TASK_END    TASK_NAME
1   101 2018-12-01 22:50:18.827 2018-12-01 22:50:18.827 ERROR1
2   101 2018-12-01 15:10:20.100 2018-12-01 15:10:20.100 ERROR2
3   201 2018-12-01 13:40:10.100 2018-12-01 13:40:10.100 ERROR1
ev_ip_error<-data.frame(matrix(ncol=5,nrow=0))
x<-c("RUID_KEY", "sess_start", "sess_end")
colnames(ev_ip_error)<-x

考虑两个数据帧的merge然后按时间subset

ev_ip_error <- subset(merge(ip, ip_error, by="RUID_KEY", suffixes=c("", "_")),
                      TASK_START >= sess_start & TASK_END < sess_end)[names(ip)]

ev_ip_error

#   No. RUID_KEY          sess_start            sess_end
# 1   1      101 2018-12-01 22:48:18 2018-12-01 22:55:18
# 3   2      201 2018-12-01 13:10:20 2018-12-01 13:50:10

相当于unadjustedfor循环和corrected mapply(或Map)方法构建具有expand.grid的数据帧列表(对于RUID_KEY值之间的所有可能组合)。由于应用系列解决方案不保存作用域变量,因此您需要在其循环外构建对象或在循环外调用 rbind once。这比 for 循环更有效。见下文:

prms <- expand.grid(al = 1:length(ip$RUID_KEY),
                    bl = 1:length(ip_error$RUID_KEY))

f <- function(i,j){
  if(isTRUE(ip_error$RUID_KEY[i]==ip$RUID_KEY[j] && ip_error$TASK_START[i]>=ip$sess_start[j] && ip_error$TASK_END[i]<ip$sess_end[j])){
     return(ip[j,])
  }
}

df_list <- mapply(f, prms$al, prms$bl, SIMPLIFY = FALSE)
#df_list <- Map(f, prms$al, prms$bl)   # EQUIVALENT

ev_ip_error <- do.call(rbind, df_list)

请参阅 Online Demo 中所有三种方法的比较。

我建议使用 data.table 包并在不等条件下使用内部连接。一旦您习惯了语法,它就可以快速直接地使用。

设置如下:

第 1 步:创建示例数据集:

ip <- data.table::data.table(
  ruid_key = c(101, 201, 201),
  sess_start = as.POSIXct(c(
    '2018-12-01 22:48:18.827',
    '2018-12-01 13:10:20.100',
    '2018-12-12 11:10:10.100'
    )),
  sess_end = as.POSIXct(c(
    '2018-12-01 22:55:18.900',
    '2018-12-01 13:50:10.000',
    '2018-12-12 11:20:00.100')))


ip_error <- data.table::data.table(
  ruid_key = c(101,101,201),
  task_start = as.POSIXct(c(
    '2018-12-01 22:50:18.827',
    '2018-12-01 15:10:20.100',
    '2018-12-01 13:40:10.100'
  )),
  task_end = as.POSIXct(c(
    '2018-12-01 22:50:18.827',
    '2018-12-01 15:10:20.100',
    '2018-12-01 13:40:10.100'
  ))
)

第2步.做内连接,直接在连接

on条件中添加不等式
ip[ip_error, 
   on = c('ruid_key', 'sess_start<=task_start', 'sess_end>task_end'),
   .(sess_start = x.sess_start, sess_end = x.sess_end),
   nomatch = NULL
   ]