Available Beds for COVID-19 Patients in New Delhi
Data from: https://coronabeds.jantasamvad.org/index.html
Date accessed: 2021-04-29 06:37:54 IST | 2021-04-28 18:07:54 PDT
Number of available ICU beds for COVID-19 patients
Number of available beds: 18/4809 beds
Blue: hospitals with available COVID ICU beds
Red: hospitals whose COVID ICU beds are completely occupied
Radius of circles correspond to number of ICU beds for COVID patients at each hospital.
Number of available beds for COVID-19 patients
Number of available beds: 1635/21014 beds
Blue: hospitals with available COVID beds
Red: hospitals whose COVID beds are completely occupied
Radius of circles correspond to number of beds for COVID patients at each hospital.
Code for above
Scrape data from https://coronabeds.jantasamvad.org/index.html
# ==============================================================================
# * Date last run
# ==============================================================================
# 2021-04-28 18:07:13 PDT
# ==============================================================================
# * Workspace
# ==============================================================================
library(xml2)
library(dplyr)
library(rvest)
library(data.table)
library(leaflet)
# * Docker specifics
# ==============================================================================
system("open -a docker")
launch_dkr = "docker run -d -p 4445:4444 selenium/standalone-firefox"
shut_dkr = "docker stop $(docker ps -q)"
system(shut_dkr)
system(launch_dkr)
Sys.sleep(3)
# * Start Selenium
# ==============================================================================
remDr = RSelenium::remoteDriver(remoteServerAddr = "localhost",
port = 4445L,
browserName = "firefox")
remDr$open()
# * Navigate to website
# ==============================================================================
urls = c("https://coronabeds.jantasamvad.org/all-covid-icu-beds.html", "https://coronabeds.jantasamvad.org/beds.html")
covid_info_l = lapply(urls, function(url) {
remDr$navigate(url)
Sys.sleep(3)
# remDr$screenshot(display = TRUE)
covid_info = xml2::read_html(remDr$getPageSource()[[1]])
})
system(shut_dkr)
# Get hospital info
# ==============================================================================
hosp_info_l = lapply(covid_info_l, function(covid_info) {
hosp_loc = covid_info %>%
html_nodes(xpath = '//*[@id="hospitals_list"]/tr/th/a[1]') %>%
html_attr("href")
hosp_name = covid_info %>%
html_nodes(xpath = '//*[@id="hospitals_list"]/tr/th/a[2]/text()') %>%
html_text()
hosp_last_update = covid_info %>%
html_nodes(xpath = '//*[@id="hospitals_list"]/tr/td[1]/small/a') %>%
html_text()
hosp_total_bed = covid_info %>%
html_nodes(xpath = '//*[@id="hospitals_list"]/tr/td[2]/a') %>%
html_text() %>%
as.numeric()
hosp_vacant_bed = covid_info %>%
html_nodes(xpath = '//*[@id="hospitals_list"]/tr/td[3]/a[1]') %>%
html_text() %>%
as.numeric()
hosp_address = sapply(seq_along(hosp_name), function(n, covid_info) {
xpath_n = sprintf('//*[@id="collapse%s"]/td/div/div/p/text()', n)
covid_info %>%
html_nodes(xpath = xpath_n) %>%
html_text()
}, covid_info)
hosp_tel = sapply(seq_along(hosp_name), function(n, covid_info) {
xpath_n = sprintf('//*[@id="collapse%s"]/td/div/ul/li[2]/a', n)
tel = covid_info %>%
html_nodes(xpath = xpath_n) %>%
html_text()
tel = gsub(" ", "", tel)
tel = paste0(tel, collapse = "; ")
}, covid_info)
if(FALSE) {
tb = covid_info %>%
html_nodes(xpath = '/html/body/div/div[3]/table') %>%
html_table()
}
coords = lapply(hosp_loc, function(loc_url) {
print(loc_url)
if(loc_url != "" & grepl("@", loc_url) ) {
url_split = strsplit(loc_url, "/")[[1]]
which_coord = grepl("@", url_split)
coords = strsplit(
gsub("@", "", url_split[ which_coord ]),
",")[[1]][1:2] %>%
as.numeric()
data.frame(lat = coords[1],
lon = coords[2])
} else {
data.frame(lat = NA,
lon = NA)
}
}) %>%
rbindlist()
hosp_df = data.frame(name = hosp_name,
vacant = hosp_vacant_bed,
total = hosp_total_bed,
last_update = hosp_last_update,
address = hosp_address,
tel = hosp_tel)
hosp_df = cbind(hosp_df, coords)
})
timestamp = Sys.time() %>%
gsub(" ", "_", .) %>%
gsub(":", "-", .)
out_dir = file.path("content/post/data/delhi-covid")
if( !dir.exists(out_dir) ) dir.create(out_dir)
out_name = paste0("delhi-covid_", timestamp, "_PDT.RDS")
out_file = file.path(out_dir, out_name)
saveRDS(hosp_info_l, out_file)
Make searchable table and map
# ==============================================================================
# * Workspace
# ==============================================================================
library(xml2)
library(dplyr)
library(rvest)
library(data.table)
library(leaflet)
library(DT)
library(widgetframe)
library(kableExtra)
in_dir = "data/delhi-covid"
in_file = sort(list.files(in_dir, full.names = TRUE), decreasing = TRUE)[1]
hosp_info_l = readRDS(in_file)
# ==============================================================================
# Table
# ==============================================================================
tbls = lapply(hosp_info_l, function(hosp_df) {
hosp_df$percent_vac = round(hosp_df$vacant/hosp_df$total * 100, 2)
hosp_df$beds = ifelse(hosp_df$percent_vac > 0, "yes", "no")
pal = colorFactor(c("red", "#004EFF"), domain = c("yes", "no"))
tbl_cols = c("name", "beds", "vacant", "total", "last_update",
"address", "tel")
hosp_tbl = hosp_df[ tbl_cols ]
hosp_tbl$beds = factor(hosp_tbl$beds)
hosp_tbl = datatable(hosp_tbl,
filter = 'top',
extensions = list('Scroller', 'Buttons'),
rownames = FALSE,
colnames = c("Hospital", "Beds Available",
"Vacant beds", "Total beds",
"Last Updated", "Address", "Telephone"),
options = list(
pageLength = 15,
dom = 'Bfrtip',
scrollX = TRUE,
scroller = TRUE,
scrollY = TRUE,
autoWidth = TRUE,
order = list(list(2, 'desc')),
buttons = c('copy', 'csv', 'pdf')
)) %>%
formatStyle(names(hosp_tbl) ,"white-space"="nowrap") %>%
formatStyle(
'beds',
backgroundColor = styleEqual(
c("yes", "no"), c('#B6CCFF', '#FFBEBE')
)) %>%
formatStyle('beds', `text-align` = 'center')
})
# ==============================================================================
# Map
# ==============================================================================
maps = lapply(hosp_info_l, function(hosp_df) {
which_nocoords = is.na(hosp_df$lat)
hosp_df = hosp_df[ !which_nocoords, ]
hosp_df$percent_vac = round(hosp_df$vacant/hosp_df$total * 100, 2)
hosp_df$beds = ifelse(hosp_df$percent_vac > 0, "yes", "no")
hosp_df$size = round(sqrt(hosp_df$total))
hosp_df$size = ifelse(hosp_df$size > 15, 15, hosp_df$size)
hosp_df$labels = sprintf("<strong>%s</strong><p>Vacant beds: %s <br> Total beds: %s <br>
Percent vacant: %s%% <br> Address: %s <br> Tel: %s</p>",
hosp_df$name,
hosp_df$vacant,
hosp_df$total,
hosp_df$percent_vac,
hosp_df$address,
hosp_df$tel
) %>% lapply(htmltools::HTML)
map = leaflet() %>%
addTiles(group = "Light Map") %>%
addProviderTiles(providers$CartoDB.DarkMatter,
group = "Dark Map") %>%
addCircleMarkers(data = hosp_df[ hosp_df$beds %in% "no", ],
radius = ~size,
color = "red",
fillColor = "red",
label = ~labels,
popup = ~labels,
group = "No beds available") %>%
addCircleMarkers(data = hosp_df[ hosp_df$beds %in% "yes", ],
radius = ~size,
color = "#004EFF",
fillColor = "#004EFF",
fillOpacity = 0.75,
label = ~labels,
popup = ~labels,
group = "Beds available") %>%
addLayersControl(
baseGroups = c("Light Map", "Dark Map"),
overlayGroups = c("No beds available", "Beds available"),
options = layersControlOptions(collapsed = FALSE)
)
})