其他
通过数据看上海疫情
今天晚上就要开始住在医院里了，希望疫情赶紧结束吧…
数据来源于腾讯，用python爬虫爬下来的，大家可以后台回复20220317获取数据。
加载数据和R包
library(tidyverse)
## -- Attaching packages ----------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.6 v dplyr 1.0.8
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.0.1 v forcats 0.5.1
## -- Conflicts -------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
df <- read.csv("../000files/province_history_data.csv",encoding = "UTF-8")
看看数据有哪些内容：
names(df)
## [1] "X.U.FEFF.id" "year" "date" "country"
## [5] "province" "confirm" "dead" "heal"
## [9] "confirm_add" "confirm_cuts" "dead_cuts" "now_confirm_cuts"
## [13] "heal_cuts" "newConfirm" "newHeal" "newDead"
## [17] "description" "wzz" "wzz_add"
数据整理
筛选日期，确诊，无症状和新增相关的列。
dfsh <- df %>%
filter(year == "2022", province == "上海", date > 2.29) %>%
select(date, confirm, confirm_add, wzz, wzz_add)
names(dfsh)[2:5] <- c("确诊","新增确诊","无症状","新增无症状")
可视化
library(ggthemes)
dfsh1 <- dfsh %>%
pivot_longer(cols = -date, names_to = "type", values_to = "number")
p <- ggplot(dfsh1, aes(x = date, y = number, color = type))+
geom_line(aes(group = type),size = 1.5)+
scale_color_brewer(palette = "Set1", name = NULL)+
scale_x_continuous(breaks = seq(3.01,3.31,by=0.01),labels = sprintf("%0.2f",dfsh$date),name = NULL)+
theme_economist()+
theme(axis.text.x = element_text(angle = 90))
p
可以看到上海最近的疫情真的是很严重哦，每日新增确诊基本平稳，稍有上升趋势。确诊总数也只是在缓慢增加。
不过无症状嘛就很好看了！确诊无症状数量差不多是指数形式！新增无症状在3.20日后明显增加。
为了更清楚的看清确诊的趋势，单独拿出来画一个图：
dfsh1 <- dfsh %>%
select(date, contains("确诊")) %>%
pivot_longer(cols = -date, names_to = "type", values_to = "number")
ggplot(dfsh1, aes(x = date, y = number, color = type))+
geom_line(aes(group = type), size = 1.5)+
scale_color_brewer(palette = "Set1", name = NULL)+
scale_x_continuous(breaks = seq(3.01,3.31,by=0.01),labels = sprintf("%0.2f",dfsh$date),name = NULL)+
theme_economist()+
theme(axis.text.x = element_text(angle = 90))
这样就是一个很明显的上升趋势了，3.29日明显增多，因为3.28日浦东封了，全浦东大采样，所以明显变多！
昨天3.30日也是大采样，不过我写这篇推文时数据还没出来，封控多少应该是有点效果的！
再来一个简单的动图吧：
library(gganimate)
p + transition_reveal(date)
## Rendering [>--------------------------------------------] at 13 fps ~ eta: 8s
## 省略....
## Rendering [=========================================>---] at 13 fps ~ eta: 1s
## Rendering [=========================================>---] at 13 fps ~ eta: 0s
## Rendering [==========================================>--] at 13 fps ~ eta: 0s
## Rendering [===========================================>-] at 13 fps ~ eta: 0s
## Rendering [============================================>] at 13 fps ~ eta: 0s
## Rendering [=============================================] at 13 fps ~ eta: 0s
折线图的动图好像不太好看？来一个点图的动图版：
p1 <- ggplot(dfsh1, aes(x = date, y = number, color = type))+
geom_point(aes(size = number))+
scale_color_brewer(palette = "Set1", name = NULL)+
scale_x_continuous(breaks = seq(3.01,3.31,by=0.01),labels = sprintf("%0.2f",dfsh$date),name = NULL)+
scale_size(range = c(3,10), guide = "none")+
theme_economist()+
theme(axis.text.x = element_text(angle = 90))
p1
p1 + transition_time(date) + shadow_wake(wake_length = 0.2, alpha = 0.2)
## Rendering [>--------------------------------------------] at 14 fps ~ eta: 7s
## Rendering [=>-------------------------------------------] at 14 fps ~ eta: 7s
## 省略....
## Rendering [==========================================>--] at 13 fps ~ eta: 0s
## Rendering [===========================================>-] at 13 fps ~ eta: 0s
## Rendering [============================================>] at 13 fps ~ eta: 0s
## Rendering [=============================================] at 13 fps ~ eta: 0s
像不像小蝌蚪？
那么问题来了：
“按照这个趋势，你说4.5日解封有希望吗？
以上就是今天的内容，希望对你有帮助哦！欢迎点赞、在看、关注、转发！
欢迎在评论区留言或直接添加我的微信！
欢迎关注公众号：医学和生信笔记
“医学和生信笔记 公众号主要分享：1.医学小知识、肛肠科小知识；2.R语言和Python相关的数据分析、可视化、机器学习等；3.生物信息学学习资料和自己的学习笔记！
往期回顾
我的个人博客上线了！
R语言和网络药理学：批量处理ETCM的数据
2行代码重命名上百个列名！
长数据变为宽数据的7种情况！