使用子集创建有效的每周计算

Question

在我的工作数据集中，我试图计算批发和收入变化的每周值。该代码似乎有效，但我的估计显示运行看似简单的计算需要大约 75 小时。下面是在这个较小的数据集上运行大约 2m 的通用可重现版本：

########################################################################################################################
# MAKE A GENERIC REPORDUCIBLE STACK OVERFLOW QUESTION
########################################################################################################################

# Create empty data frame of 26,000 observations  similar to my data, but populated with noise
exampleData <- data.frame(product = rep(LETTERS,1000),
                          wholesale = rnorm(1000*26), 
                          revenue = rnorm(1000*26))

# create a week_ending column which increases by one week with every set of 26 "products"
for(i in 1:nrow(exampleData)){
  exampleData$week_ending[i] <- as.Date("2016-09-04")+7*floor((i-1)/26)
}
exampleData$week_ending <- as.Date(exampleData$week_ending, origin = "1970-01-01")

# create empty columns to fill
exampleData$wholesale_wow <- NA
exampleData$revenue_wow <- NA

# loop through the wholesale and revenue numbers and append the week-over-week changes
for(i in 1:nrow(exampleData)){
  # set a condition where the loop only appends the week-over-week values if it's not the first week
  if(exampleData$week_ending[i]!="2016-09-04"){
    # set temporary values for the current and past week's wholesale value
    currentWholesale <- exampleData$wholesale[i]
    lastWeekWholesale <- exampleData$wholesale[which(exampleData$product==exampleData$product[i] & 
                                                       exampleData$week_ending==exampleData$week_ending[i]-7)] 
    exampleData$wholesale_wow[i] <- currentWholesale/lastWeekWholesale -1

    # set temporary values for the current and past week's revenue
    currentRevenue <- exampleData$revenue[i]
    lastWeekRevenue <- exampleData$revenue[which(exampleData$product==exampleData$product[i] & 
                                                   exampleData$week_ending==exampleData$week_ending[i]-7)] 
    exampleData$revenue_wow[i] <- currentRevenue/lastWeekRevenue -1
  }
}

任何帮助理解为什么这需要这么长时间或如何减少时间将不胜感激！

Answer 1

第一个for 循环可以简化为：

exampleData$week_ending2 <- as.Date("2016-09-04") + 7 * floor((seq_len(nrow(exampleData)) - 1) / 26)

setequal(exampleData$week_ending, exampleData$week_ending2)
[1] TRUE

替换第二个for 循环

library(data.table)
dt1 <- as.data.table(exampleData)
dt1[, wholesale_wow := wholesale / shift(wholesale) - 1 , by = product]
dt1[, revenue_wow := revenue / shift(revenue) - 1 , by = product]

setequal(exampleData, dt1)
[1] TRUE

在我的笔记本电脑上运行大约需要 4 毫秒

Answer 2

这是使用 tidyr 包的矢量化解决方案。

set.seed(123)
# Create empty data frame of 26,000 observations  similar to my data, but populated with noise
exampleData <- data.frame(product = rep(LETTERS,1000),
                          wholesale = rnorm(1000*26), 
                          revenue = rnorm(1000*26))

# create a week_ending column which increases by one week with every set of 26 "products"
#vectorize the creating of the data
i<-1:nrow(exampleData)
exampleData$week_ending <- as.Date("2016-09-04")+7*floor((i-1)/26)

exampleData$week_ending <- as.Date(exampleData$week_ending, origin = "1970-01-01")

# create empty columns to fill
exampleData$wholesale_wow <- NA
exampleData$revenue_wow <- NA

#find the index of rows of interest (ie removing the first week)
i<-i[exampleData$week_ending!="2016-09-04"]

library(tidyr)

#create temp variables and convert into wide format
# the rows are product and the columns are the ending weeks
Wholesale<-exampleData[ ,c(1,2,4)]
Wholesale<-spread(Wholesale, week_ending, wholesale)

Revenue<-exampleData[ ,c(1,3,4)]
Revenue<-spread(Revenue, week_ending, revenue)

#number of columns
numCol<-ncol(Wholesale)

#remove the first two columns for current wholesale
#remove the first and last column for last week's wholesale
#perform calculation on ever element in dataframe (divide this week/lastweek)
Wholesale_wow<- Wholesale[ ,-c(1, 2)]/Wholesale[ ,-c(1, numCol)] - 1
#convert back to long format
Wholesale_wow<-gather(Wholesale_wow)

#repeat for revenue
Revenue_wow<- Revenue[ ,-c(1, 2)]/Revenue[ ,-c(1, numCol)] - 1
#convert back to long format
Revenue_wow<-gather(Revenue_wow)

#assemble calculated values back into the original dataframe
exampleData$wholesale_wow[i]<-Wholesale_wow$value
exampleData$revenue_wow[i]<-Revenue_wow$value

策略是将原始数据转换为宽格式，其中行是产品 ID，列是周。然后将数据帧相互分割。转换回长格式并将新计算的值添加到 exampleData 数据框。这行得通，不是很干净，但比循环快得多。 dplyr 包是此类工作的另一个工具。

要将此代码的结果与您的测试用例进行比较，请使用：

print(identical(goldendata, exampleData))  

如果 golddata 是您已知的良好结果，请务必在 set.seed() 函数中使用相同的随机数。