AOE*_*yer 3 parallel-processing optimization r dataframe data.table
我试图通过迭代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 倍。我想知道是否有人可以向我解释更好的方法。我想学习。
Mic*_*ico 10
一定要阅读一些介绍材料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
)]
}