Я написал следующую функцию mape_fcn , чтобы вычислить точность прогноза временного ряда, следующим образом:
library(forecast)
mape_fcn <- function(fcn, trn, tst, h) {
fcst <- forecast(fcn(trn), h = h) # calculates a forecast using the training data
fcst_mean <- as.numeric(fcst$mean) # converts the forecast to a numeric value
mape <- sum(abs(fcst_mean - tst))/sum(tst) # calculates the weighted MAPE (Mean Absolute Percentage Error) of this forecast on the training data to the test data
mape
}
, где fcn - функция временного ряда trn - данные обучения временных рядов (все, кроме последних h наблюдений), tst - данные испытаний временных рядов, которые были удержаны для проверкиточность прогноза, а h - горизонт прогноза.
Я использовал эту функцию с pmap из библиотеки purrr длярассчитать MAPE различных функций из библиотеки прогноз за один тренинг и один набор тестовых данных следующим образом.
library(purrr)
library(forecast)
fcns <- list(auto.arima, nnetar, tbats)
trainlstsku1 <- list(trainsku1)
testlstsku1 <- list(testsku1)
pmap(list(fcns, trainlstsku1, testlstsku1, 12), mape_fcn)
Ниже приведены выходные данные MAPE различных функций (десятичные, непроцентов).
# [[1]]
# [1] 0.4552366
#
# [[2]]
# [1] 0.3576489
#
# [[3]]
# [1] 0.4256295
Я хотел бы расширить это, чтобы повторить два обучающих и два тестовых набора, соответственно, как я попытался ниже.
trainlstsample <- list(list(trainsku1, trainsku2))
testlstsample <- list(list(testsku1, testsku2))
pmap(list(fcns, trainlstsample, testlstsample, 12), mape_fcn)
Так что для каждого изнаборы данных (sku1 и sku2), я хочу увидеть MAPE длятри функции перечислены.Там будет 6 MAPE выходов.
Однако я получаю эту ошибку:
Error in is.constant(x) :
(list) object cannot be coerced to type 'double'
Called from: is.constant(x)
Вот соответствующие данные с кодом для преобразования векторов в ts объектов.(Я не разделял как ts объекты из-за проблем с форматированием.) Хотя обычно это не рекомендуется, я делюсь всеми данными, так как наборы данных не велики, и для функций прогнозирования необходимы достаточные наблюдения.Заранее спасибо за помощь.
trainsku1 <- ts( c(31900, 48000, 16000, 0, 16000, 48000, 96000, 0, 0, 31900, 32000, 63000, 63600, 32000, 0, 0, 0, 63100, 63300, 126500, 32000, 96000, 32000, 61400, 30000, 32000, 63700, 63700, 0, 0, 92800, 29800, 0, 0, 61800, 76500, 47800, 107600, 45200, 31700, 14600, 63600, 79500, 31900, 16000, 48000, 48000, 48000), start = c(2013, 8), frequency = 12)
testsku1 <- ts( c(16000, 48000, 32000, 16000, 48000, 64000, 111900, 48000, 16000, 62900, 31300, 32000), start = c(2017, 8), frequency = 12)
trainsku2 <- ts( c(56250, 90000, 108900, 96000, 0, 0, 0, 86400, 32400, 43200, 162000, 216000, 64800, 97200, 75600, 75600, 64800, 64800, 0, 0, 0, 0, 108000, 54000, 0, 0, 43200, 43200, 0, 0, 43200, 43200, 43200, 0, 108000, 43200, 43200), start = c(2014, 6), frequency = 12)
testsku2 <- ts( c(54000, 43200, 43200, 0, 0, 97200, 0, 54000, 0, 54000, 129600, 0, start = c(2017, 7), frequency = 12)