R语言对COVID19分析作业

#a.数据获取与基本统计分析
#安装并引入COVID19包
##install.packages(“COVID19”)
library(COVID19)

#提取截止至2020年5月31号数据
library(dplyr)
library(lubridate)

rawdata <- data.frame(covid19())
df <- filter(rawdata,month(date)<6)
df <- filter(df,confirmed>1000)
#对国家分组求出确诊人数最大值
group<- df %>% group_by(id)
rank_country <- summarise(group,
max_confirmed=max(confirmed)
)
#按照确诊人数进行排序,rank_country为i的output
rank_country <- arrange(rank_country,desc(max_confirmed))

#计算各个国家的日新增
new <- mutate(rawdata,
lag_1=dplyr::lag(confirmed)
)
new <- mutate(new,
diff_1=confirmed-lag_1)
new <- filter(new,month(date)<6)
new <- filter(new,confirmed>1000)
new <- mutate(new,
day_after=rank(date)
)
new<- new %>% group_by(id)
#计算各个国家最大日新增(max_diff)以及所对应的日期(max_date),max_increase为ii的output
max_increase <- summarise(new,
max_diff=max(diff_1,na.rm = FALSE),
max_date=new[which.max(diff_1),“date”])

#选取有二级单位的国家
unique(rawdata$administrative_area_level_2) #数据集中并未包含二级单位地区
area_level2 <- new[!is.na(new$administrative_area_level_2),] #二级单位地区一列(administrative_area_level_2)为空
#即iiioutput 为空

#b.各国确诊人数时间累计图
library(ggplot2)
library(reshape2)
#提取确诊超过3000的国家数量为78
df2 <- filter(rawdata,month(date)<6)
df2 <- filter(df,confirmed>3000)
country_over_3000 <- unique(df2$id)
length(country_over_?000)
#plot_data为国家为列名,day_after到达1000例后的天数,值为确诊数。
plot_data <- select(new,id,confirmed,day_after)
plot_data <- dcast(plot_data,day_after~id,value.var = “confirmed”)

b <- new[which(new$id %in% country_over_3000),]
#将国家作为因子进行画???
a <- select(b,id,confirmed,day_after)
p <- ggplot(b, aes(x = day_after, y = confirmed , colour = factor(id)))
p + geom_line()

#从上图可知USA确认人数过多,不方便查看,现在剔除USA,画出P2
c <- b[which(!(b$id %in% “USA”)),]
p2 <- ggplot(c, aes(x = day_afte?, y = confirmed , colour = factor(id)))
p2 + geom_line()

###自主分析部分
#c.数据的图形展示
#c-1对截止至2020年5月31日,对美国的确诊,治愈,死亡人数进行绘图泡p3
plot_data2 <- rawdata[which((rawdata$id %in% “USA”)),][,c(2,4:6)]
plot_data2 <- melt(data=plot_?ata2,id.vars=“date”)
p3 <- ggplot(plot_data2,aes(x=date,y=value,colour=factor(variable)))
p3 + geom_line()+labs(tittle=“USA CONDITION”,x=“TIME”,y=“AMOUNT”)
#p3展现了美国确诊,治愈,死亡随时间变化的增长趋势,可以看出确诊人数暂无下降势头,
#同时确诊人数曲线,康复人数曲线,说明由于医疗环境,人员配合等原因,治疗水平较低。

#c-2#c-1对截止至2020年5月31日,对韩国,日本,新加坡三个重点亚洲国际的确诊,治愈,死亡人数进行绘图对比p4
asian_3=c(“JPN”,“KOR”,“SGP”)
plot_data3 <- summarise(group,
max_c?nfirmed=max(confirmed),
max_recover=max(recovered),
max_deaths=max(deaths)
)

plot_data3 <- plot_data3[which(plot_data3$id %in% asian_3),]
plot_data3 <- melt(data=plot_data3,id.vars=“i?”)
col <- c(‘red’,‘green’,‘black’)
p4 <- ggplot(data = plot_data3, mapping =aes(x =id , y = value, fill = factor(variable)))
p4+ geom_bar(stat = ‘identity’, colour= ‘black’, position = ‘dodge’)+scale_fill_manual(values = col, limits=c(“max_confirmed”,“max?recover”,“max_deaths”))+labs(x=“COUNTRY”,y=“AMOUNT”)
#P4展现了韩国,日本,新加坡的确诊,治愈,死亡人数,此图可以直观的对比各国的不同
##相比与JPN与KOR,SPG有更高的确诊人数,却有极低的死亡人数,但治愈人数却远低于确诊人数,说明SPG的医疗水平有限。
##反观JPN与KOR将存量患病人数(确诊-治愈-死亡)保持在很低的水平上,有助于疫情防控。

#d.数据的统计检验
#检验死亡人数与确诊人数是否存在线性关系(只考虑截止至2020年5月31号,确诊人数大于1000的国家)
#计算各个国家确诊人数,死亡人数
tem <- summarise(group,
max_confirmed=max(confirmed),
population=mean(population),
max_deaths=max(deaths)
)
#cor.test()函数进行相关性系数的计算和检验,使用pearson相关性检验
cor.test(tem$max_confirmed,tem$max_deaths,method = “pearson”) #检验结果p<0.05,存在相关性
#单因素方差分析,结果里面还有t值,以及两个P值,P值越小,回归效果越显著.
#倒数第二行R-squared数字越接近于1,回归效果越好。
lm_rel <- lm(max_deaths~max_confirmed,data = tem)
summary(lm_rel)

#var.test()方差检验,检验双样本方差,p值很小
var.test(tem$max_confirmed,tem$max_deaths)

#e.最近7日或7日以上新增确诊为0,判定为疫情得到有效控制
tem2 <- mutate(rawdata,
lag_1=dplyr::lag(confirmed)
)
tem2<- tem2 %>% group_by(id)
tem2 <- mutate(tem2,
diff_1=confirmed-lag_1,
? max_confirm= max(confirmed))
tem3 <- tem2[which(tem2$confirmed==tem2$max_confirm),]
#计算连续0增长天数,保留连续0增长天数大于等于7的国家
tem3<- tem3 %>% group_by(id)
country_list <- summarise(tem3,
count=n()
)
country_list <- country_list[which(country_lis\t$count>=7),]
#回推计算0新增开始日期,得到country_list,列date为起始时间
country_list$date <- Sys.Date()-country_list$count

  • 0
    点赞
  • 34
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值