利用R语言简单的时间序列模型预测韩国、日本、伊朗和意大利的疫情趋势

问题：韩国、日本、伊朗和意大利的新型冠状病毒肺炎疫情是除了我国之外，目前疫情最严重的4个国家，那么之后疫情会有怎样的变化趋势？
方法：采用R语言forecast包的auto.arima函数进行预测。

1 数据采集

利用腾讯微信提供的数据。仅收集2月18日至今的数据，具体如下：

> df1
# A tibble: 13 x 5
   date                no.kor no.Jpn no.Irn no.Ita
   <dttm>               <dbl>  <dbl>  <dbl>  <dbl>
 1 2020-02-18 00:00:00     31     74      0      3
 2 2020-02-19 00:00:00     51     84      2      3
 3 2020-02-20 00:00:00    104     93      5      3
 4 2020-02-21 00:00:00    208    103     18      6
 5 2020-02-22 00:00:00    433    122     28     20
 6 2020-02-23 00:00:00    602    136     43    132
 7 2020-02-24 00:00:00    833    159     61    230
 8 2020-02-25 00:00:00    977    162     95    283
 9 2020-02-26 00:00:00   1261    178    139    374
10 2020-02-27 00:00:00   1766    207    245    528
11 2020-02-28 00:00:00   2337    233    388    655
12 2020-02-29 00:00:00   3150    241    593    888
13 2020-03-01 00:00:00   3736    256    978   1128

2 批量分析函数的编写

编写下述代码以批量分析，同时预测未来的10天数据：

library(forecast)
#select proper arima model
covpred <- function(dat) {
  yts<-ts(dat$y)
  mod.1 <- auto.arima(yts)
  tt<- forecast(mod.1,10)
  pdf <- data.frame(date = seq(as.Date("2020-03-02"), as.Date("2020-03-11"), "days"), y = tt$mean[1:10]) 
  
  return(pdf)
}
  

3 运行程序

为利用plyr包的批量分析，需要对原始数据做数据重构，过程如下：

df1a<-reshape2::melt(df1,id=1)
head(df1a)
names(df1a)[2:3]<-c('nation','y')

# 批量运行
res <- plyr::dlply(df1a,"nation",covpred) 

#预测结果转换
res1<-do.call(cbind,res)
res1a<-res1[,c(1:2,4,6,8)]
names(res1a)<-names(df1)
# 与原始数据合并
df1b<-rbind(df1,res1a)

4 结果查看

批量运行结果如下：

> names(res)
[1] "no.kor" "no.Jpn" "no.Irn" "no.Ita"
> str(res)
List of 4
 $ no.kor:'data.frame':	10 obs. of  2 variables:
  ..$ date: Date[1:10], format: "2020-03-02" "2020-03-03" ...
  ..$ y   : num [1:10] 4322 4908 5494 6080 6666 ...
 $ no.Jpn:'data.frame':	10 obs. of  2 variables:
  ..$ date: Date[1:10], format: "2020-03-02" "2020-03-03" ...
  ..$ y   : num [1:10] 271 286 302 317 332 ...
 $ no.Irn:'data.frame':	10 obs. of  2 variables:
  ..$ date: Date[1:10], format: "2020-03-02" "2020-03-03" ...
  ..$ y   : num [1:10] 1363 1748 2133 2518 2903 ...
 $ no.Ita:'data.frame':	10 obs. of  2 variables:
  ..$ date: Date[1:10], format: "2020-03-02" "2020-03-03" ...
  ..$ y   : num [1:10] 1368 1608 1848 2088 2328 ...
 - attr(*, "split_type")= chr "data.frame"
 - attr(*, "split_labels")='data.frame':	4 obs. of  1 variable:
  ..$ nation: Factor w/ 4 levels "no.kor","no.Jpn",..: 1 2 3 4
  

5 图形绘制

ggplot2绘图代码如下：

datebreaks <- seq(as.Date("2020-02-18"),as.Date("2020-03-11"),by="3 day")
fnames <- c(
  `no.kor` = "韩国",
  `no.Jpn` = "日本",
  `no.Irn` = "伊朗",
  `no.Ita` = "意大利"
)

ggplot(df1c, aes(as.Date(date), value)) + geom_line() +geom_point()+
  #scale_x_date(format = "%b%Y") + xlab("") + ylab("no.kor")
 geom_text(aes(label=ifelse(as.Date(date)>as.Date('2020-03-01'),as.character(value),'')),
           col='red',hjust=1.15,vjust=.25)+
 geom_text(aes(label=ifelse(as.Date(date)<=as.Date('2020-03-01'),as.character(value),'')),
           col='blue',size=3,vjust=1.5)+
  scale_x_date(breaks=datebreaks)+xlab('日期')+ylab('累计病例')+
  facet_wrap(~variable, scales="free", labeller = as_labeller(fnames))+
  theme(axis.text.x = element_text(angle=45,hjust=1))
  

生成的图形如下：

从图形来看，韩国和伊朗形势比较严峻，意大利也不乐观，日本总体上比较稳定，爆发的可能性不大。

说明：本文所用的方法属于简单的模型，不考虑数据隐瞒性和人为措施的干预性，因此，模型的可靠性未必高。