时间戳

首页 > 解决方案 > 优化缓慢的 for 循环操作

r - 优化缓慢的 for 循环操作

问题描述

我正在尝试通过迭代data.table. 这是我目前的方法。它按我的预期工作，但是当它data.table变大时，我会浪费大量时间。

library(data.table)

new_df <- data.table(text= c("RT A y...", "RT b...", "XYZ 3...", "RT Ca...", "IO"),
                     full_text= c(NA, NA, "XYZ 378978978", NA, NA),
                     status.text= c("A yes y...", "ball ball", NA, "Call ca...", NA),
                     status.full_text= c("A yes yes yes yes", NA, NA, "Call call call", NA))

#     text     full_text status.text  status.full_text
# 1: RT A y...          <NA>  A yes y... A yes yes yes yes
# 2:   RT b...          <NA>   ball ball              <NA>
# 3:  XYZ 3... XYZ 378978978        <NA>              <NA>
# 4:  RT Ca...          <NA>  Call ca...    Call call call
# 5:        IO          <NA>        <NA>              <NA>
#   

attach_texts_in_df <- function(give_me_df){
  
  #make an empty vector to store texts
  complete_texts <- c()
  
  #loop through each elements of rows
  for(i in seq_along(1:nrow(give_me_df))){
    
    #check if text begins with RT
    if(!grepl('^RT', give_me_df[i, "text"])){
      #check if text is smaller than the full_text, while full text is not NA
      if((nchar(give_me_df[i, "text"]) < nchar(give_me_df[i, "full_text"]))& !is.na(give_me_df[i, "full_text"])){
        complete_texts <- c(complete_texts, give_me_df[i, "full_text"])
        
      }else{
        complete_texts <- c(complete_texts, give_me_df[i, "text"]) # if not, then it's original
      }
      
    }
    else{
      
      if((nchar(give_me_df[i, "status.text"]) < nchar(give_me_df[i, "status.full_text"]))& !is.na(give_me_df[i, "status.full_text"])){
        complete_texts <- c(complete_texts, give_me_df[i, "status.full_text"])
        
      }else{
        complete_texts <- c(complete_texts, give_me_df[i, "status.text"])
      }
      
    }
  }
  
  #attached the proper texts
  give_me_df$complete_text <- complete_texts
  
  #return the vector
  return(give_me_df)
}

new_df <- attach_texts_in_df(new_df)

#this was the what I was looking for and I got it when its small, but big one take a long time!!
#     text     full_text status.text  status.full_text     complete_text
# 1: RT A y...          <NA>  A yes y... A yes yes yes yes A yes yes yes yes
# 2:   RT b...          <NA>   ball ball              <NA>         ball ball
# 3:  XYZ 3... XYZ 378978978        <NA>              <NA>     XYZ 378978978
# 4:  RT Ca...          <NA>  Call ca...    Call call call    Call call call
# 5:        IO          <NA>        <NA>              <NA>                IO

我想知道是否有人可以帮助我优化这个。R对我来说是新的。我知道应用函数存在，但我不知道如何使用这些自定义函数。

我将感谢您的帮助和提示。谢谢你。

编辑：我使用data.table函数执行了以下操作，但是我缺少一些数据：

sample_fxn <-  function(t,ft,st,sft){
  if(!grepl('^RT', t)){
    if((nchar(t) < nchar(ft)) & !is.na(ft)){
      return(ft)
    }else{
      return(t)
    }
  }
  else{
    if((nchar(st) < nchar(sft))& !is.na(sft)){
      return(sft)
    }else{
      return(st)
    }
  }
}

new_df <- new_df[ ,complete_texts := sample_fxn(text,
                                                full_text,
                                                status.text,
                                                status.full_text)]

#   text     full_text status.text  status.full_text         complete_texts
# 1: RT A y...          <NA>  A yes y... A yes yes yes yes  A yes yes yes yes 
# 2:   RT b...          <NA>   ball ball              <NA>                <NA>              
# 3:  XYZ 3... XYZ 378978978        <NA>              <NA>                <NA>             
# 4:  RT Ca...          <NA>  Call ca...    Call call call    Call call call    
# 5:        IO          <NA>        <NA>              <NA>                <NA>

这是我在阅读了@Henrik 分享的 R Inferno 书中的矢量化版本后的最佳尝试。我想出了：

