Question

我使用此数据集进行了预测这里是trainsample（的一部分）

train=structure(list(Store = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 
10L, 11L, 12L, 13L, 14L, 15L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
9L, 10L, 11L, 12L, 13L, 14L, 15L), DayOfWeek = c(5L, 5L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L), Date = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("30.01.2015", 
"31.01.2015"), class = "factor"), Sales = c(5577L, 5919L, 6911L, 
13307L, 5640L, 6555L, 11430L, 6401L, 8072L, 6350L, 10031L, 9156L, 
7004L, 6491L, 8898L, 5577L, 5919L, 6911L, 13307L, 5640L, 6555L, 
11430L, 6401L, 8072L, 6350L, 10031L, 9156L, 7004L, 6491L, 8898L
), Customers = c(616L, 624L, 678L, 1632L, 617L, 692L, 1077L, 
747L, 643L, 602L, 1263L, 988L, 453L, 692L, 828L, 616L, 624L, 
678L, 1632L, 617L, 692L, 1077L, 747L, 643L, 602L, 1263L, 988L, 
453L, 692L, 828L), Open = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L), Promo = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L), StateHoliday = c(0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), SchoolHoliday = c(0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)), .Names = c("Store", 
"DayOfWeek", "Date", "Sales", "Customers", "Open", "Promo", "StateHoliday", 
"SchoolHoliday"), class = "data.frame", row.names = c(NA, -30L
))

这里是测试数据集

df2=structure(list(Id = 1:10, Store = 1:10, DayOfWeek = c(5L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L), Date = structure(c(1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "31.07.2015", class = "factor"), 
    Customers = c(555L, 625L, 821L, 1498L, 559L, 589L, 1414L, 
    833L, 687L, 681L), Open = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L), Promo = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L
    ), StateHoliday = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L
    ), SchoolHoliday = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L)), .Names = c("Id", "Store", "DayOfWeek", "Date", "Customers", 
"Open", "Promo", "StateHoliday", "SchoolHoliday"), class = "data.frame", row.names = c(NA, 
-10L))

测试样本仅具有2015年7月31日的数据，我必须预测销售额。因此，对每个商店分别进行了预测。

通过回归分析进行的预测

Forecast <- test
    for(store in store1$Store) {
      coeff <- lm(data = train[train$Store == store, ], 
                  Sales ~ DateDiff)$coefficients

      store1[store1$Store == store, 'reg_intercept']<- coeff[1]
      store1[store1$Store == store, 'reg_slope'] <- coeff[2]

      train[train$Store == store, 'LinearRegressionForecast'] <- 
        coeff[1] + coeff[2] * train[train$Store == store, 'DateDiff']

      Forecast[Forecast$Store == store, 'LinearRegressionForecast'] <- 
        coeff[1] + coeff[2] * Forecast[Forecast$Store == store, 'DateDiff']
    }


    #set predictors
    predictors <- c('Store', 'DayOfWeek', 'Promo')
    modelForecast <- train %>% 
      group_by_(.dots=predictors) %>% 
      summarize(salesMinusForecast=mean(Sales - LinearRegressionForecast)) %>% 
      ungroup()

    Forecast <-  Forecast %>% 
      left_join(modelForecast, by=predictors) %>% 
      mutate(Sales=salesMinusForecast + LinearRegressionForecast) %>% 
      select(Id, Store, DayOfWeek, Date, Sales, Open, Promo, StateHoliday, 
             SchoolHoliday, WeekOfYear,  DateDiff, LinearRegressionForecast)

    #View(Forecast)



    Forecast$Forecast <- 1
    train$Forecast <- 0


    x=train[, c(1:4, 6:13)]
    y=Forecast[, 2:13]
    testtrain=rbind(x,y)


    testtrain[testtrain$Forecast == 1, 
              'Type'] <- "Forecast"

    testtrain[testtrain$Forecast == 0, 
              'Type'] <- "Observed"

我也为商店数据集提供了部分数据

store1=structure(list(Store = 1:13, StoreType = structure(c(2L, 1L, 
1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L), .Label = c("a", 
"c", "d"), class = "factor"), Assortment = structure(c(1L, 1L, 
1L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L), .Label = c("a", 
"c"), class = "factor")), .Names = c("Store", "StoreType", "Assortment"
), class = "data.frame", row.names = c(NA, -13L))

执行预测时，我只是将数据写入csv文件

Forecast <- data.frame(Id=Forecast$Id, Sales=Forecast$Sales)

所以主要的问题是，对于每个商店，我都必须计算均方根误差（RMSPE）。公式是

其中y_i表示一天中一家商店的销售额，ŷ_i表示相应的预测。

因此，输出是商店，销售，预期销售和RMSPE的简单数量，即4列。

例如，此处173和174存储的结果（无RMSPE）

