高效的R循环

Question

高效的R循环

4

数据看起来像这样：

   cum_ft source 

 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds
 123.1018   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
   0.0000  maint 
   0.0000  maint 
   0.0000  maint 
 126.7622   imds 
 126.7622   imds 
 126.7622   imds

目标是将maint的值设置为imds中的最后一个值。

   cum_ft source 
 123.1018   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585   imds 
 125.4585  maint 
 125.4585  maint 
 125.4585  maint 
 126.7622   imds 
 126.7622   imds 
 126.7622   imds

我一直在尝试做某件事情，但是没有成功，类似于：

maint_rows_to_change = which(temp_df$source=="maint")
diff_maint_row_to_change = diff(maint_rows_to_change)
imds_rows_with_data = which(temp_df$source=="imds")
diff_imds_row_to_change = diff(imds_rows_with_data)
rows_to_change_increment = which(diff_update_row > 1)

在此时，当需要跳过IMSL数据时，diff_maint_row_to_change的数字大于1，而在需要调整连续维护行时，其值为1。调整是将维护行的cum_ft值设置为IMSL数据的最后一个值。

我想写的内容应该像下面的表达式，但我不清楚如何得出last_imds_row。在本例中，maint_rows_to_change = c（11,12,13），last_imds_row = c（10,10,10）。

temp_df$cum_ft[maint_rows_to_change] = temp_df$cum_ft[last_imds_row]

我还尝试了循环，有一定的成功，但是时间太长。

fun1 <- function(z) {
  z$cum_ft_cor = z$cum_ft
  rows_to_fix = which(z$source=="maint")
  z$cum_ft_cor[rows_to_fix]=-1
  for(i in rows_to_fix) {
    z$cum_ft_cor[i] <- z$cum_ft_cor[i-1]
  }
  z
}
temp_df_2 =  fun1(temp_df)

- user3969377

1

“maint”是否总是等于零，而“imds”从不等于零？ - David Arenburg

也许将零设置为NA，然后使用na.locf()函数？当然，这取决于您的数据集的其他部分如何以及它是否按照正确的顺序排列。 - Stu

有两个数据源，imds和maint。 imds和maint数据源都有时间戳，但只有imds有ft_cum值。上面的数据是从imds和maint数据框中列的行合并，并按时间戳排序的。目标是获取maint数据的ft_cum值。因此，maint始终为零或NA，但imds可以为零或正数。需要更新的是maint值，因此我只需在源列中搜索“maint”。 - user3969377

2

那么这就是小菜一碟了，只需要执行以下代码：library(zoo) ; temp_df[temp_df$source == "maint", "cum_ft"] <- NA ; temp_df$cum_ft <- na.locf(temp_df$cum_ft) - David Arenburg

我喜欢蛋糕!!! 我明天会试一试...谢谢!!! - user3969377

@DavidArenburg 谢谢，上面的“loop”在测试用例上需要大约90分钟，而na.locf方法几乎瞬间执行。 - user3969377

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- josliber · Accepted Answer

一种方法是使用Rcpp包来加速循环解决方案:

library(Rcpp)
copyDat <- cppFunction(
'void copyDat(NumericVector x, std::vector<std::string> y) {
  for (int i=1; i < y.size(); ++i) {
    if (y[i] == "maint") x[i] = x[i-1];
  }
}')

那么你可以这样做：

copyDat(temp_df$cum_ft, as.character(temp_df$source))
temp_df
#      cum_ft source
# 1  125.4585   imds
# 2  125.4585   imds
# 3  125.4585   imds
# 4  125.4585   imds
# 5  125.4585   imds
# 6  125.4585   imds
# 7  123.1018   imds
# 8  125.4585   imds
# 9  125.4585   imds
# 10 125.4585   imds
# 11 125.4585  maint
# 12 125.4585  maint
# 13 125.4585  maint
# 14 126.7622   imds
# 15 126.7622   imds
# 16 126.7622   imds

在一个包含130万行数据的示例中，Rcpp解决方案比评论中发布的zoo解决方案快6倍（尽管两者都相当快速）。

# Functions to benchmark
josilber <- function(temp_df) {
  copyDat(temp_df$cum_ft, as.character(temp_df$source))
  temp_df
}
library(zoo)
darenburg <- function(temp_df) {
  temp_df[temp_df$source == "maint", "cum_ft"] <- NA
  temp_df$cum_ft <- na.locf(temp_df$cum_ft)
  temp_df
}

# Do the test
library(microbenchmark)
temp_df <- data.frame(cum_ft=rnorm(1300000),
                      source=rep(c(rep("imds", 10), rep("maint", 3)), 100000))
all.equal(josilber(temp_df), darenburg(temp_df))
# [1] TRUE
microbenchmark(josilber(temp_df), darenburg(temp_df))
# Unit: milliseconds
#                expr       min        lq    median        uq      max neval
#   josilber(temp_df)  78.05012  83.80206  86.96831  92.56959 122.5809   100
#  darenburg(temp_df) 464.33525 492.76668 510.65864 541.43435 703.6944   100