问题
I am trying to make forecasting for sales from two stores: Store 1 and Store 2. Like results from forecasting with forecasting package I got this two table.First table contain data about MAPE error separably by each model(column Value).Below you can see data and screen shot of data.
Table_1<-structure(list(...1 = c("1", "2", "3", "4", "5", "6", "7", "8",
"9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19",
"20"), X1 = c("SNAIVE", "HW", "ETS", "ARIMA", "STL", "TBATS",
"NNETAR", "RWF", "TSLM", "FOURIER", "SNAIVE", "HW", "ETS", "ARIMA",
"STL", "TBATS", "NNETAR", "RWF", "TSLM", "FOURIER"), X2 = c("Store 1",
"Store 1", "Store 1", "Store 1", "Store 1", "Store 1", "Store 1",
"Store 1", "Store 1", "Store 1", "Store 2", "Store 2", "Store 2",
"Store 2", "Store 2", "Store 2", "Store 2", "Store 2", "Store 2",
"Store 2"), value = c(11.2819379803024, 4.90469397146697, 4.90469397146697,
4.64808116952175, 4.92695563666538, 6.11286061911487, 7.66061575087076,
8.95984865369006, 5.07614708345642, 4.57448859126253, 22.7760224588221,
24.0502857269679, 18.9376978459644, 21.6693712888351, 21.6029490199174,
24.692214948761, 26.2680955559159, 30.5302345480261, 22.2367412218357,
22.6100823447494)), row.names = c(NA, -20L), class = c("tbl_df",
"tbl", "data.frame"))
With yellow color I already highlighted best three models (with lowest MAPE error) from forecasting for Store 1 and Store 2.For Store 1 are (ETS,ARIMA and Fourier) and for Store 2 (ETS,ARIMA and STL).
Second table contain forecasted data by each month from all this models.Below you can see data and also screen shot of data.
Table2<-structure(list(Date = structure(c(1575158400, 1577836800, 1580515200,
1583020800, 1585699200, 1588291200, 1590969600, 1593561600, 1596240000,
1598918400, 1601510400, 1604188800, 1606780800, 1575158400, 1577836800,
1580515200, 1583020800, 1585699200, 1588291200, 1590969600, 1593561600,
1596240000, 1598918400, 1601510400, 1604188800, 1606780800, 1575158400,
1577836800, 1580515200, 1583020800, 1585699200, 1588291200, 1590969600,
1593561600, 1596240000, 1598918400, 1601510400, 1604188800, 1606780800,
1575158400, 1577836800, 1580515200, 1583020800, 1585699200, 1588291200,
1590969600, 1593561600, 1596240000, 1598918400, 1601510400, 1604188800,
1606780800, 1575158400, 1577836800, 1580515200, 1583020800, 1585699200,
1588291200, 1590969600, 1593561600, 1596240000, 1598918400, 1601510400,
1604188800, 1606780800, 1575158400, 1577836800, 1580515200, 1583020800,
1585699200, 1588291200, 1590969600, 1593561600, 1596240000, 1598918400,
1601510400, 1604188800, 1606780800, 1575158400, 1577836800, 1580515200,
1583020800, 1585699200, 1588291200, 1590969600, 1593561600, 1596240000,
1598918400, 1601510400, 1604188800, 1606780800, 1575158400, 1577836800,
1580515200, 1583020800, 1585699200, 1588291200, 1590969600, 1593561600,
1596240000, 1598918400, 1601510400, 1604188800, 1606780800, 1575158400,
1577836800, 1580515200, 1583020800, 1585699200, 1588291200, 1590969600,
1593561600, 1596240000, 1598918400, 1601510400, 1604188800, 1606780800,
1575158400, 1577836800, 1580515200, 1583020800, 1585699200, 1588291200,
1590969600, 1593561600, 1596240000, 1598918400, 1601510400, 1604188800,
1606780800), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Forecasting_model = c("SNAIVE", "SNAIVE", "SNAIVE", "SNAIVE",
"SNAIVE", "SNAIVE", "SNAIVE", "SNAIVE", "SNAIVE", "SNAIVE",
"SNAIVE", "SNAIVE", "SNAIVE", "HW", "HW", "HW", "HW", "HW",
"HW", "HW", "HW", "HW", "HW", "HW", "HW", "HW", "ETS", "ETS",
"ETS", "ETS", "ETS", "ETS", "ETS", "ETS", "ETS", "ETS", "ETS",
"ETS", "ETS", "ARIMA", "ARIMA", "ARIMA", "ARIMA", "ARIMA",
"ARIMA", "ARIMA", "ARIMA", "ARIMA", "ARIMA", "ARIMA", "ARIMA",
"ARIMA", "STL", "STL", "STL", "STL", "STL", "STL", "STL",
"STL", "STL", "STL", "STL", "STL", "STL", "TBATS", "TBATS",
"TBATS", "TBATS", "TBATS", "TBATS", "TBATS", "TBATS", "TBATS",
"TBATS", "TBATS", "TBATS", "TBATS", "NNAR", "NNAR", "NNAR",
"NNAR", "NNAR", "NNAR", "NNAR", "NNAR", "NNAR", "NNAR", "NNAR",
"NNAR", "NNAR", "RWF", "RWF", "RWF", "RWF", "RWF", "RWF",
"RWF", "RWF", "RWF", "RWF", "RWF", "RWF", "RWF", "TSLM",
"TSLM", "TSLM", "TSLM", "TSLM", "TSLM", "TSLM", "TSLM", "TSLM",
"TSLM", "TSLM", "TSLM", "TSLM", "FOURIER", "FOURIER", "FOURIER",
"FOURIER", "FOURIER", "FOURIER", "FOURIER", "FOURIER", "FOURIER",
"FOURIER", "FOURIER", "FOURIER", "FOURIER"), `Store 1` = c(8083,
1171, 1328, 1281, 1281, 1118, 1107, 1611, 1116, 1133, 1618,
1261, 8083, 8312, 1336, 1261, 1673, 1667, 1223, 1603, 1621,
1211, 1633, 1637, 1672, 8138, 8312, 1336, 1261, 1673, 1667,
1223, 1603, 1621, 1211, 1633, 1637, 1672, 8138, 8818, 1363,
1282, 1671, 1623, 1276, 1283, 1687, 1261, 1632, 1676, 1631,
8367, 8827, 1108, 1226, 1681, 1661, 1288, 1616, 1683, 1278,
1663, 1678, 1703, 8338, 8371, 1183, 1237, 1738, 1701, 1637,
1681, 1721, 1271, 1738, 1663, 1732, 8180, 8076, 1318, 1271,
1732, 1883, 1286, 1607, 1336, 1281, 1711, 1873, 1881, 8183,
1271, 1283, 1233, 1608, 1618, 1681, 1631, 1611, 1620, 1660,
1663, 1673, 1688, 8166, 1317, 1188, 1233, 1273, 1183, 1212,
1276, 1178, 1221, 1226, 1283, 8863, 8811, 1118, 1223, 1661,
1621, 1260, 1286, 1617, 1213, 1688, 1687, 1660, 8311), `Store 2` = c(1180,
811, 312, 1612, 1387, 878, 812, 883, 362, 768, 800, 760,
1180, 1021, 761, 1002, 1106, 1271, 337, 1113, 373, 833, 1012,
333, 303, 1166, 336, 708, 332, 1312, 1168, 838, 1010, 862,
773, 883, 861, 767, 1000, 1070, 636, 838, 1161, 1183, 887,
1001, 813, 331, 820, 738, 732, 1087, 333, 688, 810, 1311,
1183, 876, 338, 818, 816, 818, 816, 773, 333, 337, 888, 871,
1378, 1100, 1008, 368, 380, 883, 386, 872, 838, 363, 1102,
301, 831, 1133, 1331, 831, 333, 321, 338, 883, 832, 881,
1303, 766, 778, 773, 782, 731, 737, 801, 810, 816, 888, 883,
832, 811, 1820, 1000, 1136, 1270, 1718, 1188, 1873, 1162,
1136, 1130, 1178, 1110, 1371, 380, 703, 306, 1862, 1110,
873, 327, 837, 808, 817, 838, 726, 371)), row.names = c(NA,
-130L), class = c("tbl_df", "tbl", "data.frame"))
So my intention is to make automated selection of best three models like highlighted models above on basis on lowest MAPE error and calculate average by months of best three models for Store 1 and Store 2 like example below.
I tried with this code but I don't have good idea how to continue.
# Arrange data by MAPE error
Table_1a<-data.frame(Table_1)%>%
select(X1,X2,value)%>%
arrange((value),.by_group = TRUE)
# Select three best models
Table_1b <-data.frame(rbind(Table_1a[1:3, 1:3],Table_1a[10:13, 1:3]))%>%
select(X1,X2)%>%
group_by(X1,X2)
# Тhis line does not work
Forecasting_Store_1<-mutate(Table_2,
ifelse(Table_1b$X1==Table_2$Forecasting_model,Table_2$Forecasting_model,"")
)
So can anybody help me how to resolve this problem ?
回答1:
Here is a possible solution:
First, you select the 3 best models. I prefer to use top_n which is similar to your solution but a little cleaner. The trick is then to paste the model and the store to have a unique key.
model_ok = Table_1 %>%
group_by(X2) %>%
top_n(-3, value) %>% ungroup %>%
transmute(model_ok=paste(X1,X2)) %>% unlist
Note that in your example sample, there is a tie in third place, so my code selected 4 models for store 1 instead of 3 (and so did your code).
Then you can pivot the second table to have the stores in lines instead of columns, do the pasting again and filter the lines that match the accepted keys.
table3=Table2 %>%
pivot_longer(c(`Store 1`,`Store 2`), names_to = "store") %>%
mutate(model_store=paste(Forecasting_model, store)) %>%
filter(model_store %in% model_ok) %>%
select(-model_store)
Finally, you can pivot again the table to get the models as columns and compute the average of the 3 models (or 4 in my case). If you have only 2 stores you can just repeat this code with "Store 2".
table3 %>%
filter(store=="Store 1") %>%
pivot_wider(names_from = Forecasting_model) %>%
mutate(average=rowMeans(select(., -Date, -store)))
EDIT:
Since you seem to have multiple stores, here is an example on how you could use purrr::map to loop over the stores. First, you need the different stores as a named vector. I used Table_1$X2 %>% unique %>% set_names but you probably want to use a cleaner object.
library(purrrr)
output=Table_1$X2 %>% unique %>% set_names %>% map(~{
table3 %>%
filter(store==.x) %>%
pivot_wider(names_from = Forecasting_model) %>%
mutate(average=rowMeans(select(., -Date, -store)))
})
output$`Store 1`
output$`Store 2`
Hope it helped.
来源：https://stackoverflow.com/questions/59477284/data-manipulation-with-forecasting-data