新型冠状病毒肺炎疫情发展情况:2020-01-28

新型冠状病毒肺炎疫情发展情况:2020-01-28

可能是由于确诊流程的简化,昨天新型冠状病毒肺炎疫情新增确诊病例三千多例!所以我今天再更新一波分析。

视频讲解

实时疫情状况

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
library(jsonlite)
library(tidyverse)
library(lubridate)
library(scales)
library(readr)
dir <- tempdir()
# 实时数量
fromJSON('https://view.inews.qq.com/g2/getOnsInfo?name=wuwei_ww_global_vars&_=1580180392238') %>%
.$data %>%
writeLines(file.path(dir, "real.json"))
real <- fromJSON(file.path(dir, "real.json")) %>%
as_tibble()
# 保存一下
# write_rds(real, "real.rds")
message <- paste0("截止 ", real %>% pull(update_time),
", 共计确诊 ", real %>% pull(confirmCount),
" 例,疑似 ", real %>% pull(suspectCount),
" 例,死亡 ", real %>% pull(deadCount), " 例。")

截止 2020-02-03T13:19:18.000Z, 共计确诊 17341 例,疑似 21558 例,死亡 361 例。

全国疫情发展

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
# 全国总数量:
fromJSON('https://view.inews.qq.com/g2/getOnsInfo?name=wuwei_ww_cn_day_counts&_=1580180392239') %>%
.$data %>%
writeLines(file.path(dir, "wuhan.json"))
df <- fromJSON(file.path(dir, "wuhan.json")) %>%
as_tibble() %>%
type_convert() %>%
mutate(date = ymd(paste0("2020.", date)))
# 保存一下
# write_rds(df, "df.rds")

df %>%
gather(confirm, suspect, dead, heal,
key = "key", value = "count") %>%
arrange(date) %>%
type_convert() %>%
ggplot(aes(x = date, y = count, color = key)) +
geom_line() +
geom_point() +
awtools::a_flat_color(
breaks = c("confirm", "dead", "heal", "suspect"),
labels = c("确诊", "死亡", "治愈", "疑似")
) +
theme_ipsum(base_family = cnfont) +
scale_x_date(breaks = date_breaks('2 day'),
labels = date_format('%m-%d'),
expand = c(0, 0)) +
labs(x = "", y = "人数", color = "",
title = "新型冠状病毒肺炎疫情发展趋势",
subtitle = message,
caption = "数据来源:腾讯新闻\n<https://news.qq.com/zt2020/page/feiyan.htm>")

我们还可以计算一下每天新增的数量:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
df %>% 
arrange(date) %>%
mutate(
dconfirm = confirm - dplyr::lag(confirm),
dsuspect = suspect - dplyr::lag(suspect),
ddead = dead - dplyr::lag(dead),
dheal = heal - dplyr::lag(heal)
) %>%
select(date, dconfirm, dsuspect, ddead, dheal) %>%
gather(dconfirm, dsuspect, ddead, dheal,
key = "key", value = "count") %>%
mutate(
count = case_when(
is.na(count) ~ 0,
is.infinite(count) ~ 1,
T ~ count
)
) %>%
ggplot(aes(x = date, y = count, color = key)) +
geom_line() +
geom_point() +
awtools::a_flat_color(
breaks = c("dconfirm", "ddead", "dheal", "dsuspect"),
labels = c("确诊", "死亡", "治愈", "疑似")
) +
theme_ipsum(base_family = cnfont) +
scale_x_date(breaks = date_breaks('2 day'),
labels = date_format('%m-%d'),
expand = c(0, 0)) +
labs(x = "", y = "人数", color = "",
title = "新型冠状病毒肺炎疫情发展趋势(每日新增数量)",
subtitle = message,
caption = "数据来源:腾讯新闻\n<https://news.qq.com/zt2020/page/feiyan.htm>")

可以看到昨天新增的疑似人数高达 3000 例!

实时省级分布

这种图网上很多了:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
fromJSON('https://view.inews.qq.com/g2/getOnsInfo?name=wuwei_ww_area_counts&_=1580180392241') %>% 
.$data %>%
writeLines(file.path(dir, "real_data.json"))
df <- fromJSON(file.path(dir, "real_data.json")) %>%
as_tibble()
# 保存下
# write_rds(df, "df2.rds")

real_data <- df %>%
dplyr::filter(country == "中国") %>%
group_by(area) %>%
summarise(
confirm = sum(confirm)
) %>%
arrange(desc(confirm))

real_data 是每个省级行政单位确诊病例的分布:

1
DT::datatable(real_data)

