- 在线时间
- 514 小时
- 最后登录
- 2023-12-1
- 注册时间
- 2018-7-17
- 听众数
- 15
- 收听数
- 0
- 能力
- 0 分
- 体力
- 40294 点
- 威望
- 0 点
- 阅读权限
- 255
- 积分
- 12799
- 相册
- 0
- 日志
- 0
- 记录
- 0
- 帖子
- 1419
- 主题
- 1178
- 精华
- 0
- 分享
- 0
- 好友
- 15
TA的每日心情 | 开心 2023-7-31 10:17 |
|---|
签到天数: 198 天 [LV.7]常住居民III
- 自我介绍
- 数学中国浅夏
 |
可视化实例基于R语言的全球疫情可视化' R, q, l' b7 h0 i l
目录' N& W' y, n! s' q0 ?0 s, @- b
一、数据介绍及预处理8 g9 l0 }, @. Z5 n+ P0 U( m
二、新增确诊病例变化趋势
) i/ q! G7 A8 {8 }9 a: Q6 {: n% `三、新增确诊病例全球地理分布% P8 B5 P8 C* u
四、累计确诊病例动态变化图0 K. S J% ?; s) N5 X$ u7 P+ m
一、数据介绍及预处理$ G) S* ~& ^1 ^3 b7 l* `, P) t6 p
1. 基本字段介绍- }& D& c; ^8 V3 e) u
% q3 A. S/ E; o( i' E: e
字段名 含义
) \, v- X+ E- @1 T6 l, l' UProvince/State 省/州
7 b/ A7 t8 u. f# Q! h. `Country/Region 国家/地区
+ k3 I- H& s) Y2 g, K% P' X% y! FLat 纬度3 B: H7 I$ B% M: [1 [) w: C
Long 经度
B9 I/ Q! f/ g' ^0 L0 K6 U1/22/20-12/7/20 每日累计确诊病例
) w3 u4 s+ g5 A, \- y% V2 f) E: Z+ b. _% j0 ?! W
% Y) h2 Z# s, _! i H; m7 e
5 d. h* K$ k3 E2 d; e/ x2 O( D
2. 数据预处理 - 整理某些国家的名称,如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)]( U- {! V% I" @: ^1 X2 D
[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)]( f N3 L- m' U ?* M' d
[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)]
4 K1 ~# k9 G5 e- n5 D( G[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)]
: n: u3 S) P2 _[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)]二、新增确诊病例变化趋势#由累计确诊病例计算新增确诊病例
( e2 I( T# c# C: T, J4 f2 u, p5 Cinspect_lag_data<-cbind(0,inspect_data[,1 ncol(inspect_data)-1)])$ _& V7 v& H; o$ p; ~$ }
increase_data<-inspect_data-inspect_lag_data
3 p2 ]. F# K/ {& P" w3 X. f) m6 f1 _3 `: ~* ~
#合并数据,new_data为新增确诊人数数据' T* Q# N- X9 N1 F# m
new_data<-cbind(information_data,increase_data)
' a- N& m" R) q, W: j" P6 a% c- X; S3 E
1. 中国新增确诊病例变化趋势, u0 ~, V/ O; I0 f7 i
#合并所有省份新增确诊人数8 @0 X- P; _& K" r3 [6 g
china<-new_data[new_data$`Country/Region`=='China',]
) d7 E/ D) m( {& X& B' D8 Zchina_increase<-data.frame(apply(china[,-c(1:4)],2,sum))0 `) n" b1 S' K* C7 x1 d) p
colnames(china_increase)<-'increase_patient'7 |, ~9 T: b8 E R
china_increase$date<-as.Date(rownames(china_increase),format="%Y-%m-%d")$ a. a' t) _+ `
3 h4 j% O% A- b. @3 hggplot(china_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+
, h# \9 v) U7 @- C" W: n scale_x_date(date_breaks = "14 days")+ #设置横轴日期间隔为14天(注意:此时的date列必须为日期格式!)
. D4 Y1 e' Q+ b# C( V2 d. Q labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日中国新增确诊人数变化趋势图')+
; b$ u6 Y) y# } i* n theme_economist()+ #使用经济学人绘图样(式ggthemes包)
/ ^0 [! [) H v3 A1 q$ E* W3 H theme(plot.title = element_text(face="plain",size=15,hjust=0.5),
! U+ s3 ^. E G$ b" `) M/ j; Q axis.title.x = element_blank(),0 D0 n/ K" q. ]5 c2 o. @ G3 G* x
axis.title.y = element_text(size=15),
% @+ ~$ i, [" Q# \8 e0 m axis.text.x = element_text(angle = 90,size=15),
, P2 i m* q$ H- [* P axis.text.y = element_text(size=15),
; p- {4 S, u; Z) P* s2 ~- ` legend.title=element_blank(),
0 _$ q; a% y4 a legend.text=element_text(size=15))
) g# P$ \$ r% d6 n6 ~1 y
) H3 C/ h. y9 e( ]9 T) p8 C7 Z 5 w7 @+ v; Z9 o) a
2. 美国新增病例变化趋势! K0 N' P! |6 B7 `+ h
us<-new_data[new_data$`Country/Region`=='United States',]+ ^1 l3 P8 a. W( Q6 k) Q
us_increase<-gather(us,key="date",value="increase_patient",'2020-01-22':'2020-12-07')
: E& ]1 }+ ? ^& _" _8 w" e. Hus_increase$date<-as.Date(us_increase$date)
2 x/ B h- ]3 Q8 X/ m0 Zggplot(us_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+
# {4 q E: J8 k# A/ V9 ? scale_x_date(date_breaks = "14 days")+ #设置横轴日期间隔为14天
! y8 k; i S% k0 \; ?% F1 U labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日美国新增确诊人数变化趋势图')+6 n! ]+ s8 z: \6 g: R8 A$ V
theme_economist()+ #使用经济学人绘图样(式ggthemes包)
" a: ?: w: s8 s0 Q+ y2 @7 m theme(plot.title = element_text(face="plain",size=15,hjust=0.5),
' J5 Y; m0 @2 M% C' j! x axis.title.x = element_blank(),$ i1 B* L2 {% Z; a# W# y
axis.title.y = element_text(size=15),
$ d/ w1 Z3 I" X/ B axis.text.x = element_text(angle = 90,size=15),
& k- {9 U, F9 y0 y: N axis.text.y = element_text(size=15),
# I- F3 p9 S( V% Z& v legend.title=element_blank(),
) Q- r/ a4 m0 n legend.text=element_text(size=15))
. q1 J& V9 ]7 K6 c7 f7 h) g: `) g3 M ^# r- K) L5 K
+ a8 K* ` w# G& B. r4 j3 t5 I
3. 全球新增病例变化趋势
2 k; v. y$ q/ ?9 i0 M5 ototal_increase<-data.frame(apply(new_data[,-c(1:4)],2,sum))
6 y* {9 M" U) h* q1 g6 qcolnames(total_increase)<-'increase_patient'
) _7 k }" J3 ?2 S8 qtotal_increase$date<-as.Date(rownames(total_increase),format="%Y-%m-%d"); e J, y* a& l
ggplot(total_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+' p# v& ~' u& s
scale_x_date(date_breaks = "14 days")+
+ s' E: `# x& o7 @" A labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日全球新增确诊人数变化趋势图')+
5 R& P$ E) s* b; s$ F# N+ D6 T theme_economist()+
: Q" [, u5 g9 T- M4 x: D scale_y_continuous(limits=c(0,8*10^5), #考虑数字过大,以文本形式标注y轴标签
8 Y, e7 A, y7 V* g: r breaks=c(0,2*10^5,4*10^5,6*10^5,8*10^5),. j+ Z" E6 }3 l; L1 ~
labels=c("0","20万","40万","60万","80万"))+. R& t4 N1 J* `( E% k
theme(plot.title = element_text(face="plain",size=15,hjust=0.5),
# {* S; |; X# b- k axis.title.x = element_blank(),& N1 G1 _* w4 z% h& ?
axis.title.y = element_text(size=15),
+ s; M5 [) C9 Q axis.text.x = element_text(angle = 90,size=15), j$ b/ g d: q/ V: L
axis.text.y = element_text(size=15),8 G9 @3 ^/ u; i
legend.title=element_blank(),1 C1 W+ b( n* L t; Y
legend.text=element_text(size=15))$ p8 s$ T; Y; y; `
3 v- R' x; ]# O; d
$ k2 a" O" G, H8 v- m, { x8 h
三、新增确诊病例全球地理分布" t; r1 @5 S K, F
mapworld<-borders("world",colour = "gray50",fill="white")
: r, X3 R! l" h7 yggplot()+mapworld+ylim(-60,90)+
Y5 s9 k# S C: M* m9 j geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-01-22`),color="darkorange")+! |1 V5 Z, T9 \! i1 ]3 E
scale_size(range=c(2,9))+labs(title="2020年1月22日全球新增确诊人数分布")+
8 z2 _, Y2 T* D( w9 J" v theme_grey(base_size = 15)+$ L$ F& J/ Z2 w& O8 N, p8 w
theme(plot.title=element_text(face="plain",size=15,hjust=0.5),. `2 s6 {- {8 C4 j9 ?
legend.title=element_blank())
7 m# r4 _1 U& T% p) q& R6 L3 G/ X2 N* [. ]. H1 f! }
ggplot()+mapworld+ylim(-60,90)+
8 N5 }4 E( F- B4 \$ ~/ N geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-11-22`),color="darkorange")+% R+ w# V5 b# S' k: m7 [0 c/ G
scale_size(range=c(2,9))+labs(title="2020年11月22日全球新增确诊人数分布")+2 ?( |! U5 a7 `8 T
theme_grey(base_size = 15)+& {5 ~0 ]2 }( r1 c
theme(plot.title=element_text(face="plain",size=15,hjust=0.5),: y$ m5 ]- L2 y# K" V4 _) h
legend.title=element_blank())
6 q2 v0 s! U7 v
) [# K. \8 j- C# q# |![]() ( n: ^/ t' z8 q* {( |( v0 C
四、累计确诊病例动态变化图1. 至12月7日全球累计病例确诊人数前十国家 - Z+ I y% a/ K% F. }! l; P3 k
cum_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)) ![]()
1 B- Y) Q" z3 E3 g$ c2. 五国(India、Brazil、Russia、Spain、Italy)累计确诊病例动态变化图
" I. T4 v7 w# ~cum_patient_time<-gather(data,key="date",value="increase_patient",'2020-01-22':'2020-12-07') H; Z$ H+ |9 a
colnames(cum_patient_time)<-c(" rovince","Country","Lat","Long","date","increase_patient")5 j! K/ s2 O; |* N+ k
five_country<-subset(cum_patient_time,Country %in% c("India","Brazil","Russia","Spain","Italy"))
5 a% k# _) x6 n. |five_country$date<-as.Date(five_country$date)6 a3 m, q, U5 r* J6 u) P" j& o
" T7 \+ e: P2 P' s. r/ k" f
ggplot(five_country,
" e# l: P, R+ u9 m) ^+ V: u% G# v) h aes(x=reorder(Country,increase_patient),y=increase_patient, fill=Country,frame=date)) + ! W7 L" y( x h- T6 w# K
geom_bar(stat= 'identity', position = 'dodge',show.legend = FALSE) + , k2 k: W, S; ?- r% k
geom_text(aes(label=paste0(increase_patient)),col="black",hjust=-0.2)+
! a4 i- z. ~# `6 t6 P1 D scale_fill_brewer(palette='Set3')+ #使用Set3色系模板
- R: |7 y) \4 I theme(legend.position="none",9 H1 w9 i& ^1 @) F/ o& b, Y
panel.background=element_rect(fill='transparent'),
D' e# Z+ N7 I. M0 h axis.text.y=element_text(angle=0,colour="black",size=12,hjust=1),
0 R8 d& U R( a3 V/ G panel.grid =element_blank(), #删除网格线
g+ q6 ]- J6 T2 ^ axis.text = element_blank(), #删除刻度标签) p0 z( y, ~) @
axis.ticks = element_blank(), #删除刻度线1 b4 ]2 l% T# d' h1 n
)+
; U: N: i/ [! r4 x& L X: g coord_flip()+ 9 G' z$ ^6 l" ]4 y9 V) B, v" U
transition_manual(frames=date) + #动态呈现7 ^7 _8 E$ l+ d7 P4 E+ r% y! B
labs(title = paste('日期:', '{current_frame}'),x = '', y ='五国累计确诊病例增长')+ & J* k1 I7 s1 |- _( Y5 }
theme(axis.title.x = element_text(size=15))+
! R( S; i+ D1 x$ J; b ease_aes('linear')
! x. \) A4 V9 W6 W o# X! P. o* T( D7 _# ~
anim_save(filename = "五国累计确诊病例增长动态图.gif")/ W& y4 }# V! D* E }
. S; L0 G) r" c8 D- p
6 z. H. S" f0 ^2 h0 d
1 d: u8 s) z' q% q* P
) m) m' q$ G8 N; u& o
: o- {$ k; Z- {# o5 B: F3 l
|
zan
|