QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 5767|回复: 0
打印 上一主题 下一主题

可视化实例基于R语言的全球疫情可视化

[复制链接]
字体大小: 正常 放大

1178

主题

15

听众

1万

积分

  • TA的每日心情
    开心
    2023-7-31 10:17
  • 签到天数: 198 天

    [LV.7]常住居民III

    自我介绍
    数学中国浅夏
    跳转到指定楼层
    1#
    发表于 2021-10-28 20:34 |只看该作者 |倒序浏览
    |招呼Ta 关注Ta
                                   可视化实例基于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$ o

    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)]
      / 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[,1ncol(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 o

      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))

      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
    转播转播0 分享淘帖0 分享分享0 收藏收藏0 支持支持0 反对反对0 微信微信
    您需要登录后才可以回帖 登录 | 注册地址

    qq
    收缩
    • 电话咨询

    • 04714969085
    fastpost

    关于我们| 联系我们| 诚征英才| 对外合作| 产品服务| QQ

    手机版|Archiver| |繁體中文 手机客户端  

    蒙公网安备 15010502000194号

    Powered by Discuz! X2.5   © 2001-2013 数学建模网-数学中国 ( 蒙ICP备14002410号-3 蒙BBS备-0002号 )     论坛法律顾问:王兆丰

    GMT+8, 2025-9-29 00:17 , Processed in 0.493215 second(s), 50 queries .

    回顶部