绘图展示:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
library(sf)
map <- read_sf('china.json')
map %>%
left_join(real_data, by = c("name" = "area")) %>%
mutate(
confirm = cut(confirm,
breaks = c(0.0, 0.99, 9.9, 99.9, 10000),
labels = c("无", "1~10 人", "10~100人", "> 100人"),
include.lowest = TRUE)
) %>%
mutate(
confirm = as.character(confirm),
confirm = case_when(
is.na(confirm) ~ "无",
T ~ confirm
)
) %>%
ggplot() +
geom_sf(aes(fill = confirm),
color = "gray", size = 0.2) +
scale_fill_manual(name = "确诊",
values = c(
"无" = "#ffffff",
"1~10 人" = "#fcae91",
"10~100人" = "#fb6a4a",
"> 100人" = "#cb181d"
)) +
theme_ipsum(base_family = cnfont) +
worldtilegrid::theme_enhance_wtg() +
labs(title = "新型冠状病毒肺炎疫情分布",
subtitle = message,
caption = "数据来源:腾讯新闻\n<https://news.qq.com/zt2020/page/feiyan.htm>")

市级分布

这里用到的市级地图是我昨天介绍的,这个地图数据和我的边界数据契合的不是很好:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
# 市级分布
citydata <- df %>%
dplyr::filter(country == "中国") %>%
select(city, confirm)

cn <- read_sf('JToMOWvicvJOISZFCkEI.json') %>%
left_join(citydata, by = c("area" = "city")) %>%
mutate(
confirm = cut(confirm,
breaks = c(0.0, 0.99, 9.9, 99.9, 10000),
labels = c("无", "1~10 人", "10~100人", "> 100人"),
include.lowest = TRUE)
) %>%
mutate(
confirm = as.character(confirm),
confirm = case_when(
is.na(confirm) ~ "无",
T ~ confirm
)
)
# 国界线
boundary <- st_read('quanguo_Line.geojson',
stringsAsFactors = FALSE)
ggplot(cn) +
geom_sf(aes(fill = confirm),
color = "gray", size = 0.05) +
geom_sf(data = subset(boundary,
QUHUADAIMA == "guojiexian"),
aes(geometry = geometry),
color = "gray", size = 0.2) +
scale_fill_manual(name = "确诊",
values = c(
"无" = "#ffffff",
"1~10 人" = "#fcae91",
"10~100人" = "#fb6a4a",
"> 100人" = "#cb181d"
)) +
theme_ipsum(base_family = cnfont,
plot_title_family = cnfont,
subtitle_family = cnfont,
caption_family = cnfont) +
worldtilegrid::theme_enhance_wtg() +
labs(title = "新型冠状病毒肺炎疫情分布",
subtitle = message,
caption = "数据来源:腾讯新闻\n<https://news.qq.com/zt2020/page/feiyan.htm>") +
coord_sf(crs = "+proj=laea +lat_0=23 +lon_0=113 +x_0=4321000 +y_0=3210000 +ellps=GRS80 +units=m +no_defs")

具体的细节我就不讲解了,我们今晚直播见!

使用 Stata 绘制一幅带九段线小地图的中国地图

Stata 不是很擅长爬取 JSON 格式的数据,我们就直接把刚刚爬取到的 real_data 保存为 real_data.dta

1
2
3
# 把省级数据导出为 dta 文件
library(haven)
write_dta(real_data, "wuhan.dta", version = 15)

使用 Stata 的 spmap 命令绘制地图:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
clear all
shp2dta using china, database(cndb) coordinates(cncoord) genid(ID) replace

* merege 武汉疫情的数据
use cndb, clear
merge m:1 name using wuhan
replace confirm = 0 if confirm == .
spmap confirm using cncoord, id(ID) fcolor(Reds) ///
clmethod(custom) clbreaks(0 1 10 100 10000) ///
ti(新型冠状病毒肺炎疫情分布, size(*1.2)) graphr(margin(medium)) ///
subti("截止 2020-01-28 14:45, 共计确诊 4578 例,疑似 6973 例,死亡 106 例") ///
legti(确诊) legstyle(2) osize(vvthin ...) ///
legend(size(*1.3) ///
order(2 "无" 3 "1~10 人" 4 "10~100 人" 5 "> 100 人") ///
ti(确诊, size(*0.5) pos(11)))
gr export 新型冠状病毒肺炎疫情分布-stata.png, replace

就不再用 Stata 绘制线图的哈,因为太容易了,我们等会儿直播见。就讲解这几天的疫情数据处理~

附件链接:https://t.zsxq.com/RByFmeq

# R

评论

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×