QQ登录

只需要一步,快速开始

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

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

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

1178

主题

15

听众

1万

积分

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

    [LV.7]常住居民III

    自我介绍
    数学中国浅夏
    跳转到指定楼层
    1#
    发表于 2021-10-28 20:34 |只看该作者 |倒序浏览
    |招呼Ta 关注Ta
                                   可视化实例基于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[,1ncol(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* @& ]- z0 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
    转播转播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-10-23 04:36 , Processed in 3.094894 second(s), 51 queries .

    回顶部