71-R語言新冠疫情地圖可視化

1犁河、導(dǎo)入數(shù)據(jù)

> library(pacman)
> p_load(dplyr)
> covid <- readr::read_csv("./data_set/novel-corona-virus-2019-dataset/time_series_covid_19_confirmed.csv") %>%
+   rename(province=`Province/State`,region=`Country/Region`)
> names(covid)

##   [1] "province" "region"   "Lat"      "Long"     "1/22/20"  "1/23/20" 
##   [7] "1/24/20"  "1/25/20"  "1/26/20"  "1/27/20"  "1/28/20"  "1/29/20" 
##  [13] "1/30/20"  "1/31/20"  "2/1/20"   "2/2/20"   "2/3/20"   "2/4/20"  
##  [19] "2/5/20"   "2/6/20"   "2/7/20"   "2/8/20"   "2/9/20"   "2/10/20" 
##  [25] "2/11/20"  "2/12/20"  "2/13/20"  "2/14/20"  "2/15/20"  "2/16/20" 
##  [31] "2/17/20"  "2/18/20"  "2/19/20"  "2/20/20"  "2/21/20"  "2/22/20" 
##  [37] "2/23/20"  "2/24/20"  "2/25/20"  "2/26/20"  "2/27/20"  "2/28/20" 
##  [43] "2/29/20"  "3/1/20"   "3/2/20"   "3/3/20"   "3/4/20"   "3/5/20"  
##  [49] "3/6/20"   "3/7/20"   "3/8/20"   "3/9/20"   "3/10/20"  "3/11/20" 
##  [55] "3/12/20"  "3/13/20"  "3/14/20"  "3/15/20"  "3/16/20"  "3/17/20" 
##  [61] "3/18/20"  "3/19/20"  "3/20/20"  "3/21/20"  "3/22/20"  "3/23/20" 
##  [67] "3/24/20"  "3/25/20"  "3/26/20"  "3/27/20"  "3/28/20"  "3/29/20" 
##  [73] "3/30/20"  "3/31/20"  "4/1/20"   "4/2/20"   "4/3/20"   "4/4/20"  
##  [79] "4/5/20"   "4/6/20"   "4/7/20"   "4/8/20"   "4/9/20"   "4/10/20" 
##  [85] "4/11/20"  "4/12/20"  "4/13/20"  "4/14/20"  "4/15/20"  "4/16/20" 
##  [91] "4/17/20"  "4/18/20"  "4/19/20"  "4/20/20"  "4/21/20"  "4/22/20" 
##  [97] "4/23/20"  "4/24/20"  "4/25/20"  "4/26/20"

2、數(shù)據(jù)適配

因?yàn)镽Emap包中獲取的國家（region）名稱和我們數(shù)據(jù)中的名稱可能不一致缩幸，需要手動(dòng)將其一一對(duì)應(yīng)千贯。比如美國在我們數(shù)據(jù)中為US，而在REmap中為United States of America送朱。

> covid$region[which(covid$region=="Antigua and Barbuda")] <- "Bermuda"
> covid$region[which(covid$region=="Czechia")] <- "Czech Republic"
> covid$region[which(covid$region=="Congo (Kinshasa)")] <- "Democratic Republic of the Congo"
> covid$region[which(covid$region=="Timor-Leste")] <- "East Timor"
> covid$region[which(covid$region=="Guinea-Bissau")] <- "Guinea Bissau"
> covid$region[which(covid$region=="Cote d'Ivoire")] <- "Ivory Coast"
> covid$region[which(covid$region=="North Macedonia")] <- "Macedonia"
> covid$region[which(covid$region=="Serbia")] <- "Republic of Serbia"
> covid$region[which(covid$region=="Congo (Brazzaville)")] <- "Republic of the Congo"
> covid$region[which(covid$region=="Korea, South")] <- "South Korea"
> covid$region[which(covid$region=="Eswatini")] <- "Swaziland"
> covid$region[which(covid$region=="Bahamas")] <- "The Bahamas"
> covid$region[which(covid$region=="Tanzania")] <- "United Republic of Tanzania"
> covid$region[which(covid$region=="US")] <- "United States of America"
> covid$region[which(covid$region=="West Bank and Gaza")] <- "West Bank"
> # covid$region[which(covid$region=="china")] <- "xianggang"

