QQ登录

只需要一步,快速开始

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

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

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

1178

主题

15

听众

1万

积分

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

    [LV.7]常住居民III

    自我介绍
    数学中国浅夏
    跳转到指定楼层
    1#
    发表于 2021-10-28 20:34 |只看该作者 |倒序浏览
    |招呼Ta 关注Ta
                                   可视化实例基于R语言的全球疫情可视化
    $ w2 B  C: o1 }' u# J6 p) K0 x目录$ K$ w( ^. X% O" @
    一、数据介绍及预处理, d) Y# O9 _8 a( N  Z: x4 |
    二、新增确诊病例变化趋势1 L; k- t! z+ t' p; M# D8 [# m% G3 G' J, h
    三、新增确诊病例全球地理分布' Q" ]# T/ F4 h
    四、累计确诊病例动态变化图" |* h# R* r1 g( |3 M9 q: I2 H
    一、数据介绍及预处理
    & {/ p! J0 P( S: Z1. 基本字段介绍: N: I; d* ^7 w2 e/ G
    3 ?. h% W! L0 d& J5 z1 y  m
    字段名        含义
    9 M0 O" B& P3 O: Q  l' @- m! \Province/State        省/州5 d0 h3 K/ s3 d" }( O) ^% @
    Country/Region        国家/地区
    & a. I* q) p2 T  P% \Lat        纬度% x1 x% p0 ]9 a; `3 g
    Long        经度
    8 h  B5 I+ `, F9 Q1/22/20-12/7/20        每日累计确诊病例
    3 F2 B5 B9 S) h; R, k: c( W8 v1 s3 ~

    # U1 ?) v2 e% g2 W+ x" q3 W& t& r4 Z* g0 h, O0 \# F- V6 P

    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 g  p/ `0 G# g
      [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)]
      6 z. r0 P/ v" N  V' @
      [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)]
      / h0 `8 c* Q/ v% e5 Q) i- H4 T
      [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)]
      ) Z) Q3 W" [! j' U) J. o3 ?5 @2 c6 h
      [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)]二、新增确诊病例变化趋势#由累计确诊病例计算新增确诊病例
      1 }0 S3 T1 }) v# s- Binspect_lag_data<-cbind(0,inspect_data[,1ncol(inspect_data)-1)])
      8 g( h$ J% O1 G1 |9 f* N4 wincrease_data<-inspect_data-inspect_lag_data
      ; X  G- N( M1 z; J+ {5 y. D2 M; b( Y' z# K" V8 [( q
      #合并数据,new_data为新增确诊人数数据" ?8 Y6 z1 Q' J5 b
      new_data<-cbind(information_data,increase_data)9 z7 U( l4 {) b% I9 R3 w4 l
      % v+ l$ D# S4 M. ?2 ]
      1. 中国新增确诊病例变化趋势, p8 m' N$ X3 a6 ^
      #合并所有省份新增确诊人数
      4 @8 i$ M5 S% {- M1 l9 Q# achina<-new_data[new_data$`Country/Region`=='China',]9 p$ t4 g. J& b+ z
      china_increase<-data.frame(apply(china[,-c(1:4)],2,sum))
      ) h) s$ c- S% X1 jcolnames(china_increase)<-'increase_patient'' o! N1 N# ?; _( C
      china_increase$date<-as.Date(rownames(china_increase),format="%Y-%m-%d")
      ( j* X( G6 j( p1 s9 B1 ~& p" b. T% e( {- |, _2 c
      ggplot(china_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+5 L/ Q, j  x5 f  ^9 Y
        scale_x_date(date_breaks = "14 days")+  #设置横轴日期间隔为14天(注意:此时的date列必须为日期格式!)
      ( s6 o0 w9 m: P. q  labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日中国新增确诊人数变化趋势图')+
      ' `5 d: d$ U9 ~9 K8 K/ Z) F; K1 A% S  theme_economist()+  #使用经济学人绘图样(式ggthemes包)+ p* E: v" h4 w" `
        theme(plot.title = element_text(face="plain",size=15,hjust=0.5),* I* m+ }8 P  }; C
              axis.title.x = element_blank(),
      4 Q! N9 x' {" J( f9 e/ d        axis.title.y = element_text(size=15),) i9 k& p  h0 V
              axis.text.x = element_text(angle = 90,size=15),
      2 S- `2 e( J- [! v9 B! \- }6 @        axis.text.y = element_text(size=15),
      2 J: y  `5 s- ?- ?        legend.title=element_blank(),( ?# n; E+ L/ {# ^% k% t1 N
              legend.text=element_text(size=15))! }! p. H* i- D" q, l

      & @! v4 T3 M( `2 S  M; ^4 |                             
      6 |2 l& c) _$ O  K# @" n6 n9 J2. 美国新增病例变化趋势7 j' A: R/ H( m
      us<-new_data[new_data$`Country/Region`=='United States',]
      9 U7 j" D  v' t, n9 }  ?us_increase<-gather(us,key="date",value="increase_patient",'2020-01-22':'2020-12-07')
      5 E5 \  Q, q6 rus_increase$date<-as.Date(us_increase$date)
      0 `+ k& [  G1 }, ~ggplot(us_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+5 v" v. b, f; Y& n. L
        scale_x_date(date_breaks = "14 days")+   #设置横轴日期间隔为14天
      3 J+ f) ?9 u; d2 v: |1 K& e  labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日美国新增确诊人数变化趋势图')+
      . i- |4 N, G0 p$ k- c  S1 C  theme_economist()+   #使用经济学人绘图样(式ggthemes包)
      * y0 N+ k) [& Y! @  theme(plot.title = element_text(face="plain",size=15,hjust=0.5),; V/ ?/ K% s  S! b% D
              axis.title.x = element_blank(),
      6 u: q: ^6 j  n6 R        axis.title.y = element_text(size=15),7 p. q5 X" ~8 c
              axis.text.x = element_text(angle = 90,size=15),% E1 |9 Q( ?6 G$ E
              axis.text.y = element_text(size=15),$ H5 x$ R; \' a+ R" P( C9 ]3 Y7 @" u
              legend.title=element_blank(),
      , U) I. K6 B0 K- e        legend.text=element_text(size=15))
      6 p$ Q4 |# I6 N& K( A
      2 }6 t. J+ V( j9 E  s8 M

      3 C& L8 ~6 X7 j, c( {3. 全球新增病例变化趋势! R* k1 [+ n$ N3 Q% S% {: c
      total_increase<-data.frame(apply(new_data[,-c(1:4)],2,sum))
      - H4 g1 J% Z# G5 e7 I+ S6 r  ^colnames(total_increase)<-'increase_patient'4 ?! ?3 {6 n  s; J
      total_increase$date<-as.Date(rownames(total_increase),format="%Y-%m-%d")
      ) o' D# k3 m  Q/ Oggplot(total_increase,aes(x=date,y=increase_patient,color='新增确诊人数'))+geom_line(size=1)+
      : l3 i( x$ u8 y- z; D5 w  scale_x_date(date_breaks = "14 days")+- G$ _, n0 x% ~: U' ?% G
        labs(x='日期',y='新增确诊人数',title='2020年1月22日-2020年12月7日全球新增确诊人数变化趋势图')+
      ' _4 U( m& [/ j* ?3 B1 U3 Y/ E4 X  theme_economist()++ D' o* `) p" ^; s
        scale_y_continuous(limits=c(0,8*10^5),      #考虑数字过大,以文本形式标注y轴标签
      8 F" L3 p$ ?9 Y) z6 v! n! v                     breaks=c(0,2*10^5,4*10^5,6*10^5,8*10^5),
      . q2 B- B2 U2 V. `3 y, ~2 d                     labels=c("0","20万","40万","60万","80万"))+
      ) C3 L8 J) q! N! ^/ d. l  theme(plot.title = element_text(face="plain",size=15,hjust=0.5),
      . ^; L2 V6 |& d4 W$ ^3 ~        axis.title.x = element_blank(),
      5 _, S& u2 j3 K: u- X3 F7 s        axis.title.y = element_text(size=15),6 l  g9 y* O+ m2 z: Z* K9 O
              axis.text.x = element_text(angle = 90,size=15),
      # j$ D' O# k( t' @9 }- j$ {        axis.text.y = element_text(size=15),; p7 f, X& Z" S2 w. ?: d. V  p
              legend.title=element_blank(),
      # j: }6 N1 f2 b0 E" g        legend.text=element_text(size=15))  p$ D  _! A. o- u+ U) [4 Z* _

      . ^( f3 _. h0 c! s$ @& K. v) W/ e( j  P' ^+ ~
      三、新增确诊病例全球地理分布) t# V3 {/ `7 C+ \( T% q+ |8 S$ J1 s
      mapworld<-borders("world",colour = "gray50",fill="white") ( C  ]6 m/ h* Y9 b
      ggplot()+mapworld+ylim(-60,90)+" c+ b4 k# h+ R6 |- p
        geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-01-22`),color="darkorange")+. M9 h. w4 G7 |$ C2 k* E$ h& t  m
        scale_size(range=c(2,9))+labs(title="2020年1月22日全球新增确诊人数分布")+9 p; V, @% ^5 o8 y# _
        theme_grey(base_size = 15)+* I/ q* p( z  @" E
        theme(plot.title=element_text(face="plain",size=15,hjust=0.5),
      9 J& y6 l: x7 z$ E% E        legend.title=element_blank())! s3 p9 c5 y7 a4 E& m
      : e& s7 o) ^& M2 ?+ |* f/ h
      ggplot()+mapworld+ylim(-60,90)+" G9 q1 E$ m' e8 S
        geom_point(aes(x=new_data$Long,y=new_data$Lat,size=new_data$`2020-11-22`),color="darkorange")+) L0 o" |/ y3 o
        scale_size(range=c(2,9))+labs(title="2020年11月22日全球新增确诊人数分布")+
      . K; h) F% s" [$ B- O9 _# r  theme_grey(base_size = 15)+
      . X7 Q# H2 w( l  theme(plot.title=element_text(face="plain",size=15,hjust=0.5),% W& k. u0 C" R
              legend.title=element_blank())% U6 V: W, n" |

      / v8 u, _5 v# ~6 C" w; G, u* _: P& M
      四、累计确诊病例动态变化图

      1. 至12月7日全球累计病例确诊人数前十国家


      0 V% K& e# ~4 t" J0 {6 L$ m/ G

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


      / |% ~8 Q7 z/ _! ^! P! ?2. 五国(India、Brazil、Russia、Spain、Italy)累计确诊病例动态变化图! `( B9 d$ M9 B. ]
      cum_patient_time<-gather(data,key="date",value="increase_patient",'2020-01-22':'2020-12-07')4 J1 F3 B/ j0 e4 S" g2 a
      colnames(cum_patient_time)<-c("rovince","Country","Lat","Long","date","increase_patient")% I0 l! b4 z) h4 C3 n$ s2 [
      five_country<-subset(cum_patient_time,Country %in% c("India","Brazil","Russia","Spain","Italy"))
      . n' o4 t0 O+ r/ Sfive_country$date<-as.Date(five_country$date)
      ; F' `2 r) L2 `1 S0 @; C* Y- O& d  R
      ggplot(five_country, 4 w% g) l, }  \/ S
                  aes(x=reorder(Country,increase_patient),y=increase_patient, fill=Country,frame=date)) +  
      1 w8 D' h3 J1 z& c  geom_bar(stat= 'identity', position = 'dodge',show.legend = FALSE) +  ! I+ O7 W% X, l4 B6 e
        geom_text(aes(label=paste0(increase_patient)),col="black",hjust=-0.2)+  8 N. `& l7 x5 [3 V
        scale_fill_brewer(palette='Set3')+  #使用Set3色系模板6 ?9 S( S2 H* h# K
        theme(legend.position="none",
      4 q8 a- a: I; I6 K% u# q( s+ m        panel.background=element_rect(fill='transparent'),* w# V6 n6 g/ r2 t( d* x
              axis.text.y=element_text(angle=0,colour="black",size=12,hjust=1),
      / M% R* a9 q- {% d! e0 D        panel.grid =element_blank(),  #删除网格线! G. s+ W. P& T$ Z3 ?3 b1 B2 z) S7 F
              axis.text = element_blank(),  #删除刻度标签0 T2 I% d- m! |' _) I
              axis.ticks = element_blank(),  #删除刻度线6 m( @5 \! o% A* A& j
        )+
      - y# C% j# G. y) E1 i  coord_flip()+  
      ; W6 y2 h# Y& O1 ]- P  transition_manual(frames=date) +  #动态呈现$ k8 M  y. d  s; V/ }9 a: Z; n  j
        labs(title = paste('日期:', '{current_frame}'),x = '', y ='五国累计确诊病例增长')+  9 D# U9 J+ A0 b, J' S$ S* M0 T6 L! h5 E
        theme(axis.title.x = element_text(size=15))+, i2 o6 ]( r2 ~- W6 E1 J
        ease_aes('linear')  : t/ D2 D5 T" R) M

      - M) u! w6 a: U" z; S; \4 |, K- danim_save(filename = "五国累计确诊病例增长动态图.gif")% B0 G8 Y" I6 C2 T& k
      5 J* E* I: H6 v+ [

      0 O, e: o! g4 b" h% F
      1 I4 M1 x7 h' F' N# s& k/ a
    2 G$ A3 d- T- i6 ]4 ]7 P% D

    ; H, @' V, q) g5 o$ C6 s/ s
    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, 2026-4-22 00:45 , Processed in 0.413982 second(s), 50 queries .

    回顶部