covidTracker_flexdashboard.Rmd

---
title: "COVID-19 Global Case and Treatment Tracker"
resource_files:
- data/italy_regional_data/italy_032320.pdf
- data/italy_regional_data/italy_032320.xlsx
- data/italy_regional_data/italy.csv
- data/italy_regional_data/italy_041420.xlsx
- data/italy_regional_data/italy_041420.pdf
runtime: shiny
output:
  flexdashboard::flex_dashboard:
    favicon: favicon-32x32.png
    logo: university.shield.small.black.png
    orientation: column
    social: menu
    source_code: embed
    vertical_layout: fill
---

```{r global, include=FALSE}

#Packages <- c("tidyverse","shiny","magrittr","httr","plotly","rvest","tabulizer","XML","xml2","htmltab","pdftools","tesseract","leaflet","openxlsx","htmltools","shinydashboard","DT","geojsonio")
#lapply(Packages, library, character.only = TRUE)

library("tidyverse")
library("shiny")
library("magrittr")
library("httr")
library("plotly")
library("rvest")
library("tabulizer")
library("XML")
library("xml2")
library("htmltab")
library("pdftools")
library("tesseract")
library("leaflet")
library("xlsx")
library("htmltools")
library("shinydashboard")
library("DT")
library("geojsonio")

jhuCSSE <- read_html('https://github.com/CSSEGISandData/COVID-19/tree/master/csse_covid_19_data/csse_covid_19_daily_reports')
csvFiles<-sort(xpathSApply(htmlParse(jhuCSSE), "//a[contains(@class,'js-navigation-open')]/@href"))
githubLink<-paste("https://raw.githubusercontent.com",csvFiles[tail(grep("*.csv",csvFiles),n=1)],sep = "")%>%str_remove("/blob")

jhuData <- read.csv(githubLink) %>% mutate(Last.Update=as.character(Last_Update)) %>% mutate(Last.Update=parse_datetime(Last.Update,format="%Y-%m-%d %H:%M:%S",locale = locale(tz="GMT")),Active=Confirmed-Deaths-Recovered) %>% mutate(Source = "Johns Hopkins University CSSE") %>% rename(Province.State=Province_State,Country.Region=Country_Region,Latitude=Lat, Longitude=Long_) %>% select(Admin2,Province.State,Country.Region,Confirmed,Recovered,Deaths,Active,Latitude,Longitude,Source,Last.Update)


jhuCSSE2 <- read_html('https://github.com/CSSEGISandData/COVID-19/tree/master/csse_covid_19_data/csse_covid_19_time_series')
csvFiles<-sort(xpathSApply(htmlParse(jhuCSSE2), "//a[contains(@class,'js-navigation-open')]/@href"))

githubLinkConfirmed<-paste("https://raw.githubusercontent.com",csvFiles[grep("*confirmed_global.csv",csvFiles)],sep = "")%>%str_remove("/blob")

githubLinkDeaths<-paste("https://raw.githubusercontent.com",csvFiles[grep("*deaths_global.csv",csvFiles)],sep = "")%>%str_remove("/blob")

tsConfirmedData <- read.csv(githubLinkConfirmed) %>% rename(Latitude = Lat, Longitude = Long)%>%mutate(New.Cases = .[[ncol(.)]] - .[[ncol(.)-1]])
tsDeathsData <- read.csv(githubLinkDeaths) %>% rename(Latitude = Lat, Longitude = Long)%>%mutate(New.Deaths = .[[ncol(.)]] - .[[ncol(.)-1]])

newDayData <- merge(tsConfirmedData,tsDeathsData,by=c("Province.State","Country.Region"),all=T) %>% select(Province.State,Country.Region,New.Cases,New.Deaths)

# COVID Treatment and Vaccine Data

path_to_milken_pdf <- './data/vaccine_and_treatment_data/milken_tracker_data.pdf'
path_to_milken_xlsx <- './data/vaccine_and_treatment_data/milken_tracker_data.xlsx'
updateTime<-sub(".*Updated ", "", pdf_text(path_to_milken_pdf))[1]%>% substr(1,nchar(.)-1)%>%parse_datetime(format="%B %d, %Y, at %I:%M p.m.",locale = locale(tz="America/New_York"))

treatmentData<-read.xlsx(path_to_milken_xlsx,sheetIndex=1,startRow=10)%>%filter(Number!="Number")%>%mutate(Last.Update=updateTime)%>%drop_na("Type.of.Product...Treatment")

vaccineData<-read.xlsx(path_to_milken_xlsx,sheetIndex=2,startRow=2)%>%filter(Number!="Number")%>%mutate(Last.Update=updateTime)%>%drop_na("Type.of.Vaccine")

# US Department of State Travel Advisory
source("./functions/convertAdvisoryNames.R")

travelLink <-
  'https://travel.state.gov/content/travel/en/traveladvisories/traveladvisories.html/'
advisory <-htmltab(travelLink,which = 1) %>% mutate(Advisory = str_remove_all(Advisory, " Travel Advisory")) %>% rename(Country.Region = Advisory,Advisory.Level = Level,Advisory.DateUpdated = 'Date Updated') %>% convertAdvisoryNames(.)

# Italy (Ministero della Salute) Regional Data Scraping

source("./functions/convertItalyNames.R")

italy_Link <-
  'http://www.salute.gov.it/portale/nuovocoronavirus/dettaglioContenutiNuovoCoronavirus.jsp?lingua=italiano&id=5351&area=nuovoCoronavirus&menu=vuoto'
italy_web <- read_html(italy_Link)

italy_dateTim_updated <- italy_web %>% 
  rvest::html_nodes('body') %>% 
  xml2::xml_find_all("//h4[contains(@class, 'blu-italia-base-color') and contains(@style,'font-size:24px;margin:0;')]") %>% 
  rvest::html_text()%>%sub(".*: ", "", .)

path_to_italy_data <- "./data/italy_regional_data"
italy_pdfs <- sort(list.files(path_to_italy_data,"*.pdf",full.names=T))[-1]
italy_xlsx <- sort(list.files(path_to_italy_data,"*.xlsx",full.names=T))[-1]

italy_pdf_link <- xpathSApply(htmlParse(italy_Link), "//a[contains(@title,'apre file pdf')]/@href")[1]
italy_pdf_link<-paste('http://www.salute.gov.it',italy_pdf_link,sep = "")

italy_table <- read.xlsx(italy_xlsx,sheetIndex=1,startRow=4)%>%drop_na(2)%>%head(-1)%>%discard(~all(is.na(.x)))%>% select(c(1,6,7,8,5))%>% rename(Province.State=1,Recovered=2,Deaths=3,Confirmed=4,Active=5)%>%
mutate(Admin2="",Last.Update=parse_datetime(italy_dateTim_updated,format="%d %B %Y, ore %H.%M",locale = locale("it",tz="Europe/Rome")),Source="Ministry of Health of Italy")

italy_coords <-read.csv('https://simplemaps.com/static/data/country-cities/it/it.csv')%>%filter(capital == "admin" | capital == "primary")%>%rename(Province.State=admin,Country.Region=country,Latitude=lat,Longitude=lng)%>%select(Province.State,Country.Region,Latitude,Longitude)%>% mutate(Province.State=convertItalyNames(as.character(Province.State)))

italy_coords[length(italy_coords$Province.State),1]<-'Valle d\'Aosta'

italy_table<-merge(italy_table,italy_coords,by = c("Province.State"),all=TRUE)
bolIdx<-italy_table$Province.State == 'Bolzano'
italy_table[bolIdx,]$Country.Region <- 'Italy'
italy_table[bolIdx,]$Longitude <-11.35
italy_table[bolIdx,]$Latitude <- 46.5

# South Korea (보건복지부) Regional Data Scraping

sk_link <-'http://ncov.mohw.go.kr/bdBoardList_Real.do?brdId=1&brdGubun=13&ncvContSeq=&contSeq=&board_id=&gubun='

sk_web <- read_html(sk_link)
sk_dateTim_updated <- sk_web %>% 
  rvest::html_nodes('body') %>% 
  xml2::xml_find_all("//p[contains(@class, 'info')]") %>% 
  rvest::html_text()
sk_dateTim_updated<-sk_dateTim_updated[1]
sk_dateTim_updated<-substr(sk_dateTim_updated, 1, 9)
if (substr(sk_dateTim_updated, 1, 1) == " "){
  substr(sk_dateTim_updated, start = 1, stop = 1)<-"0"
}
sk_dateTim_updated<-paste(sk_dateTim_updated,substring(Sys.Date(),1,4))

sk_table<-htmltab(sk_link,which = 1)%>%tail(-1)%>%rename(Province.State=1,New.Cases=2,Confirmed=3,Recovered=4,Deaths=5,Incidence.Rate=6)%>%mutate(Province.State=c("Seoul","Busan","Daegu","Incheon","Gwangju","Daejeon","Ulsan","Sejong","Gyeonggi-do","Gangwon","Chungbuk","Chungnam","Jeonbuk","Jeonnam","Gyeongbuk","Gyeongnam","Jeju","Quarantined"))%>%select(Province.State,New.Cases,Confirmed,Recovered,Deaths)%>%mutate(Source="Ministry of Health and Welfare of the Republic of Korea")%>%mutate(Admin2="",Last.Update=parse_datetime(sk_dateTim_updated,format="%m.%d. %H %Y",locale = locale(tz="GMT")))
sk_table[, c("Confirmed","Recovered","Deaths")]<- sapply(sk_table[, c("Confirmed","Recovered","Deaths")], as.numeric)

sk_keep <- sk_table[,c("Province.State","New.Cases")] %>% mutate(Country.Region="Korea, South")
newDayData <- merge(newDayData,sk_keep,by = c("Province.State","Country.Region","New.Cases"),all=T)

sk_table<-select(sk_table,Province.State,Confirmed,Recovered,Deaths,Source,Admin2,Last.Update)%>%mutate(Active=Confirmed-Deaths-Recovered)

sk_coords <-read.csv('https://simplemaps.com/static/data/country-cities/kr/kr.csv')%>%filter(capital == "admin" | capital == "primary")%>%rename(Province.State=admin,Country.Region=country,Latitude=lat,Longitude=lng)%>%select(Province.State,Country.Region,Latitude,Longitude)

source("./functions/coordinates_sk.R")
sk_table<-merge(sk_table,sk_coords,by = c("Province.State"),all=TRUE)%>%mutate(Country.Region="Korea, South")%>%coordinates_sk(.)

covidData<-rbind(jhuData,italy_table,sk_table)%>%merge(.,advisory,by = c("Country.Region"),all=T) %>% drop_na(Confirmed)
new_adv <- rename(advisory, Province.State = Country.Region)
covidData<-merge(covidData,new_adv,by = c("Province.State","Advisory.Level","Advisory.DateUpdated"),all=T) %>% drop_na(Confirmed)%>%.[!(.$Country.Region=="Italy" & .$Source=="Johns Hopkins University CSSE") & !(.$Country.Region=="Korea, South" & .$Source=="Johns Hopkins University CSSE"),] %>% mutate(Country.Region=as.character(Country.Region))

covidData[is.na(covidData$Active),"Active"]<-covidData[is.na(covidData$Active),"Confirmed"]

covidData<-merge(covidData,newDayData,by=c("Province.State","Country.Region"),all=T) %>% drop_na(Confirmed)%>%arrange(.,desc(Active))

col_order <- c("Admin2","Country.Region", "Province.State", "Last.Update","Confirmed","Recovered","Deaths","Active","New.Cases","New.Deaths","Advisory.Level","Advisory.DateUpdated","Latitude","Longitude","Source")
covidData <- covidData[, col_order] 

rm(list=setdiff(ls(), c("covidData","treatmentData","vaccineData","tsConfirmedData","tsDeathsData","tsRecoveredData")))

```