testtrain=structure(list(Store = c(173L, 173L, 173L, 173L, 173L, 173L, 
173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 174L, 174L, 174L, 
174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 
173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 
173L, 173L, 173L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 
174L, 174L, 174L, 174L, 174L, 174L, 173L, 173L, 173L, 173L, 173L, 
173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 173L, 174L, 174L, 
174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 174L, 
174L), DayOfWeek = c(3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), Date = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L), .Label = c("15.07.2015", "16.07.2015", "17.07.2015"
), class = "factor"), Sales = structure(c(27L, 12L, 16L, 18L, 
9L, 4L, 26L, 23L, 10L, 19L, 7L, 20L, 25L, 5L, 17L, 2L, 11L, 8L, 
3L, 22L, 15L, 14L, 28L, 6L, 1L, 24L, 13L, 21L, 27L, 12L, 16L, 
18L, 9L, 4L, 26L, 23L, 10L, 19L, 7L, 20L, 25L, 5L, 17L, 2L, 11L, 
8L, 3L, 22L, 15L, 14L, 28L, 6L, 1L, 24L, 13L, 21L, 27L, 12L, 
16L, 18L, 9L, 4L, 26L, 23L, 10L, 19L, 7L, 20L, 25L, 5L, 17L, 
2L, 11L, 8L, 3L, 22L, 15L, 14L, 28L, 6L, 1L, 24L, 13L, 21L), .Label = c("10318.344", 
"10725.268", "10765.647", "13546.236", "3418.328", "3939.406", 
"4089.442", "4377.643", "5196.012", "5487.437", "5778.296", "6200.403", 
"6216.929", "6331.589", "6404.693", "6472.833", "6693.678", "6751.922", 
"6770.161", "7510.433", "7736.447", "7743.879", "8107.569", "8119.046", 
"9087.104", "9326.839", "9718.452", "9855.327"), class = "factor"), 
    Promo = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), LinearRegressionForecast = structure(c(22L, 
    9L, 15L, 14L, 8L, 1L, 26L, 20L, 6L, 17L, 3L, 18L, 25L, 2L, 
    11L, 27L, 7L, 5L, 24L, 13L, 10L, 12L, 23L, 4L, 28L, 21L, 
    16L, 19L, 22L, 9L, 15L, 14L, 8L, 1L, 26L, 20L, 6L, 17L, 3L, 
    18L, 25L, 2L, 11L, 27L, 7L, 5L, 24L, 13L, 10L, 12L, 23L, 
    4L, 28L, 21L, 16L, 19L, 22L, 9L, 15L, 14L, 8L, 1L, 26L, 20L, 
    6L, 17L, 3L, 18L, 25L, 2L, 11L, 27L, 7L, 5L, 24L, 13L, 10L, 
    12L, 23L, 4L, 28L, 21L, 16L, 19L), .Label = c("10672.724", 
    "2286.724", "2940.339", "3038.273", "3265.624", "3387.729", 
    "3475.001", "3568.385", "4527.949", "5042.683", "5131.816", 
    "5196.835", "5204.855", "5239.113", "5572.545", "5605.564", 
    "5656.971", "6216.276", "6510.814", "6749.251", "6901.256", 
    "7248.194", "7310.538", "7549.539", "7585.489", "7842.506", 
    "8371.118", "8487.823"), class = "factor"), Type = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Forecast", "obser"
    ), class = "factor")), .Names = c("Store", "DayOfWeek", "Date", 
"Sales", "Promo", "LinearRegressionForecast", "Type"), class = "data.frame", row.names = c(NA, 
-84L))

LinearRegressionForecast列，我们不会碰。有列类型。预测是我们预测的，obser是初始值。

如何为每个商店计算此指标（RMSPE）。

必须对每个商店和每一天进行RMSPE计算

Answer 1

发布后，您的数据有两个问题，列Date不是类别Date，列Sales和LinearRegressionForecast属于类别factor。因此，我将从将这些列强制为适当的类开始。

testtrain$Date <- as.Date(testtrain$Date, "%d.%m.%Y")
testtrain$Sales <- as.numeric(levels(testtrain$Sales))[testtrain$Sales]
testtrain$LinearRegressionForecast <- as.numeric(levels(testtrain$LinearRegressionForecast))[testtrain$LinearRegressionForecast]

要计算感兴趣的统计量，请定义一个函数rmspe，split，Store和Date，然后调用传递每个子数据帧的函数。

rmspe <- function(DF){
  y <- DF[["Sales"]]
  y_obs <- y[DF[["Type"]] == "obser"]
  y_est <- y[DF[["Type"]] == "Forecast"]
  sqrt(mean(((y_obs - y_est)/y_obs)^2))
}


sp <- split(testtrain, list(testtrain$Store, testtrain$Date))

r <- sapply(sp, rmspe)

result <- data.frame(Store = sub("\\..*$", "", names(r)),
                     Date = sub("^\\d+\\.([-[:digit:]]+).*$", "\\1", names(r)),
                     RMSPE = r)

row.names(result) <- NULL
rm(sp, r)

result
#  Store       Date     RMSPE
#1   173 2015-07-15 0.7373282
#2   174 2015-07-15 0.3287756
#3   173 2015-07-16 0.7373282
#4   174 2015-07-16 0.3287756
#5   173 2015-07-17 0.7373282
#6   174 2015-07-17 0.3287756

计算R中的均方根误差

1 个答案: