Question

为了避免在R中使用for循环，我编写了一个函数，该函数从给定来自另一个数据帧的行特定值的一个数据帧返回平均值。然后，我将此函数传递给行号的范围。我的函数有效，但它每秒返回~2.5个结果，这比使用for循环要好得多。所以，我觉得我没有充分利用apply系列函数的矢量化方面。任何人都可以帮我重新思考一下我的方法吗？这是一个最低限度的工作示例。提前谢谢。

#Creating first dataframe
dates<-seq(as.Date("2013-01-01"), as.Date("2016-07-01"), by = 1)
n<-length(seq(as.Date("2013-01-01"), as.Date("2016-07-01"), by = 1))
df1<-data.frame(date = dates, 
             hour = sample(1:24, n,replace = T), 
             cat = sample(c("a", "b"), n, replace = T),
             lag = sample(1:24, n, replace = T))

#Creating second dataframe
df2<-data.frame(date = sort(rep(dates, 24)), 
                hour = rep(1:24, length(dates)), 
                p = runif(length(rep(dates, 24)), min = -20, max = 100))

df2<-df2[order(df2$date, df2$hour),]

df2$cat<-"a"
temp<-df2
temp$cat<-"b"
df2<-rbind(df2,temp)

#function
period_mean<-function(x){

    tmp<-df2[df$cat == df1[x,]$cat,]

    #This line extracts the row name index from tmp,
    #in which the two dataframes match on date and hour
    he_i<-which(tmp$date == df1[x,]$date & tmp$hour == df1[x,]$hour)

    #My lagged period is given by the variable "lag". I want the average
    #over the period hour - (hour - lag). Since df2 is sorted such hours  
    #are consecutive, this method requires that I subset on only the 
    #relevant value for cat (hence the creation of tmp in the first line 
    #of the function
    p<-mean(tmp[(he_i - df1[x,]$lag):he_i,]$p)

    print(x)
    print(p)
    return(p)
}

#Execute function
out<-sapply(1:length(row.names(df1)), period_mean)

编辑我后来了解到，原始问题迭代这么慢的部分原因是我的两个数据帧之间的数据类不一样。 df1 $ date是一个日期字段，而df2 $ date是一个字符字段。当然，我发布的示例并不明显，因为数据类型与构造相同。希望这可以帮助。

Answer 1

以下是一个建议：

getIdx <- function(i) {
    date <- df1$date[i]
    hour <- df1$hour[i]    
    cat <- df1$cat[i]
    which(df2$date==date & df2$hour==hour & df2$cat==cat)
}
v_getIdx <- Vectorize(getIdx)

df1$index <- v_getIdx(1:nrow(df1))
b_start <- match("b", df2$cat)
out2 <- apply(df1[,c("cat","lag","index")], MAR=1, function(x) {
    flr <- ifelse(x[1]=="a", 1, b_start)
    x <- as.numeric(x[2:3])
    mean(df2$p[max(flr, (x[2]-x[1])):x[2]])
})

我们创建一个函数（getIdx）来检索df2中与df1中每行的值匹配的行，然后Vectorize函数。

然后我们运行矢量化函数来获得rownames的向量。我们将b_start设置为＆＃34; b＆＃34;类别开始。

然后，我们使用df1遍历apply行。在mean(...)函数中，我们设置＆＃34; floor＆＃34;要么是第1行（如果cat=="a"），要么是b_start（如果是cat=="b"），这样就不需要进行子集化（你使用tmp做了什么）。

性能：

> system.time(out<-sapply(1:length(row.names(df1)), period_mean))
   user  system elapsed 
 11.304   0.393  11.917 

> system.time({
+     df1$index <- v_getIdx(1:nrow(df1))
+     b_start <- match("b", df2$cat)
+     out2 <- apply(df1[,c("cat","lag","index")], MAR=1, function(x) {
+         flr <- ifelse(x[1]=="a", 1, b_start)
+         x <- as.numeric(x[2:3])
+         mean(df2$p[max(flr, (x[2]-x[1])):x[2]])
+     })
+ })
   user  system elapsed 
  2.839   0.405   3.274 

> all.equal(out, out2)
[1] TRUE

如何加速R中的循环函数

1 个答案: