Create efficient week over week calculation with subsetting

user_5807695 0
Viewed 455

In my working dataset, I'm trying to calculate week-over-week values for the changes in wholesale and revenue. The code seems to work, but my estimates show it'll take about 75hrs to run what is a seemingly simple calculation. Below is the generic reproducible version which takes about 2m to run on this smaller dataset:

########################################################################################################################
# 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
  }
}

Any help understanding why this takes so long or how to cut down the time would be much appreciated!

subset r loops performance
2 Answers

The first for loop can be simplified with the following 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

Replacing second for loop

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

This takes about 4 milliseconds to run on my laptop

user_32421300

Here is a vectorized solution using the tidyr package.

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

The strategy was to convert the original data into a wide format where the rows were the product id and the columns were the weeks. Then divide the data frames by each other. Convert back into a long format and add the newly calculated values to the exampleData data frame. This works, not very clean but very much faster than the loop. The dplyr package is another tool for this type of work.

To compare this results of this code with you test case use:

print(identical(goldendata, exampleData))

Where goldendata is your known good results, be sure to use the same random numbers with the set.seed() function.

user_57922440
Related