new_df$complete_texts <- ifelse(!grepl('^RT', new_df$text),
                                yes = ifelse((nchar(new_df$text) < nchar(new_df$full_text))& !is.na(new_df$full_text),
                                             yes = new_df$full_text,
                                             no = new_df$text
                                ),
                                no = ifelse((nchar(new_df$status.text) < nchar(new_df$status.full_text))& !is.na(new_df$status.full_text),
                                            yes = new_df$status.full_text,
                                            no = new_df$status.text
                                )
                          )

这确实使工作完成速度提高了 3 倍。我想知道是否有人可以向我解释更好的方法。我想学习。

标签： rdataframeoptimizationparallel-processingdata.table

解决方案

确保阅读一些介绍材料data.table——特别是介绍和参考语义小插曲。

接下来，我看到的最明显的事情是缺乏矢量化。在低级语言中，你必须一直循环；在 R 中，你应该总是想——我真的需要一个循环吗？在您的代码中，我看到正在使用的几个矢量化函数的标量版本：

  • grepl适用于矢量
  • nchar适用于矢量
  • is.na适用于矢量

只要有可能，您应该使用向量版本——与只调用一次相比，重复调用 C 函数会有一些延迟：

  • for (i in 1:nrow(DT)) grepl('^RT', DT[i, "text"])保证慢于grepl('^RT', DT$text)

接下来，重复data.table调用会有一些额外的开销[，因为内部内部有很多事情[要处理更复杂的“查询”，所以你应该尽可能地利用它！

最后，data.table我宁愿让函数返回一个可以分配为列的向量，而不是更新函数中的

new_df[ , complete_text := my_function(.SD)]

注意这和这个简单的例子my_function(.SD)是一样的——这里的使用是为了在更复杂的场景中习惯这种语法；有关更多信息，请参见小插图。my_function(new_df).SD.SD

这是我将调用的更新版本get_complete_text：

get_complete_text = function(DT) {
  DT[ , fifelse(
    grepl('^RT', text),
    fifelse(
      nchar(status.text) < nchar(status.full_text) & !is.na(status.full_text), 
      status.full_text,
      status.text
    ),
    fifelse(
      nchar(text) < nchar(full_text) & !is.na(full_text),
      full_text,
      text
    )
  )]
}
new_df[ , complete_text := get_complete_text(.SD)][]
#         text     full_text status.text  status.full_text     complete_text
# 1: RT A y...          <NA>  A yes y... A yes yes yes yes A yes yes yes yes
# 2:   RT b...          <NA>   ball ball              <NA>         ball ball
# 3:  XYZ 3... XYZ 378978978        <NA>              <NA>     XYZ 378978978
# 4:  RT Ca...          <NA>  Call ca...    Call call call    Call call call
# 5:        IO          <NA>        <NA>              <NA>                IO

嵌套fifelse可以通过一个中间列来简化，该text列根据^RT条件存储要使用的列：

idx = new_df[grepl('^RT', text), which=TRUE]
new_df[idx, c('rt_text', 'rt_full_text') := .(status.text, status.full_text)]
new_df[-idx, c('rt_text', 'rt_full_text') := .(text, full_text)]

new_df[ , complete_text := 
  fifelse(
    nchar(rt_text) < nchar(rt_full_text) & !is.na(rt_full_text),
    rt_full_text,
    rt_text
  )
]

或者，使用data.tablethere is的开发版本fcase，您可能会发现它更具可读性（在这种情况下，我认为嵌套fifelse工作正常）：

get_complete_text = function(DT) {
  DT[ , fcase(
    grepl('^RT', text) & nchar(status.text) < nchar(status.full_text) & !is.na(status.full_text),
    status.full_text,
    grepl('^RT', text) & (nchar(status.full_text) >= nchar(status.text) | is.na(status.full_text)),
    status.text,
    # here, we're implicitly using that logically grepl('^RT') is now FALSE
    nchar(text) < nchar(full_text) & !is.na(full_text),
    full_text,
    # there is some ongoing work to make this less ugly,
    #   but for now this is the catchall term -- we could also
    #   explicitly write out the conjugate condition nchar(full_text) >= ...
    rep(TRUE, .N),
    text
  )]
}

推荐阅读