Global Map
=======================================


Column {data-width=175}
-------------------------------------

### Last Update (GMT):

```{r }

valueBox(`attr<-`(Sys.time(),"tzone","GMT"),"",icon = icon("calendar"), width=NULL)
```


### Active Cases

```{r }
renderValueBox({
  if (input$countryChoice == "World"){
    val<-sum(covidData$Active,na.rm = T)
  } else {
    filtData<-covidData %>% filter(as.character(Country.Region) == input$countryChoice)
    val<-sum(filtData$Active,na.rm = T)
  }
  shinydashboard::valueBox(val,input$countryChoice, width=NULL)
})

```

### Confirmed Cases

```{r }

renderValueBox({
  if (input$countryChoice == "World"){
    val<-sum(covidData$Confirmed,na.rm = T)
  } else {
    filtData<-covidData %>% filter(as.character(Country.Region) == input$countryChoice)
    val<-sum(filtData$Confirmed,na.rm = T)
  }
  shinydashboard::valueBox(val,input$countryChoice,width=NULL)
})


```

### Deaths

```{r }

renderValueBox({
  if (input$countryChoice == "World"){
    val<-sum(covidData$Deaths,na.rm = T)
  } else {
    filtData<-covidData %>% filter(as.character(Country.Region) == input$countryChoice)
    val<-sum(filtData$Deaths,na.rm = T)
  }
  shinydashboard::valueBox(val,input$countryChoice,width=NULL)
})


```