3娘荡、匯總數(shù)據(jù)

> # 按行求和
> covid.sel <- covid %>% 
+   reshape2::dcast(`province` + `region` + `Long` + `Lat` ~ .,
+                   fun.aggregate = sum) %>%
+   # 更名
+   rename(vol=".")
> str(covid.sel)

## 'data.frame':    264 obs. of  5 variables:
##  $ province: chr  "Alberta" "Anguilla" "Anhui" "Aruba" ...
##  $ region  : chr  "Canada" "United Kingdom" "China" "Netherlands" ...
##  $ Long    : num  -116.6 -63.1 117.2 -70 149 ...
##  $ Lat     : num  53.9 18.2 31.8 12.5 -35.5 ...
##  $ vol     : num  4480 3 991 100 106 ...

4、畫圖

> p_load(REmap)
> # 獲取REmap中的國家名
> country <- data.frame(region=mapNames("world"))
> # 根據(jù)名稱對(duì)應(yīng)數(shù)據(jù)
> mapdata <- left_join(country,covid.sel,by="region") %>%
+   select(region,vol)
> str(mapdata)

## 'data.frame':    257 obs. of  2 variables:
##  $ region: chr  "Afghanistan" "Angola" "Albania" "United Arab Emirates" ...
##  $ vol   : num  1531 26 726 10349 3892 ...

> covid.world <- remapC(mapdata,maptype = "world",
+                       color = c('#FD0100','#FFB8B5'),
+                       theme = get_theme("dark"),
+                       title = "2019-nCoV全球分布圖",
+                       subtitle = "截止2020年4月26日",)
> covid.world

## Save img as: C:\Users\Admin\AppData\Local\Temp\RtmpKs931s/ID_20200504184333_2814895.html
REmap地圖

使用REmap包畫的圖會(huì)通過瀏覽器展示出來驶沼，鼠標(biāo)放在某一區(qū)域炮沐，會(huì)自動(dòng)顯示相應(yīng)數(shù)值。
灰色地帶為region名稱沒有對(duì)應(yīng)上的區(qū)域回怜。

5大年、按時(shí)間序列畫動(dòng)態(tài)圖

> p_load(animation,sp,maptools,ggplot2)
> # 讀取中國地圖的多邊形數(shù)據(jù)
> china <- readShapePoly("./data_set/china_basic_map/bou2_4p.shp")
> # 提取省級(jí)名稱
> province.name <- china$NAME %>% as.character()
> # 轉(zhuǎn)換為數(shù)據(jù)框
> china.sel <- fortify(china) %>% select(long,lat,group,id)
> # 添加province列
> china.sel$province[!duplicated(china.sel$id)] <- province.name
> # 填充其他列
> china.sel <- tidyr::fill_(china.sel,fill_cols="province",.direction="down")

## 'data.frame':    89912 obs. of  5 variables:
##  $ long    : num  121 121 122 122 122 ...
##  $ lat     : num  53.3 53.3 53.3 53.3 53.3 ...
##  $ group   : Factor w/ 925 levels "0.1","1.1","2.1",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ id      : chr  "0" "0" "0" "0" ...
##  $ province: chr  "黑龍江省" "黑龍江省" "黑龍江省" "黑龍江省" ...

> # 抽取中國的疫情數(shù)據(jù)
> china.data <- covid %>% filter(region=="China" | region=="Taiwan*") %>%
+   select(-"region")
> 
> china.data$province <-
+   c("安徽省","北京市","重慶市","福建省","甘肅省","廣東省",
+   "廣西壯族自治區(qū)","貴州省","海南省","河北省","黑龍江省","河南省",
+   "香港特別行政區(qū)","湖北省","湖南省","內(nèi)蒙古自治區(qū)","江蘇省",
+   "江西省","吉林省","遼寧省","澳門特別行政區(qū)","寧夏回族自治區(qū)","青海省",
+   "陜西省","山東省","上海市","山西省","四川省","天津市",
+   "西藏自治區(qū)","新疆維吾爾自治區(qū)","云南省","浙江省","臺(tái)灣省")
> 
> # 合并數(shù)據(jù)
> china.data <- china.data[,-c(2:3)] %>% 
+   right_join(china.sel,by="province")
> china.data <- select(china.data,-c("id"))
> str(china.data)

