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

Question

我试图通过迭代 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 倍。我想知道是否有人可以向我解释更好的方法。我想学习。

Answer 1

请务必阅读 data.table 的一些介绍 Material -- 特别是Introduction和 Reference Semantics小插曲。
接下来，我看到的最明显的事情是缺乏矢量化。在低级语言中，你必须一直循环；在 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这是在更复杂的场景中习惯这种语法；见 the .SD vignette更多。
这是我将称之为 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.table 的开发版本有 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
  )]
}