### Recovered

```{r }

renderValueBox({
  if (input$countryChoice == "World"){
    val<-sum(covidData$Recovered,na.rm = T)
  } else {
    filtData<-covidData %>% filter(as.character(Country.Region) == input$countryChoice)
    val<-sum(filtData$Recovered,na.rm = T)
  }
  shinydashboard::valueBox(val,input$countryChoice,width=NULL)
})

```


Column {data-width=650}
-------------------------------------

### Cases by Geographical Location

```{r }

source('functions/correct_world_names.R')
source('functions/produce_labels.R')

worldcountry = geojson_read("./countries.geo.json", what = "sp")
worldcountry$name<-correct_world_names(worldcountry$name)

mutualCountries <- worldcountry$name[worldcountry$name %in% covidData$Country.Region]
advisoryFiltData <- filter(covidData,Country.Region %in% mutualCountries)
#
# qpal <- colorFactor("YlOrRd", (as.factor(advisoryFiltData$Advisory.Level)))
# polygons = worldcountry[worldcountry$name %in% covidData$Country.Region, ]

output$basemap<-renderLeaflet({leaflet(data = worldcountry,options = leafletOptions(minZoom = 2, maxZoom = 8)) %>%
  addProviderTiles(provider = providers$CartoDB.Positron) %>%
  addLayersControl(position = "bottomright",overlayGroups = c("Active", "Confirmed", "Recovered", "Deaths"),options = layersControlOptions(collapsed = FALSE))%>%
  hideGroup(c("Confirmed", "Recovered", "Deaths"))  %>%
  setView(lng = -92 ,lat=26,zoom = 3) %>%
  setMaxBounds(lng1 = -180,lat1 = -90,lng2 = 180,lat2 =90)%>%
  # addLegend("bottomright", pal = qpal, values = ~(as.factor(advisoryFiltData$Advisory.Level)), title = "<small>US DOS Travel Advisory Level</small>")%>%
  addCircleMarkers(data = covidData,radius=~log(Active),lng = ~Longitude,lat = ~Latitude,weight = ~(Active)**(1/3),color = "#662506",label = produce_labels(covidData),labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "15px", direction = "auto"),group = "Active")%>%
  addCircleMarkers(data = covidData,radius=~log(Confirmed),lng = ~Longitude,lat = ~Latitude,weight = ~(Confirmed)**(1/3),color = "#cc4c02",label = produce_labels(covidData),labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "15px", direction = "auto"),group = "Confirmed")%>%
  addCircleMarkers(data = covidData,radius=~log(Recovered),lng = ~Longitude,lat = ~Latitude,weight = ~(Recovered)**(1/3),color = "#045a8d",label = produce_labels(covidData),labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "15px", direction = "auto"),group = "Recovered")%>%
  addCircleMarkers(data = covidData,radius=~log(Deaths),lng = ~Longitude,lat = ~Latitude,weight = ~(Recovered)**(1/3),color = "#4d004b",label = produce_labels(covidData),labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),textsize = "15px", direction = "auto"),group = "Deaths")
})
# #
# # %>%addPolygons(data=polygons,stroke = F, smoothFactor = 0.1, fillOpacity = 1, fillColor = ~qpal(as.factor(as.factor(advisoryFiltData$Advisory.Level))))
#
#
leafletOutput('basemap')

```