> # 設(shè)置播放速度及圖片大小，轉(zhuǎn)換器路徑
> ani.options(interval=0.5,
+             convert=shQuote("C:/Program Files/ImageMagick-7.0.10-Q16/convert.exe"),
+             ani.width=800,ani.height=800)
> 
> saveGIF(
+  for(i in seq(2,97,by=11)) {
+     data <- china.data[,c(1,98:100,i)] %>% as.data.frame()
+     names(data)[5] <- "vol"
+     p <- ggplot(data,aes(long,lat,group=group,fill=vol)) +
+          geom_polygon(col="gray60") +
+          scale_fill_gradient(low="white",high="red") +
+          labs(title = names(china.data)[i],x="",y="") +
+          theme(panel.grid = element_blank(),
+                panel.background = element_blank(),
+                axis.text = element_blank(),
+                axis.ticks = element_blank(),
+                legend.position = "none")
+     print(p)
+   }
+ )
疫情時(shí)間序列圖

因?yàn)楹钡臄?shù)據(jù)太大玉雾，導(dǎo)致其他區(qū)域的填充顏色太淺鲜戒。
這個(gè)地方需要注意的有兩點(diǎn)：1、數(shù)據(jù)一定要轉(zhuǎn)換為data.frame抹凳，因?yàn)槟壳斑€不支持tibble遏餐；2、圖片的長寬比例需要手動(dòng)調(diào)整赢底，不然圖片會(huì)很難看失都。

6、動(dòng)態(tài)點(diǎn)圖

> # 畫一個(gè)空白的中國地圖
> p <- ggplot() +
+   geom_polygon(data=china,aes(long,lat,group=group),col="gray40",fill="white") +
+   labs(title = "疫情地圖",x="",y="") +
+   theme(panel.grid = element_blank(),
+        panel.background = element_blank(),
+        axis.text = element_blank(),
+        axis.ticks = element_blank(),
+        legend.position = "none")
>
> china.data2 <- covid %>% filter(region=="China" | region=="Taiwan*") %>%
+   select(-c("region","province"))

