- 在线时间
- 514 小时
- 最后登录
- 2023-12-1
- 注册时间
- 2018-7-17
- 听众数
- 15
- 收听数
- 0
- 能力
- 0 分
- 体力
- 40345 点
- 威望
- 0 点
- 阅读权限
- 255
- 积分
- 12815
- 相册
- 0
- 日志
- 0
- 记录
- 0
- 帖子
- 1419
- 主题
- 1178
- 精华
- 0
- 分享
- 0
- 好友
- 15
TA的每日心情 | 开心 2023-7-31 10:17 |
|---|
签到天数: 198 天 [LV.7]常住居民III
- 自我介绍
- 数学中国浅夏
 |
可视化实例基于R语言的全球疫情可视化
6 T3 c* F r$ ]+ R目录) b6 a Z( D0 ?( Q! v2 e% S
一、数据介绍及预处理9 u# J. z5 K3 m
二、新增确诊病例变化趋势
+ M1 o$ x* B r" G三、新增确诊病例全球地理分布# c& |4 c3 A; p" D
四、累计确诊病例动态变化图5 o0 |! N& w$ @5 o
一、数据介绍及预处理. [% ^/ L8 H. f
1. 基本字段介绍( H1 U4 x: N; E: v
: ?/ c8 ]- w* {
字段名 含义
- W. E, `+ A- J8 L( u6 R% u8 a0 vProvince/State 省/州
& O. s$ f( g$ ~# Y7 l* k0 h g5 q: @Country/Region 国家/地区0 W% @ y7 d. T/ g* c
Lat 纬度
) n- v5 {$ g# R, h4 V5 q. oLong 经度
7 Y! a+ b' j" M; Z4 L3 F# G* P1/22/20-12/7/20 每日累计确诊病例
5 b# @( S& I0 v
( [3 Z8 L1 @# z% B![]()
1 z: l( ?: l1 V0 |+ c4 h$ W' m
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)]
4 T5 g/ c7 J, Y; v* r[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)]# M; m, J6 ]# w' ^0 A
[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)]" R9 h Q* [! \, w: {0 f" U; Q
[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)]
! f3 b$ \6 {: }7 d% ~2 r[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)]二、新增确诊病例变化趋势#由累计确诊病例计算新增确诊病例; ^9 r8 ]0 \: t6 ?" c
inspect_lag_data<-cbind(0,inspect_data[,1 ncol(inspect_data)-1)])* t8 q( T3 M2 Y; f; ~! X
increase_data<-inspect_data-inspect_lag_data
, R7 D7 y- L/ [5 F* ]! b; K; q9 d( q. f: G/ d# i/ X
#合并数据,new_data为新增确诊人数数据
% Y s% I; t3 f. e ` ?" Znew_data<-cbind(information_data,increase_data)
+ `( G3 M4 L7 u- k0 u
. S/ h3 r" P+ p1 B1. 中国新增确诊病例变化趋势
! O# L+ f0 C+ j+ n9 ]3 C#合并所有省份新增确诊人数
: a) {6 P: y9 F7 R' Wchina<-new_data[new_data$`Country/Region`=='China',]; e' P5 C8 W3 ]. N5 B/ Z4 [
china_increase<-data.frame(apply(china[,-c(1:4)],2,sum))+ M( W0 A" |7 d* b& g% m
colnames(china_increase)<-'increase_patient'
# d, V6 x4 c0 O) b! T+ Ichina_increase$date<-as.Date(rownames(china_increase),format="%Y-%m-%d")- U4 I+ M4 }/ G0 i5 M
. j/ R# n m7 H1 w
ggplot(china_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)++ D$ H6 K% |. ~9 v: P; t* J
scale_x_date(date_breaks = "14 days")+ #设置横轴日期间隔为14天(注意:此时的date列必须为日期格式!)! j6 l5 D/ K( c7 v; C
labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日中国新增确诊人数变化趋势图')+
; r, r' v4 }8 Q5 p: m9 A theme_economist()+ #使用经济学人绘图样(式ggthemes包)
0 C3 C9 N D" w7 _) J$ S theme(plot.title = element_text(face="plain",size=15,hjust=0.5),: {6 t3 x5 r6 t% N# e6 f) E2 \
axis.title.x = element_blank(),
+ w/ \3 j/ N$ D5 p, h axis.title.y = element_text(size=15),$ e" U. P2 r! c! O3 w
axis.text.x = element_text(angle = 90,size=15),2 f5 [( X. J0 c0 @$ k, X7 Y, N" \1 k
axis.text.y = element_text(size=15),
+ C$ @7 f6 `. N$ q legend.title=element_blank(),- v$ y' n% T) U
legend.text=element_text(size=15))
- m) G+ X2 O/ F n% [ u3 r
# h& r% Q$ B0 V$ C/ n$ A 8 ]* A& S& L9 [$ h
2. 美国新增病例变化趋势, ^6 @4 [% y4 G
us<-new_data[new_data$`Country/Region`=='United States',]5 T+ F6 @4 a3 B. D9 W @
us_increase<-gather(us,key="date",value="increase_patient",'2020-01-22':'2020-12-07')
/ K8 g$ Z. h2 `3 S5 b7 F( \/ Tus_increase$date<-as.Date(us_increase$date)
1 m6 p. c9 u/ jggplot(us_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+* w: v0 Y% P4 f+ T F2 v! y! W
scale_x_date(date_breaks = "14 days")+ #设置横轴日期间隔为14天; ^! x2 M* t+ B( B2 v U
labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日美国新增确诊人数变化趋势图')++ O2 H4 o' q7 s$ V; A: a- M
theme_economist()+ #使用经济学人绘图样(式ggthemes包)! @9 d6 |2 q* b4 d
theme(plot.title = element_text(face="plain",size=15,hjust=0.5),. a/ n, X: Z+ C/ q
axis.title.x = element_blank(),
6 E4 Y0 |9 x) y; h' ?; l5 ] axis.title.y = element_text(size=15),% t3 T$ R/ g4 }
axis.text.x = element_text(angle = 90,size=15),
& `* E; j: S0 ?, n- B: [' k/ a. a7 a axis.text.y = element_text(size=15),
l, @- U% q9 I/ d2 ?( M- n9 @& a legend.title=element_blank(),
9 ^) w3 N @& W2 U3 r0 ?* Q8 m legend.text=element_text(size=15))
1 o2 k% @# ?/ H" }) k1 J# S
" ]( u( b3 v9 C* @& ]- z 0 U) a5 P8 _) W2 f; }7 A6 f/ J
3. 全球新增病例变化趋势4 Y+ e( | \+ S1 \, n
total_increase<-data.frame(apply(new_data[,-c(1:4)],2,sum))
8 d/ d: @3 G' I" N9 V4 Ccolnames(total_increase)<-'increase_patient'
# c- p+ B. G, p; Y( Ttotal_increase$date<-as.Date(rownames(total_increase),format="%Y-%m-%d")
$ K+ ]6 i' t( R, w0 iggplot(total_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+" l4 ]8 l. c$ p7 q6 K9 f
scale_x_date(date_breaks = "14 days")+
5 {& @+ S b! W. V labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日全球新增确诊人数变化趋势图')+
/ ]. X. _- h0 W9 ^ theme_economist()+% ?# _7 E9 x1 Z" i" Y
scale_y_continuous(limits=c(0,8*10^5), #考虑数字过大,以文本形式标注y轴标签
$ \5 ~5 K# V& T5 k; L W" r3 L0 ^ breaks=c(0,2*10^5,4*10^5,6*10^5,8*10^5),
( P2 e. ]0 U$ I/ W T* x. r labels=c("0","20万","40万","60万","80万"))+5 A" v% B: ]' N. S$ G/ B3 K
theme(plot.title = element_text(face="plain",size=15,hjust=0.5),
5 I8 v2 i z# M) H- t axis.title.x = element_blank(),& E, G- m7 {* u0 c* X. f' S
axis.title.y = element_text(size=15),
( y8 \2 p; [1 [6 U axis.text.x = element_text(angle = 90,size=15),& _$ d. Z) A- l$ t3 L4 z
axis.text.y = element_text(size=15),
$ e4 }5 x6 K. ^- d0 g3 ~% ~- h legend.title=element_blank(),
. E0 p2 y' t! E! V) J. R8 c legend.text=element_text(size=15))7 R( \ h r. h3 G# O5 J+ m' ~
, e( F; m- Y9 C. {& i9 `
![]()
+ {' _' I' a% d, m9 E D+ o B三、新增确诊病例全球地理分布! ?' D1 w/ J9 a \
mapworld<-borders("world",colour = "gray50",fill="white") ' x/ N- [/ \! e! V$ s$ B0 N6 L. s
ggplot()+mapworld+ylim(-60,90)+
' O0 T" @& ?- }) {' @8 t( n% | geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-01-22`),color="darkorange")+! I" k* Z2 s+ Q$ h- F I6 B
scale_size(range=c(2,9))+labs(title="2020年1月22日全球新增确诊人数分布")+! _% Z I: H0 E+ Z$ `% [* c
theme_grey(base_size = 15)+
8 ^9 H Q$ r8 H8 y theme(plot.title=element_text(face="plain",size=15,hjust=0.5),# f& a3 c1 @9 @+ ?
legend.title=element_blank())+ O; F9 L: T! [; O1 `7 S
9 [% S, i& ^: w2 \8 e+ ]
ggplot()+mapworld+ylim(-60,90)+
3 P$ \$ z+ X% m( X* a- O- x0 p geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-11-22`),color="darkorange")+7 l, y8 G' z& b9 C, C: k: [3 H
scale_size(range=c(2,9))+labs(title="2020年11月22日全球新增确诊人数分布")+4 V& Y" j# o( `6 |$ f) }
theme_grey(base_size = 15)+
/ C4 x2 `/ k3 \4 \! e' i( @ theme(plot.title=element_text(face="plain",size=15,hjust=0.5),
! g" N; ~% F1 i, R" ^& G+ s/ s legend.title=element_blank()): X: A, O W1 k+ l f$ m
8 e+ a* r: a1 S1 E% c
![]() ![]()
( E; E/ w1 s3 Z. K1 q四、累计确诊病例动态变化图1. 至12月7日全球累计病例确诊人数前十国家 ( C2 R- e0 R- k0 T4 Y) e
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)) ![]()
; r- s; g3 @: u% h+ j3 N2. 五国(India、Brazil、Russia、Spain、Italy)累计确诊病例动态变化图
! r0 n4 G- g3 w: d( b* ?cum_patient_time<-gather(data,key="date",value="increase_patient",'2020-01-22':'2020-12-07')
9 A j+ l; w$ \2 z( ]colnames(cum_patient_time)<-c(" rovince","Country","Lat","Long","date","increase_patient")
z* {; s- {) W7 [6 U# r/ cfive_country<-subset(cum_patient_time,Country %in% c("India","Brazil","Russia","Spain","Italy"))5 C3 @2 Z$ O4 C) j, K
five_country$date<-as.Date(five_country$date)
$ g1 |. H: P6 j; t/ D0 k+ H* g* r" J1 V8 }, `' w: R# Z
ggplot(five_country,
1 F& _& a) c( o$ K. Y$ a, l. u aes(x=reorder(Country,increase_patient),y=increase_patient, fill=Country,frame=date)) +
& D3 n9 |' v0 @1 S: N geom_bar(stat= 'identity', position = 'dodge',show.legend = FALSE) + / k& P: G! w! [8 ^
geom_text(aes(label=paste0(increase_patient)),col="black",hjust=-0.2)+ 5 Y% O, o1 h! V5 `/ Y- u9 i' U
scale_fill_brewer(palette='Set3')+ #使用Set3色系模板0 X. `) V J @- t9 b/ Y5 u7 d
theme(legend.position="none", F! x/ p6 I( x0 L; c7 ^& x2 J0 x
panel.background=element_rect(fill='transparent'),0 d2 s) Y$ j1 F
axis.text.y=element_text(angle=0,colour="black",size=12,hjust=1),
5 Z' r" x' M3 _% p( ]3 f: c/ w panel.grid =element_blank(), #删除网格线
$ Q4 K, H! s4 R$ R; | axis.text = element_blank(), #删除刻度标签) R, J: {3 m( j0 ^
axis.ticks = element_blank(), #删除刻度线$ r! q. l; u6 V$ L5 X
)+$ m ~4 x- w; a( X! K
coord_flip()+ , ]1 |6 D9 a8 n7 D
transition_manual(frames=date) + #动态呈现- W, r2 l( C6 v6 w9 e2 A1 E( b
labs(title = paste('日期:', '{current_frame}'),x = '', y ='五国累计确诊病例增长')+
0 V0 k$ _% {3 \6 t6 N4 E6 T theme(axis.title.x = element_text(size=15))+
; G: p' c; e5 l ease_aes('linear')
2 l v; M/ y/ u
. R" G6 @' z0 h- `/ t8 w0 panim_save(filename = "五国累计确诊病例增长动态图.gif") u# `" o0 Y( p9 `
* {( [) C7 b' }( L$ [
& L4 h- G; E/ A. v
! D. w, D) d3 }, s8 @8 m
# A' x/ W( t: a& N/ H
+ M: c, |4 _5 a* D b4 T |
zan
|