r - R中的有效循环

Question

数据看起来像

   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)

Answer 1

一种选择是使用 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 解决方案比评论中发布的动物园解决方案快 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