- 在线时间
- 514 小时
- 最后登录
- 2023-12-1
- 注册时间
- 2018-7-17
- 听众数
- 15
- 收听数
- 0
- 能力
- 0 分
- 体力
- 40100 点
- 威望
- 0 点
- 阅读权限
- 255
- 积分
- 12741
- 相册
- 0
- 日志
- 0
- 记录
- 0
- 帖子
- 1419
- 主题
- 1178
- 精华
- 0
- 分享
- 0
- 好友
- 15
TA的每日心情 | 开心 2023-7-31 10:17 |
---|
签到天数: 198 天 [LV.7]常住居民III
- 自我介绍
- 数学中国浅夏
 |
可视化实例基于R语言的全球疫情可视化
% j: `" c& H( |$ a目录
9 j% S. ^1 W* I4 K' K! b" j一、数据介绍及预处理' |: W: H' J' W) c- p8 \
二、新增确诊病例变化趋势
& H, B J$ Q. K三、新增确诊病例全球地理分布7 L5 ~3 N; R$ R! z; w) R
四、累计确诊病例动态变化图
1 b" I3 A" y" e9 }# s; S& V+ s( S7 I" P一、数据介绍及预处理& B( X' ^% L8 W6 u3 `) F& i6 ?3 U
1. 基本字段介绍
|) ]$ @% u3 ^0 i L3 `0 r1 f/ s! \' V! S, [0 B- O/ ^
字段名 含义, @$ l h( L$ j R5 h
Province/State 省/州 `; ~# P% e9 Q" N! J2 A4 D
Country/Region 国家/地区
# Y3 @, j, e3 P4 }: W. gLat 纬度
" O" {) h: M2 e3 f7 GLong 经度) W9 S3 k2 {% ?5 w0 L
1/22/20-12/7/20 每日累计确诊病例
' G, o3 j: A3 }* Z( ^6 l. a
7 R9 o5 _3 m4 x( h4 m) j ( x1 ^* b6 d- u
6 i- a1 f( d. W$ o2. 数据预处理 - 整理某些国家的名称,如Korea, South改为 Korea
- 将日期列字段修改为相应的日期格式
- [color=rgba(0, 0, 0, 0.749019607843137)]#加载本次可视化所需包[color=rgba(0, 0, 0, 0.749019607843137)]library(readr) [color=rgba(0, 0, 0, 0.749019607843137)]library(sp) #地图可视化[color=rgba(0, 0, 0, 0.749019607843137)]library(maps) #地图可视化[color=rgba(0, 0, 0, 0.749019607843137)]library(forcats)[color=rgba(0, 0, 0, 0.749019607843137)]library(dplyr)[color=rgba(0, 0, 0, 0.749019607843137)]library(ggplot2)[color=rgba(0, 0, 0, 0.749019607843137)]library(reshape2) [color=rgba(0, 0, 0, 0.749019607843137)]library(ggthemes) #ggplot绘图样式包[color=rgba(0, 0, 0, 0.749019607843137)]library(tidyr)[color=rgba(0, 0, 0, 0.749019607843137)]library(gganimate) #动态图[color=rgba(0, 0, 0, 0.749019607843137)]
/ j0 M6 Q k @/ W[color=rgba(0, 0, 0, 0.749019607843137)]#一、国家名词整理[color=rgba(0, 0, 0, 0.749019607843137)]data<-read_csv('confirmed.csv')[color=rgba(0, 0, 0, 0.749019607843137)]data[data$`Country/Region`=='US',]$`Country/Region`='United States'[color=rgba(0, 0, 0, 0.749019607843137)]data[data$`Country/Region`=='Korea, South',]$`Country/Region`='Korea'[color=rgba(0, 0, 0, 0.749019607843137)]
8 w J$ Q$ u9 c[color=rgba(0, 0, 0, 0.749019607843137)]information_data<-data[,1:4] #取出国家信息相关数据[color=rgba(0, 0, 0, 0.749019607843137)]inspect_data<-data[,-c(1:4)] #取出确诊人数相关数据[color=rgba(0, 0, 0, 0.749019607843137)]6 W4 w0 L! a% z* P- c4 [
[color=rgba(0, 0, 0, 0.749019607843137)]#二、日期转换[color=rgba(0, 0, 0, 0.749019607843137)]datetime<-colnames(inspect_data)[color=rgba(0, 0, 0, 0.749019607843137)]pastetime<-function(x){[color=rgba(0, 0, 0, 0.749019607843137)] date<-paste0(x,'20')[color=rgba(0, 0, 0, 0.749019607843137)] return(date)[color=rgba(0, 0, 0, 0.749019607843137)]}[color=rgba(0, 0, 0, 0.749019607843137)]datetime1<-as.Date(sapply(datetime,pastetime),format='%m/%d/%Y')[color=rgba(0, 0, 0, 0.749019607843137)]colnames(inspect_data)<-datetime1[color=rgba(0, 0, 0, 0.749019607843137)]
, S. o/ Q$ u6 h3 L[color=rgba(0, 0, 0, 0.749019607843137)]#合并数据,data为累计确诊人数数据(预处理后)[color=rgba(0, 0, 0, 0.749019607843137)]data<-cbind(information_data,inspect_data)[color=rgba(0, 0, 0, 0.749019607843137)]二、新增确诊病例变化趋势#由累计确诊病例计算新增确诊病例
' W; g$ Y# f5 ginspect_lag_data<-cbind(0,inspect_data[,1 ncol(inspect_data)-1)])" X$ }5 l; ~0 n
increase_data<-inspect_data-inspect_lag_data9 Z, W- X7 F4 Q) Y
4 ~6 X- g: _. @8 q0 U#合并数据,new_data为新增确诊人数数据
L+ r# L: F7 G; N% qnew_data<-cbind(information_data,increase_data)- O, X7 T4 h7 _2 u
1 D6 ?% s. ?4 a. Q8 B4 i# _# A% }
1. 中国新增确诊病例变化趋势# J3 V1 m) E8 @& }, M+ k/ F
#合并所有省份新增确诊人数
0 G3 V; r" b! m+ _0 n5 bchina<-new_data[new_data$`Country/Region`=='China',]. p/ s: o: E$ a, ]+ o5 N
china_increase<-data.frame(apply(china[,-c(1:4)],2,sum))5 d& H! W; m: f' { q3 I! S l/ K2 ~
colnames(china_increase)<-'increase_patient'' `; d. ?2 M1 g8 V0 `8 N n9 s( ~
china_increase$date<-as.Date(rownames(china_increase),format="%Y-%m-%d")" E9 q# C. P5 f: Z5 U
V2 J& K1 `& K' G# C0 oggplot(china_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+6 k z! L' e) e& m
scale_x_date(date_breaks = "14 days")+ #设置横轴日期间隔为14天(注意:此时的date列必须为日期格式!)& u+ j; M. P/ n1 Y+ u. Y
labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日中国新增确诊人数变化趋势图')+0 P+ ^! n$ O2 N+ S
theme_economist()+ #使用经济学人绘图样(式ggthemes包)
m1 \6 e4 a- S7 L$ k theme(plot.title = element_text(face="plain",size=15,hjust=0.5),. ]5 u/ Z* t, ?+ I# d
axis.title.x = element_blank(),
) {8 b3 v) b' P' W% _/ u1 |6 T axis.title.y = element_text(size=15),
& P( Y3 U' H2 \" w; d1 w axis.text.x = element_text(angle = 90,size=15),
$ O8 ?4 e8 X, |$ a* U1 r% r* O axis.text.y = element_text(size=15),% x' J& j. N& X
legend.title=element_blank(),
+ n# F/ X& T; o0 O5 o( L- F legend.text=element_text(size=15))
* g! E" [2 b+ C) W1 [6 G; }" o& B" G% |/ j" ^) H9 i8 ] T2 v0 n
9 t* f" d/ e8 z9 ~1 v0 z
2. 美国新增病例变化趋势5 S7 d! T5 u3 } \+ {7 u: j
us<-new_data[new_data$`Country/Region`=='United States',]
0 r# a5 l) P1 S8 r% S; tus_increase<-gather(us,key="date",value="increase_patient",'2020-01-22':'2020-12-07')1 z8 T2 V: X: J0 K3 Q
us_increase$date<-as.Date(us_increase$date)
% F4 T5 @$ u! f9 t9 Zggplot(us_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+( A1 r1 t5 A7 K, O
scale_x_date(date_breaks = "14 days")+ #设置横轴日期间隔为14天/ c E1 [$ Q) q" O9 }
labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日美国新增确诊人数变化趋势图')+9 [; T, }$ J3 j: F1 ?- a. L
theme_economist()+ #使用经济学人绘图样(式ggthemes包)
4 |1 C" B. H M1 A4 r5 c theme(plot.title = element_text(face="plain",size=15,hjust=0.5),
, U8 n ?; k+ b f( s5 D# O. o axis.title.x = element_blank(),
H+ D: o2 c6 w# ?3 v# }, M axis.title.y = element_text(size=15),
$ R4 l6 d f) L/ [: Z axis.text.x = element_text(angle = 90,size=15),; b t; A8 H. ?7 w( z/ f8 O0 J* d
axis.text.y = element_text(size=15)," }$ G# Y" H; R% p& v7 |
legend.title=element_blank(),
r5 e4 `: d5 J" ^* W legend.text=element_text(size=15))
H' [# T( y0 P; I3 M
# M# T8 B) ~* q" [8 f3 E , D% f& v' v, {% t2 Q
3. 全球新增病例变化趋势6 R3 a2 H: l" q9 E4 o" ]
total_increase<-data.frame(apply(new_data[,-c(1:4)],2,sum))
3 z3 h+ L* ]* kcolnames(total_increase)<-'increase_patient'
1 s- j' i& e; j. J! Y+ {total_increase$date<-as.Date(rownames(total_increase),format="%Y-%m-%d")
- {8 t2 C0 }# g4 B! r- M* j" ~ggplot(total_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+
0 B. [5 x$ ]+ [" V" L scale_x_date(date_breaks = "14 days")+2 p' g9 C& Y" Q, l9 l# z$ D1 l0 I
labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日全球新增确诊人数变化趋势图')+
& d6 ?* w) ~9 E2 ` theme_economist()+, T: {. n- \. c1 L$ V! p
scale_y_continuous(limits=c(0,8*10^5), #考虑数字过大,以文本形式标注y轴标签1 Y7 B5 k- S- {# a! s
breaks=c(0,2*10^5,4*10^5,6*10^5,8*10^5),7 i& h+ a1 Z: s3 n. V
labels=c("0","20万","40万","60万","80万"))+" {: h9 L# R- @" Y3 s. E2 `
theme(plot.title = element_text(face="plain",size=15,hjust=0.5),. G: U% W. C6 {3 U' L
axis.title.x = element_blank(),! w( r& b% U6 j# [. n5 ]9 P( r; z
axis.title.y = element_text(size=15),& E1 T }8 n' a( X( \1 C) h$ h3 Y# M
axis.text.x = element_text(angle = 90,size=15),
! A3 T5 q+ d0 m5 A* y$ z axis.text.y = element_text(size=15),
1 P$ l( C) y+ @; z3 k. C3 x legend.title=element_blank(),
c7 B+ O( V' z" B% q/ B6 {1 Z z6 A legend.text=element_text(size=15))8 S! ?' K1 x1 _( f+ S
; p) Y+ s6 u9 N+ I
![]()
; b# n3 P6 ^ T5 J7 J. I- ?三、新增确诊病例全球地理分布
4 J4 Z: B) ?" J0 [" b/ N; mmapworld<-borders("world",colour = "gray50",fill="white") $ e- n% j# ]3 D2 `2 f
ggplot()+mapworld+ylim(-60,90)+
5 B) ^/ O! \# g" X( R geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-01-22`),color="darkorange")+
( W4 G! a1 P% ?7 }) r1 k scale_size(range=c(2,9))+labs(title="2020年1月22日全球新增确诊人数分布")+" p$ ]7 j) K- b4 n: [
theme_grey(base_size = 15)+* \; p- H: Q+ X" M& ?7 g
theme(plot.title=element_text(face="plain",size=15,hjust=0.5),7 ]/ z; B3 p6 Y- |- y
legend.title=element_blank())' h9 X1 `$ t6 {+ _3 G
4 }3 E$ X! D* z
ggplot()+mapworld+ylim(-60,90)+* q8 T: U) O0 m" s8 l) m% \& K
geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-11-22`),color="darkorange")+2 R8 v! |4 y$ M5 ]* ]: Q5 m+ M3 M
scale_size(range=c(2,9))+labs(title="2020年11月22日全球新增确诊人数分布")+
$ i/ Z5 A: t5 c: m4 t7 ?9 h& U% ^ theme_grey(base_size = 15)+
# T. T; }+ i2 [) T! @ theme(plot.title=element_text(face="plain",size=15,hjust=0.5),7 B7 k5 a& o3 m' _7 X) l! v2 m
legend.title=element_blank()): o3 i' F! D+ h
# \% j$ [9 F) Z' P+ T ^0 N# d* ?![]() 9 J" T: ]" ^3 U$ S- O- j
四、累计确诊病例动态变化图1. 至12月7日全球累计病例确诊人数前十国家
! Z+ B6 T# ?2 }2 F6 ocum_patient<-data[c("Country/Region","2020-12-07")] cum_patient<-cum_patient[order(cum_patient$`2020-12-07`,decreasing = TRUE),][1:10,] colnames(cum_patient)<-c("country","count") cum_patient<-mutate(cum_patient,country = fct_reorder(country, count)) cum_patient$labels<-paste0(as.character(round(cum_patient$count/10^4,0)),"万") ggplot(cum_patient,aes(x=country,y=count))+ geom_bar(stat = "identity", width = 0.75,fill="#f68060")+ coord_flip()+ #横向 xlab("")+ geom_text(aes(label = labels, vjust = 0.5, hjust = -0.15))+ labs(title='至2020年12月7日累计确诊病例前十的国家')+ theme(plot.title = element_text(face="plain",size=15,hjust=0.5))+ scale_y_continuous(limits=c(0, 1.8*10^7)) 4 F+ i: ]% r. ?7 I6 e. k2 |
2. 五国(India、Brazil、Russia、Spain、Italy)累计确诊病例动态变化图3 U- {- n6 ~+ z/ P7 \/ n
cum_patient_time<-gather(data,key="date",value="increase_patient",'2020-01-22':'2020-12-07')
+ z& y7 u. m6 r" rcolnames(cum_patient_time)<-c(" rovince","Country","Lat","Long","date","increase_patient")
( W/ O9 d# d7 h$ T; a; ?- B" `five_country<-subset(cum_patient_time,Country %in% c("India","Brazil","Russia","Spain","Italy"))7 |. Q4 i7 s: N' H( t8 ]
five_country$date<-as.Date(five_country$date); T* g1 o" P6 |( f$ X! F" r
7 [/ M% T; s* c" l( G$ Fggplot(five_country, & `, f# k# N( O3 }6 Q- M
aes(x=reorder(Country,increase_patient),y=increase_patient, fill=Country,frame=date)) + * b/ c! w# E- M
geom_bar(stat= 'identity', position = 'dodge',show.legend = FALSE) + / f* \' E7 E3 Q c$ E+ y
geom_text(aes(label=paste0(increase_patient)),col="black",hjust=-0.2)+
8 @9 n: T9 ^9 ?* s scale_fill_brewer(palette='Set3')+ #使用Set3色系模板3 ~8 T. x9 v2 Q% _( O& T3 [
theme(legend.position="none",5 I5 a0 n5 `3 l
panel.background=element_rect(fill='transparent'),
& @% X9 ^ q3 y axis.text.y=element_text(angle=0,colour="black",size=12,hjust=1),
/ x8 Y- R, N8 w4 n; C/ m- V1 X9 Z panel.grid =element_blank(), #删除网格线
" X ^( `% N7 ]6 _1 q. B axis.text = element_blank(), #删除刻度标签
! H1 }: v. m, l/ H2 A axis.ticks = element_blank(), #删除刻度线
4 Q0 {! S& O, l* y )+
6 ~8 D; z7 R) H3 E R coord_flip()+
! }2 i& g; ~* o3 c transition_manual(frames=date) + #动态呈现
6 k- R, q2 m" f. `/ V- x% G3 P labs(title = paste('日期:', '{current_frame}'),x = '', y ='五国累计确诊病例增长')+
7 W) c) A( J2 L# {* G: T4 J/ g theme(axis.title.x = element_text(size=15))+1 ^& R3 p7 H! _- i
ease_aes('linear')
# f6 s! {5 t S8 T* U' Y! I
2 K$ \4 s& g8 e9 ]anim_save(filename = "五国累计确诊病例增长动态图.gif")
# ^& [" B! D- z. E! q
* l/ ] Z; I( [" ?; ~6 z3 H![]()
. }* P3 g* D- V& }, C. {; e8 ?- m# s( {0 T
! D7 r V. p! E- W
) q* h- C! O) T6 _9 U' ~ |
zan
|