erstellen effiziente Woche über Woche Berechnung mit subsetting

Question

In meinem Arbeits-Datensatz, versuche ich Woche-over-Woche-Wert für die Änderungen in Groß- und Einnahmen zu berechnen. Der Code scheint zu funktionieren, aber meine Schätzungen zeigen, dass es etwa 75 Stunden dauern wird, um eine scheinbar einfache Berechnung auszuführen. Im Folgenden ist die allgemeine reproduzierbare Version, die auf dieser kleineren Datensatz läuft etwa 2m nimmt:

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

Jede Verständnis Hilfe, warum das so lange dauert, oder wie man die Zeit abgeholzt würde sehr geschätzt werden!

Answer 1

Die erste for Schleife kann mit dem folgenden für vereinfacht werden:

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 

Ersetzen zweite for Schleife

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 

Dieser Vorgang dauert etwa 4 Millisekunden auf meinem Laptop läuft

Answer 2

Hier eine vektorisierte Lösung unter Verwendung des tidyr-Pakets.

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 

Die Strategie bestand darin, die ursprünglichen Daten in ein breites Format, bei dem die Reihen waren die Produkt-ID und die Säulen waren die Wochen zu konvertieren. Teilen Sie dann die Datenrahmen voneinander. Konvertiere zurück in ein langes Format und füge die neu berechneten Werte dem exampleData-Datenrahmen hinzu. Dies funktioniert, nicht sehr sauber, aber sehr viel schneller als die Schleife. Das dplyr-Paket ist ein weiteres Werkzeug für diese Art von Arbeit.

Um diese Ergebnisse dieses Codes zu vergleichen mit Ihnen Fall Gebrauch zu testen:

print(identical(goldendata, exampleData)) 

Wo goldendata ist Ihre bekannt gute Ergebnisse, sollten Sie die gleichen Zufallszahl mit der set.seed() Funktion verwenden. aber