Column {data-width=175}
-------------------------------------

<!-- ### 1.) Select Variable to Track -->

<!-- ```{r } -->

<!-- inputPanel(radioButtons("trackVar", label="COVID-19 Cases:",choices = list("Active","Confirmed","Deaths","Recovered"))) -->

<!-- ``` -->

### Filter by Country or Region:

```{r }

countryNames <- as.list(prepend(as.character(unique(covidData$Country.Region)),"World"))

inputPanel(selectInput("countryChoice", label = "Country or Region", choices = countryNames, selected = FALSE, width=180))

```

<!-- ### 3.) Submit or Reset Changes to World -->

<!-- ```{r } -->

<!-- inputPanel(actionButton("submit", "Submit")) -->
<!-- inputPanel(actionButton("reset", "Reset to World")) -->

<!-- ``` -->

Time-series Plots by Country
=======================================

Column {data-width=350}
-------------------------------------
### View Time-series for Confirmed Cases by Country:

```{r }
countryNames <- as.character(unique(covidData$Country.Region))

inputPanel(h4('Select region of interest'), selectInput("countryChoice_ts", label = "Country or Region", choices = countryNames, selected = FALSE, width=180))
```


Column
-------------------------------------
### Confirmed Cases
```{r }
names(tsConfirmedData) <- gsub("X", "", names(tsConfirmedData))
library(plyr)
tsConfirmedData_sum<- ddply(tsConfirmedData, "Country.Region", numcolwise(sum))
detach("package:plyr", unload = TRUE)
tsConfirmedData_sum<-tsConfirmedData_sum[c(-2,-3)]
tsConfirmedData_sum<- tsConfirmedData_sum[1:length(tsConfirmedData_sum)-1]
names(tsConfirmedData_sum)<-gsub("Country.Region", "Dates", names(tsConfirmedData_sum))
ts_confirmed <- reactive({
  tsConfirmedData_sum %>%
  filter(Dates==input$countryChoice_ts) %>%
  tidyr::gather(Dates)%>%
  mutate(Dates=format(as.POSIXct(as.Date(Dates, format="%m.%d.%y")+1),"%d %b %Y"))
})
#ts_confirmed()$Dates<-format(as.POSIXct(as.Date(ts_confirmed()$Dates, format="%m.%d.%y")),"%d %B %Y")
renderPlotly({
  ggplot(data=ts_confirmed(), aes(x=factor(Dates, levels=Dates),y=value)) +
  geom_line()+
  geom_point(colour = "blue")+
  #ggtitle("Confirmed Cases") +
  theme(axis.text.x=element_text(angle=90,hjust=1),panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),panel.background = element_blank(),
        axis.line = element_line(colour = "black"),plot.title = element_text(hjust = 0.5))+
  ylab('Number of Cases') +
  xlab('Date')
})
```


