PM.25, Discussion 1
Predictive analytics and forecasting
Joey Biasi
10/28/2020
Download Starts Data
##########################################################
library(knitr)
library(fpp2)## Warning: package 'fpp2' was built under R version 4.0.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo## -- Attaching packages ----------------------------------------------- fpp2 2.4 --## v ggplot2 3.3.2 v fma 2.4
## v forecast 8.13 v expsmooth 2.3## Warning: package 'forecast' was built under R version 4.0.3## Warning: package 'fma' was built under R version 4.0.3## Warning: package 'expsmooth' was built under R version 4.0.3## starts=read.csv("C:/Users/jfbia/OneDrive/Documents/predictive analytics/discussions/starts.csv", header = TRUE)
starts <- ts(starts[,5], start=c(1959,1,1) ,frequency=12)
plot(starts)
##########################################################Decomp multiplicative and additive
##########################################################
dec1<-decompose(starts,type="additive") #decompose additive
dec2<-decompose(starts,type="multiplicative") #decompomse multiplicative
##########################################################Plot Decompositions
##########################################################
autoplot(dec1)
autoplot(dec2)
starts## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 1959 1657 1667 1620 1590 1498 1503 1547 1430 1540 1355 1416 1601
## 1960 1460 1503 1109 1289 1271 1247 1197 1344 1097 1246 1246 1063
## 1961 1183 1226 1312 1166 1228 1382 1335 1312 1429 1415 1385 1365
## 1962 1361 1278 1443 1524 1483 1404 1450 1517 1324 1533 1622 1564
## 1963 1244 1456 1534 1689 1641 1588 1614 1639 1763 1779 1622 1491
## 1964 1603 1820 1517 1448 1467 1550 1562 1569 1455 1524 1486 1484
## 1965 1361 1433 1423 1438 1478 1488 1529 1432 1482 1452 1460 1656
## 1966 1370 1378 1394 1352 1265 1194 1086 1119 1046 843 961 990
## 1967 1067 1123 1056 1091 1304 1248 1364 1407 1421 1491 1538 1308
## 1968 1380 1520 1466 1554 1408 1405 1512 1495 1556 1569 1630 1548
## 1969 1769 1705 1561 1524 1583 1528 1368 1358 1507 1381 1229 1327
## 1970 1085 1305 1319 1264 1290 1385 1517 1399 1534 1580 1647 1893
## 1971 1828 1741 1910 1986 2049 2026 2083 2158 2041 2128 2182 2295
## 1972 2494 2390 2334 2249 2221 2254 2252 2382 2481 2485 2421 2366
## 1973 2481 2289 2365 2084 2266 2067 2123 2051 1874 1677 1724 1526
## 1974 1451 1752 1555 1607 1426 1513 1316 1142 1150 1070 1026 975
## 1975 1032 904 993 1005 1121 1087 1226 1260 1264 1344 1360 1321
## 1976 1367 1538 1421 1395 1459 1495 1401 1550 1720 1629 1641 1804
## 1977 1527 1943 2063 1892 1971 1893 2058 2020 1949 2042 2042 2142
## 1978 1718 1738 2032 2197 2075 2070 2092 1996 1970 1981 2094 2044
## 1979 1630 1520 1847 1748 1876 1913 1760 1778 1832 1681 1524 1498
## 1980 1341 1350 1047 1051 927 1196 1269 1436 1471 1523 1510 1482
## 1981 1547 1246 1306 1360 1140 1045 1041 940 911 873 837 910
## 1982 843 866 931 917 1025 902 1166 1046 1144 1173 1372 1303
## 1983 1586 1699 1606 1472 1776 1733 1785 1910 1710 1715 1785 1688
## 1984 1897 2260 1663 1851 1774 1843 1732 1586 1698 1590 1689 1612
## 1985 1711 1632 1800 1821 1680 1676 1684 1743 1676 1834 1698 1942
## 1986 1972 1848 1876 1933 1854 1847 1782 1807 1687 1681 1623 1833
## 1987 1774 1784 1726 1614 1628 1594 1575 1605 1695 1515 1656 1400
## 1988 1271 1473 1532 1573 1421 1478 1467 1493 1492 1522 1569 1563
## 1989 1621 1425 1422 1339 1331 1397 1427 1332 1279 1410 1351 1251
## 1990 1551 1437 1289 1248 1212 1177 1171 1115 1110 1014 1145 969
## 1991 798 965 921 1001 996 1036 1063 1049 1015 1079 1103 1079
## 1992 1176 1250 1297 1099 1214 1145 1139 1226 1186 1244 1214 1227
## 1993 1210 1210 1083 1258 1260 1280 1254 1300 1343 1392 1376 1533
## 1994 1272 1337 1564 1465 1526 1409 1439 1450 1474 1450 1511 1455
## 1995 1407 1316 1249 1267 1314 1281 1461 1416 1369 1369 1452 1431
## 1996 1467 1491 1424 1516 1504 1467 1472 1557 1475 1392 1489 1370
## 1997 1355 1486 1457 1492 1442 1494 1437 1390 1546 1520 1510 1566
## 1998 1525 1584 1567 1540 1536 1641 1698 1614 1582 1715 1660 1792
## 1999 1748 1670 1710 1553 1611 1559 1669 1648 1635 1608 1648 1708
## 2000 1636 1737 1604 1626 1575 1559 1463 1541 1507 1549 1551 1532
## 2001 1600 1625 1590 1649 1605 1636 1670 1567 1562 1540 1602 1568
## 2002 1698 1829 1642 1592 1764 1717 1655 1633 1804 1648 1753 1788
## 2003 1853 1629 1726 1643 1751 1867 1897 1833 1939 1967 2083 2057
## 2004 1911 1846 1998 2003 1981 1828 2002 2024 1905 2072 1782 2042
## 2005 2144 2207 1864 2061 2025 2068 2054 2095 2151 2065 2147 1994
## 2006 2273 2119 1969 1821 1942 1802 1737 1650 1720 1491 1570 1649
## 2007 1409 1480 1495 1490 1415 1448 1354 1330 1183 1264 1197 1037
## 2008 1084 1103 1005 1013 973 1046 923 844 820 777 652 560
## 2009 490 582 505 478 540 585 594 586 585 534 588 581
## 2010 614 604 636 687 583 536 546 599 594 543 545 539
## 2011 630 517 600 554 561 608 623 585 650 610 711 694
## 2012 723 704 695 753 708 757 740 754 847 915 833 976
## 2013 888 962 1010 835 930 839 880 917 850 925 1100 1002
## 2014 888 944 970 1043 1007 911 1085 984 1023 1074 1001 1073
## 2015 1085 886 960 1190 1079 1205 1146 1130 1224 1058 1172 1146
## 2016 1103 1203 1114 1158 1131 1200 1245 1155 1072 1321 1150 1267
## 2017 1206 1282 1186 1150 1123 1243 1207 1163 1174 1256 1300 1199
## 2018 1314 1288 1335 1269 1334 1190 1195 1280 1246 1207 1204 1117
## 2019 1272 1137 1203 1267 1268 1235 1212 1377 1274 1340 1371 1587
## 2020 1617 1567 1269 934 1038 1265 1487 1388 1415##########################################################Get Accuracy Multiplicative clearly performs better here. Root Mean Squared Error and MAPE are much lower in the multiplicative decomposition. I would not use this as a forecast, but rather to remove the seasonality and the trend. For forecasting, there is some periodicity. Pre-1990, 2000-2010, and post-2010 all clearly matter here, as major changes happened in the housing market through the banking system. Population growth and 30-year fixed rate would also likely matter for housing starts.
##########################################################
error1<-na.omit(dec1$random) #generate residuals without NA
error2<-na.omit(dec2$random) #generate residuals without NA
error1<-as.vector(error1) #set residuals as a vector
error2<-as.vector(error2)
datavector<-starts[1:741]
abserror1<-abs(error1)
abserror2<-abs(error2)
sqerror1<-error1^2
sqerror2<-error2^2
pererror1<-(abserror1/datavector)*100## Warning in abserror1/datavector: longer object length is not a multiple of
## shorter object lengthpererror2<-(abserror2/datavector)*100## Warning in abserror2/datavector: longer object length is not a multiple of
## shorter object length#Calculate Statisics
ME<-c(mean(error1),mean(error2))
MAD<-c(mean(abserror1), mean(abserror2))
MSE<-c(mean(sqerror1),mean(sqerror2))
RMSE<-sqrt(MSE)
MAPE<-c(mean(pererror1),mean(pererror2))
all<-cbind(ME, MAD, MSE, RMSE, MAPE)
all## ME MAD MSE RMSE MAPE
## [1,] 0.4645283 65.3836049 7615.245166 87.265372 4.74126734
## [2,] 0.9983544 0.9983544 1.000585 1.000293 0.07690848##########################################################