Ncov 2019 Data Map

Created in January 30, 2020

2020   ·   rstats

2019-nCoV

Take Home:

  • Download the data:

/data

  • Epidemic map by provinces

/widgets/nCoV2019.html

  • Epidemic map by cities

/widgets/nCoV2019_cities.html

2019-nCov outbreak data

Script to extract latest 2019-nCov outbreak data from dxy.cn. Manually updated (2020-03-15)

Date source: https://3g.dxy.cn/newh5/view/pneumonia

library(rvest)
library(dplyr)
library(tidyr)
library(readr)
library(stringr)
library(jsonlite)

pneumonia <- read_html("https://3g.dxy.cn/newh5/view/pneumonia")
AreaStat <- pneumonia %>% html_nodes("#getAreaStat") %>% html_text() %>%
    str_replace("try \\{ window.getAreaStat =", "") %>%
    str_replace("\\}catch\\(e\\)\\{\\}", "") %>%
    fromJSON %>%
    rename(confirmedCount_sum = confirmedCount,
           suspectedCount_sum = suspectedCount,
           curedCount_sum = curedCount,
           deadCount_sum = deadCount,
           locationId_s = locationId) %>%
    unnest(cities, keep_empty = T, names_repair = "unique")

ChinaStat <- pneumonia %>% html_nodes("#getListByCountryTypeService1") %>% html_text() %>%
    str_replace("try \\{ window.getListByCountryTypeService1 =", "") %>%
    str_replace("\\}catch\\(e\\)\\{\\}", "") %>%
    fromJSON

## Error: lexical error: invalid char in json text.
##                                        NA
##                      (right here) ------^

IntStat <- pneumonia %>% html_nodes("#getListByCountryTypeService2") %>% html_text() %>%
    str_replace("try \\{ window.getListByCountryTypeService2 =", "") %>%
    str_replace("\\}catch\\(e\\)\\{\\}", "") %>%
    fromJSON

## Error: lexical error: invalid char in json text.
##                                        NA
##                      (right here) ------^

SumStat <- pneumonia %>% html_nodes("#getStatisticsService") %>% html_text() %>%
    str_replace("try \\{ window.getStatisticsService =", "") %>%
    str_replace("\\}catch\\(e\\)\\{\\}", "") %>%
    fromJSON

write_csv(AreaStat, paste0("data/AreaStat_dxy_", gsub("[ :]", "_", Sys.time()), ".csv"))
write_csv(ChinaStat, paste0("data/ChinaStat_dxy_", gsub("[ :]", "_", Sys.time()), ".csv"))

## Error in is.data.frame(x): object 'ChinaStat' not found

write_csv(IntStat, paste0("data/IntStat_dxy_", gsub("[ :]", "_", Sys.time()), ".csv"))

## Error in is.data.frame(x): object 'IntStat' not found

Epidemic report for China

library(knitr)
kable(head(ChinaStat))

## Error in head(ChinaStat): object 'ChinaStat' not found

Epidemic report for outside of China

kable(head(IntStat))

## Error in head(IntStat): object 'IntStat' not found

Epidemic map by leaflet 

library(leaflet)
##devtools::install_github("lchiffon/leafletCN")
library(leafletCN)
library(RColorBrewer)
library(htmltools)
library(htmlwidgets)
pn <- read_csv("data/province_name.csv")

## Parsed with column specification:
## cols(
##   provinceName = col_character(),
##   province = col_character()
## )

ChinaStat <- ChinaStat %>% left_join(pn, by = "provinceName")

## Error in eval(lhs, parent, parent): object 'ChinaStat' not found

map <- leafletGeo("china", ChinaStat, namevar = ~provinceName, valuevar = ~confirmedCount)

## Error in leafletGeo("china", ChinaStat, namevar = ~provinceName, valuevar = ~confirmedCount): object 'ChinaStat' not found

ChinaStat$provinceName[ChinaStat$provinceName==c("香港")] <- c("香港特别行政区")