> saveGIF(
+   for(i in seq(3,98,by=11)) {
+     data <- china.data2[,c(1,2,i)] %>% as.data.frame()
+     names(data)[3] <- "vol"
+     pic <- p + geom_jitter(aes(Long,Lat,size=vol),
+                           data=data,shape=19,col="red") +
+       scale_size(range = c(1.2,10)) +
+       labs(title = names(china.data2)[i],x="",y="")
+     print(pic)
+   })
疫情時(shí)間序列點(diǎn)圖
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者
  • 人面猴
    序言：七十年代末幸冻，一起剝皮案震驚了整個(gè)濱河市粹庞，隨后出現(xiàn)的幾起案子，更是在濱河造成了極大的恐慌洽损，老刑警劉巖庞溜，帶你破解...
    沈念sama閱讀 217,826評(píng)論 6贊 506
  • 死咒
    序言：濱河連續(xù)發(fā)生了三起死亡事件，死亡現(xiàn)場離奇詭異碑定，居然都是意外死亡流码，警方通過查閱死者的電腦和手機(jī)，發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 92,968評(píng)論 3贊 395
  • 救了他兩次的神仙讓他今天三更去死
    文/潘曉璐 我一進(jìn)店門延刘，熙熙樓的掌柜王于貴愁眉苦臉地迎上來漫试，“玉大人，你說我怎么就攤上這事碘赖〖萑伲” “怎么了外构？”我有些...
    開封第一講書人閱讀 164,234評(píng)論 0贊 354
  • 道士緝兇錄：失蹤的賣姜人
    文/不壞的土叔 我叫張陵，是天一觀的道長播掷。 經(jīng)常有香客問我审编，道長，這世上最難降的妖魔是什么歧匈？ 我笑而不...
    開封第一講書人閱讀 58,562評(píng)論 1贊 293
  • ?港島之戀（遺憾婚禮）
    正文 為了忘掉前任割笙，我火速辦了婚禮，結(jié)果婚禮上眯亦，老公的妹妹穿的比我還像新娘伤溉。我一直安慰自己，他們只是感情好妻率，可當(dāng)我...
    茶點(diǎn)故事閱讀 67,611評(píng)論 6贊 392
  • 惡毒庶女頂嫁案：這布局不是一般人想出來的
    文/花漫 我一把揭開白布乱顾。 她就那樣靜靜地躺著，像睡著了一般宫静。 火紅的嫁衣襯著肌膚如雪走净。 梳的紋絲不亂的頭發(fā)上，一...
    開封第一講書人閱讀 51,482評(píng)論 1贊 302
  • 城市分裂傳說
    那天孤里，我揣著相機(jī)與錄音伏伯，去河邊找鬼。 笑死捌袜，一個(gè)胖子當(dāng)著我的面吹牛说搅，可吹牛的內(nèi)容都是我干的。 我是一名探鬼主播虏等，決...
    沈念sama閱讀 40,271評(píng)論 3贊 418
  • 雙鴛鴦連環(huán)套：你想象不到人心有多黑
    文/蒼蘭香墨 我猛地睜開眼弄唧，長吁一口氣：“原來是場噩夢(mèng)啊……” “哼！你這毒婦竟也來了霍衫？” 一聲冷哼從身側(cè)響起候引，我...
    開封第一講書人閱讀 39,166評(píng)論 0贊 276
  • 萬榮殺人案實(shí)錄
    序言：老撾萬榮一對(duì)情侶失蹤，失蹤者是張志新（化名）和其女友劉穎敦跌，沒想到半個(gè)月后澄干，有當(dāng)?shù)厝嗽跇淞掷锇l(fā)現(xiàn)了一具尸體，經(jīng)...
    沈念sama閱讀 45,608評(píng)論 1贊 314
  • ?護(hù)林員之死
    正文 獨(dú)居荒郊野嶺守林人離奇死亡柠傍，尸身上長有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點(diǎn)故事閱讀 37,814評(píng)論 3贊 336
  • ?白月光啟示錄
    正文 我和宋清朗相戀三年麸俘，在試婚紗的時(shí)候發(fā)現(xiàn)自己被綠了。 大學(xué)時(shí)的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片携兵。...
    茶點(diǎn)故事閱讀 39,926評(píng)論 1贊 348
  • 活死人
    序言：一個(gè)原本活蹦亂跳的男人離奇死亡疾掰，死狀恐怖，靈堂內(nèi)的尸體忽然破棺而出徐紧，到底是詐尸還是另有隱情静檬，我是刑警寧澤，帶...
    沈念sama閱讀 35,644評(píng)論 5贊 346
  • ?日本核電站爆炸內(nèi)幕
    正文 年R本政府宣布并级，位于F島的核電站拂檩，受9級(jí)特大地震影響，放射性物質(zhì)發(fā)生泄漏嘲碧。R本人自食惡果不足惜稻励，卻給世界環(huán)境...
    茶點(diǎn)故事閱讀 41,249評(píng)論 3贊 329
  • 男人毒藥：我在死后第九天來索命
    文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望愈涩。 院中可真熱鬧望抽，春花似錦、人聲如沸履婉。這莊子的主人今日做“春日...
    開封第一講書人閱讀 31,866評(píng)論 0贊 22
  • 一樁弒父案，背后竟有這般陰謀
    文/蒼蘭香墨 我抬頭看了看天上的太陽毁腿。三九已至辑奈，卻和暖如春，著一層夾襖步出監(jiān)牢的瞬間已烤，已是汗流浹背鸠窗。 一陣腳步聲響...
    開封第一講書人閱讀 32,991評(píng)論 1贊 269
  • 情欲美人皮
    我被黑心中介騙來泰國打工， 沒想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留胯究，地道東北人稍计。 一個(gè)月前我還...
    沈念sama閱讀 48,063評(píng)論 3贊 370
  • 代替公主和親
    正文 我出身青樓，卻偏偏與公主長得像裕循，于是被迫代替她去往敵國和親丙猬。 傳聞我的和親對(duì)象是個(gè)殘疾皇子，可洞房花燭夜當(dāng)晚...
    茶點(diǎn)故事閱讀 44,871評(píng)論 2贊 354