Load Required Libraries
library(httr)
library(dplyr)
library(jsonlite)
library(ggplot2)
library(bsts)
Import Data From API
payload <- list(code = "ALL")
response <- httr::POST(url = "https://api.statworx.com/covid",
body = toJSON(payload, auto_unbox = TRUE), encode = "json")
Prepare Data for Modeling
content <- rawToChar(response$content)
df <- data.frame(fromJSON(content))
df.us = subset(df, df$code == 'US')
data = df.us[,-c(2,3,4,7,8)]
data[,1] = as.Date(data[,1])
data = xts(data[,-1], order.by = data[,1])
storage.mode(data) <- "numeric"
str(data)
## An 'xts' object on 2019-12-31/2020-06-29 containing:
## Data: num [1:182, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:6] "cases" "deaths" "population" "continent" ...
## Indexed by objects of class: [Date] TZ: UTC
## xts Attributes:
## NULL
Set Parameters for Modeling
ss.1 = AddSemilocalLinearTrend(list(), y = data$cases)
ss.1 = AddTrig(ss.1, period = 12, frequencies = 1:3, y = data$cases)
niter = 100
burn = niter/2
Train Model and Capture Summary
model = bsts(data$cases,
state.specification = c(ss.1),
niter = niter)
## =-=-=-=-= Iteration 0 Mon Jun 29 14:42:49 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 10 Mon Jun 29 14:42:49 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 20 Mon Jun 29 14:42:49 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 30 Mon Jun 29 14:42:49 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 40 Mon Jun 29 14:42:49 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 50 Mon Jun 29 14:42:50 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 60 Mon Jun 29 14:42:50 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 70 Mon Jun 29 14:42:51 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 80 Mon Jun 29 14:42:51 2020
## =-=-=-=-=
## =-=-=-=-= Iteration 90 Mon Jun 29 14:42:51 2020
## =-=-=-=-=
print(summary(model, burn = burn))
## $residual.sd
## [1] 1099.253
##
## $prediction.sd
## [1] 3662.021
##
## $rsquare
## [1] 0.9934583
##
## $relative.gof
## [1] 0.1448755
Forecast Using Trained Model
horizon = 100
original = horizon
pred = predict(model, horizon = horizon, quantiles = c(.05, .95))
Plot Forecast
plot(pred, plot.original = original, style = c("boxplot"), main = "COVID-19 US Cases Forecast")
Capture Forecast Results
print(pred$mean)
## [1] 42024.25 43632.58 42872.68 44726.26 41943.24 42783.42 43826.62 45415.82
## [9] 47264.00 46801.63 47259.49 46556.06 48551.95 47874.26 49779.44 50856.45
## [17] 49237.39 48492.62 49550.85 50776.27 52241.67 51103.25 51785.07 52476.90
## [25] 51389.32 53748.91 54166.83 53086.49 51598.04 53545.67 53871.30 57297.71
## [33] 57461.02 56853.29 56274.27 55778.95 57317.43 58727.86 58599.97 61146.39
## [41] 57760.59 58878.79 60802.77 63584.88 62688.87 62178.85 62028.08 62193.92
## [49] 62555.93 63154.96 65383.78 65923.84 63581.01 63839.75 65287.12 67964.01
## [57] 68363.11 68483.11 67273.20 68060.88 69011.98 69634.51 70288.91 70527.93
## [65] 68910.88 69150.06 69230.91 70468.96 70409.89 69353.93 70213.28 69788.48
## [73] 70988.41 71430.23 72866.44 72046.18 70541.57 72263.97 72775.30 74727.41
## [81] 76093.35 73993.32 74828.68 73293.99 76333.03 75548.97 77338.54 76850.97
## [89] 75933.20 76292.08 80098.56 81790.25 81405.66 80006.82 80956.79 81014.41
## [97] 80914.34 82736.55 83477.81 82624.92
print(pred$median)
## [1] 40936.12 43361.72 42870.86 44142.87 41168.86 43257.72 44072.41 46396.23
## [9] 48091.31 44109.47 44749.42 47884.19 48405.54 48508.49 52798.40 51228.34
## [17] 49348.52 49698.73 47474.36 49400.89 53039.97 46417.02 50383.31 51781.39
## [25] 52532.32 54347.22 57132.09 53901.58 52901.28 53104.59 54037.70 56289.54
## [33] 57971.90 56176.06 56452.65 54728.46 54819.03 60126.61 62835.10 63743.90
## [41] 59116.01 60483.18 61769.55 64824.76 63810.38 60803.49 63060.78 60799.35
## [49] 59536.99 59216.24 59147.90 58429.01 63909.96 55167.10 63379.07 67907.76
## [57] 70618.10 65870.66 68940.84 66384.28 73205.38 73432.40 74639.40 72982.41
## [65] 74000.46 75454.06 74171.69 72566.35 72812.05 74662.66 68963.47 71381.05
## [73] 64100.70 63386.60 66591.92 63420.45 63447.62 63117.40 64180.08 67185.65
## [81] 75035.88 70027.12 71033.31 68932.08 73664.86 69713.79 72746.15 72330.27
## [89] 72299.46 71402.85 75828.37 77028.48 78355.98 77921.76 77033.09 78262.12
## [97] 80342.62 82580.93 75735.86 78156.75
print(pred$interval)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## 5% 38404.58 37065.24 35902.22 37815.09 33561.87 34201.37 34234.56 35443.58
## 95% 47745.41 50681.60 51628.75 54350.19 53372.43 52355.09 51572.53 55911.84
## [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16]
## 5% 31365.88 34535.85 37278.40 32738.16 36253.85 33035.94 31601.47 33377.89
## 95% 60813.72 60085.85 60407.56 62266.82 63442.20 61296.88 64870.89 67237.39
## [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
## 5% 29446.04 30591.75 33003.19 32404.06 34623.47 38387.28 36243.57 40014.42
## 95% 71196.67 65549.22 69526.90 67799.56 73253.84 68235.16 68936.79 67437.03
## [,25] [,26] [,27] [,28] [,29] [,30] [,31] [,32]
## 5% 34999.23 38905.98 32554.29 36133.49 33423.93 37029.56 36389.07 37808.91
## 95% 67140.58 71184.24 72908.07 69869.90 66678.05 71794.45 71505.04 72684.15
## [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40]
## 5% 38096.60 39006.27 32872.63 35296.82 36430.95 35441.78 36564.77 37548.74
## 95% 77079.62 75969.29 75103.88 76392.94 78270.36 77031.67 76245.64 81445.53
## [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48]
## 5% 35118.31 35201.05 35992.25 37307.67 33744.70 32400.59 33149.59 33984.35
## 95% 77816.85 80933.18 84551.50 87442.26 87682.92 86220.18 87524.02 87414.20
## [,49] [,50] [,51] [,52] [,53] [,54] [,55] [,56]
## 5% 35992.28 39845.22 41297.83 42592.04 39749.18 42652.92 43409.69 45211.8
## 95% 88871.96 88840.17 90457.72 88936.48 84498.45 86408.13 91008.70 91564.6
## [,57] [,58] [,59] [,60] [,61] [,62] [,63] [,64]
## 5% 45969.29 45643.81 41753.28 45926.46 45355.99 47564.41 49074.42 45966.42
## 95% 90225.34 98247.43 94587.32 94626.76 100297.57 99068.46 97049.93 99813.83
## [,65] [,66] [,67] [,68] [,69] [,70] [,71] [,72]
## 5% 43744.44 41151.14 41890.44 38880.32 40297.68 39655.6 44545.39 39768.01
## 95% 98697.23 98921.18 99087.62 104059.24 107209.95 102772.1 101234.74 104943.59
## [,73] [,74] [,75] [,76] [,77] [,78] [,79]
## 5% 41612.92 39876.8 40549.29 39309.51 37459.22 36608.15 41480.65
## 95% 109940.75 110289.0 112891.24 115622.06 108543.92 118006.54 112983.40
## [,80] [,81] [,82] [,83] [,84] [,85] [,86]
## 5% 41064.65 43541.75 33721.59 39829.12 32121.32 38468.51 38992.25
## 95% 119329.75 121761.51 121141.24 119639.58 118947.91 121845.15 120096.52
## [,87] [,88] [,89] [,90] [,91] [,92] [,93]
## 5% 40626.87 40724.06 41344.25 41568.93 43444.76 46062.63 43456.68
## 95% 124839.43 121828.04 121448.59 121080.36 127839.54 128356.59 131187.00
## [,94] [,95] [,96] [,97] [,98] [,99] [,100]
## 5% 44424.67 45310.24 44121.91 48757.52 44916.18 46289.46 44911.09
## 95% 129332.80 129921.94 133279.32 133194.64 135099.35 140943.10 136893.33