## Error in ChinaStat$provinceName[ChinaStat$provinceName == c("香港")] <- c("香港特别行政区"): object 'ChinaStat' not found

ChinaStat$provinceName[ChinaStat$provinceName==c("澳门")] <- c("澳门特别行政区")

## Error in ChinaStat$provinceName[ChinaStat$provinceName == c("澳门")] <- c("澳门特别行政区"): object 'ChinaStat' not found

ChinaStat$provinceName[ChinaStat$provinceName==c("台湾")] <- c("台湾省")

## Error in ChinaStat$provinceName[ChinaStat$provinceName == c("台湾")] <- c("台湾省"): object 'ChinaStat' not found

map@data <- map@data %>% left_join(ChinaStat, by = c("name" = "provinceName"))

## Error in eval(lhs, parent, parent): object 'map' not found

bins <- c(1, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal <- colorBin("YlOrRd", domain = map$value, bins = bins)

## Error in colorBin("YlOrRd", domain = map$value, bins = bins): object 'map' not found

labs <- mapply(function(n, x, y, z, h){
    HTML(paste0(n, "<br>",
                "confirmedCount: ", x, "<br>",
                "curedCount: ", y, "<br>",
                "deadCount: ", z, "<br>",
                "updated: ", as.POSIXct(h / 1000, origin="1970-01-01")))
}, paste0(map$name, "(", map$province, ")"),
map$confirmedCount, map$curedCount, map$deadCount, map$modifyTime,
SIMPLIFY = FALSE, USE.NAMES = FALSE) ## must no name

## Error in paste0(map$name, "(", map$province, ")"): object 'map' not found

ll <- leaflet(map) %>% addTiles() %>%
    addPolygons(stroke = TRUE,
                smoothFactor = 1,
                fillOpacity = 0.7,
                weight = 1,
                fillColor = ~pal(value),
                color = "white",
                label = labs
                ) %>%    
    addLegend("bottomright", pal = pal, values = ~value,
              title = "confirmedCount") %>%
    addTitle(paste("2019-nCoV<br>",
                        "Confirmed Count:", SumStat$confirmedCount, "<br>",
                        "Suspected Count", SumStat$suspectedCount, "<br>",
                        "Cured Count:", SumStat$curedCount, "<br>",
                        "Dead Count:", SumStat$deadCount, "<br>",
                        "Updated:", as.POSIXct(SumStat$modifyTime / 1000,
                                               origin="1970-01-01")
                  ), fontSize = "12px",
             leftPosition = 80)

## Error in structure(list(options = options), leafletData = data): object 'map' not found

saveWidget(ll, "nCoV2019.html")

## Error in resolveSizing(x, x$sizingPolicy, standalone = standalone, knitrOptions = knitrOptions): object 'll' not found

file.rename("nCoV2019.html", "widgets/nCoV2019.html")

## Warning in file.rename("nCoV2019.html", "widgets/nCoV2019.html"): cannot
## rename file 'nCoV2019.html' to 'widgets/nCoV2019.html', reason 'No such file or
## directory'

## [1] FALSE

cmap <- leafletGeo("city")
AS <- AreaStat %>% filter(!provinceName %in% c("北京市", "上海市", "天津市", "重庆市", "香港", "台湾", "澳门"))
AS$cityName[which(AS$cityName == "神农架林区")] <- "神农架"
AS$cityName[which(AS$cityName == "恩施州")] <- "恩施"
AS$cityName[which(AS$cityName == "湘西自治州")] <- "湘西"
AS$cityName[which(AS$cityName == "黔南州")] <- "黔南"
AS$cityName[which(AS$cityName == "黔东南州")] <- "黔东南"
AS$cityName[which(AS$cityName == "黔西南州")] <- "黔西南"

cmap@data <- cmap@data %>% left_join(na.omit(AS), by = c("name" = "cityName"))
cmap@data[is.na(cmap@data)] <- 0
idx1 <- match(c("confirmedCount", "suspectedCount", "curedCount", "deadCount"), colnames(cmap@data))
idx2 <- match(c("confirmedCount", "suspectedCount", "curedCount", "deadCount"), colnames(ChinaStat))

## Error in is.data.frame(x): object 'ChinaStat' not found

cmap@data[cmap@data$name=="北京", idx1] <- ChinaStat[ChinaStat$provinceShortName=="北京", idx2]

## Error in eval(expr, envir, enclos): object 'ChinaStat' not found

cmap@data[cmap@data$name=="上海", idx1] <- ChinaStat[ChinaStat$provinceShortName=="上海", idx2]

## Error in eval(expr, envir, enclos): object 'ChinaStat' not found

cmap@data[cmap@data$name=="天津", idx1] <- ChinaStat[ChinaStat$provinceShortName=="天津", idx2]

## Error in eval(expr, envir, enclos): object 'ChinaStat' not found

cmap@data[cmap@data$name=="重庆", idx1] <- ChinaStat[ChinaStat$provinceShortName=="重庆", idx2]

## Error in eval(expr, envir, enclos): object 'ChinaStat' not found

cmap@data[cmap@data$name=="香港", idx1] <- ChinaStat[ChinaStat$provinceShortName=="香港", idx2]

## Error in eval(expr, envir, enclos): object 'ChinaStat' not found

cmap@data[cmap@data$name=="澳门", idx1] <- ChinaStat[ChinaStat$provinceShortName=="澳门", idx2]

## Error in eval(expr, envir, enclos): object 'ChinaStat' not found

clabs <- mapply(function(n, x, y, z, h){
    HTML(paste0(n, "<br>",
                "confirmedCount: ", x, "<br>",
                "curedCount: ", y, "<br>",
                "deadCount: ", z, "<br>"))
}, cmap$name, cmap$confirmedCount, cmap$curedCount, cmap$deadCount,
SIMPLIFY = FALSE, USE.NAMES = FALSE) ## must no name

llc <- leaflet(cmap) %>% addTiles() %>%
    addPolygons(stroke = TRUE,
                smoothFactor = 1,
                fillOpacity = 0.7,
                weight = 1,
                fillColor = ~pal(confirmedCount),
                color = "white",
                label = clabs
                ) %>%    
    addLegend("bottomright", pal = pal, values = ~confirmedCount,
              title = "confirmedCount") %>%
    addTitle(paste("2019-nCoV (mainland cities)<br>",
                        "Confirmed Count:", SumStat$confirmedCount, "<br>",
                        "Suspected Count", SumStat$suspectedCount, "<br>",
                        "Cured Count:", SumStat$curedCount, "<br>",
                        "Dead Count:", SumStat$deadCount, "<br>"),
             fontSize = "12px",
             leftPosition = 80)

## Error in pal(confirmedCount): could not find function "pal"

saveWidget(llc, "nCoV2019_cities.html")

## Error in resolveSizing(x, x$sizingPolicy, standalone = standalone, knitrOptions = knitrOptions): object 'llc' not found

file.rename("nCoV2019_cities.html", "widgets/nCoV2019_cities.html")

## Warning in file.rename("nCoV2019_cities.html", "widgets/nCoV2019_cities.html"):
## cannot rename file 'nCoV2019_cities.html' to 'widgets/nCoV2019_cities.html',
## reason 'No such file or directory'

## [1] FALSE

More links:

More detailed maps from Johns Hopkins: https://gisanddata.maps.arcgis.com/apps/opsdashboard/index.html#/bda7594740fd40299423467b48e9ecf6

WHO situation reports: https://www.who.int/emergencies/diseases/novel-coronavirus-2019/situation-reports/

github wuhan2020 project: https://github.com/wuhan2020/wuhan2020



Enjoy Reading This Article?

Here are some more articles you might like to read next:

  • cmdAgent
  • cmd2cwl
  • Question-Answering Engine with CrewAI and SearXNG
  • RAG with langchain and free google gemini
  • Retrieval augmented generation