Treatments and Vaccines
=======================================
Column {data-width=350}
-------------------------------------
### Vaccine or Treatment Data

```{r}
radioButtons("radio_select",NULL, c("Vaccine Data"="vaccineData","Treatment Data"="treatmentData"), selected = NULL, inline=T)
vaccineData<-vaccineData%>%discard(~all(is.na(.x)))%>%select(-Number)
treatmentData<-treatmentData%>%discard(~all(is.na(.x)))%>%select(-Number)

DT::renderDataTable({
  data<-
    switch(input$radio_select,"vaccineData"=vaccineData,"treatmentData"=treatmentData) %>%
    discard(~all(is.na(.x)))
  DT::datatable(data,extensions = 'FixedColumns',
    options = list(
    bPaginate = FALSE,
    scrollX=TRUE,
    scrollY=400,
    fixedColumns = TRUE,
    columnDefs = list(list(className = 'dt-left', targets = "_all"))),
    rownames = FALSE
  )
})

# 
# %>%
#   rename("Type of Vaccine"= "Type.of.Vaccine",
#                                       "Developer"= "Developer.Researcher",
#                                       "Current Stage of Development"="Current.Stage.of.Development",
#                                       "Related Vaccine Platforms"="Related.Use.Platform",
#                                       "Funding Sources"="Funding.Sources",
#                                       "Anticipated Timing"="Anticipated.Timing",
#                                       "Data Sources"="Sources",
#                                       "Last Update"="Last.Update")
# 
# %>%
#   rename("Type of Treatment"="Type.of.Product...Treatment",
#          "Indications of FDA Approval"="FDA.Approved.Indications..Treatments.",
#          "Ongoing Clinical Trials for Other Diseases"="Clinical.Trials.Ongoing.for.Other.Diseases",
#          "Developer"="Developer..Researcher",
#          "Current Stage of Development"="Current.Stage.of.Development",
#          "Funding Sources"="Funding.Sources",
#          "Anticipated Timing"="Anticipated.Timing",
#           "Data Sources"="Sources",
#            "Last Update"="Last.Update")
```