Skip to content

Instantly share code, notes, and snippets.

@lvalnegri

lvalnegri/app.R

Last active March 17, 2022 13:28
Show Gist options
  • Save lvalnegri/1c9ce936a917adadeed222a8543d4de0 to your computer and use it in GitHub Desktop.
Save lvalnegri/1c9ce936a917adadeed222a8543d4de0 to your computer and use it in GitHub Desktop.
Download ZIP
Covid Vaccines Adverse Reactions
Raw
app.R
dmpkg.funs::load_pkgs(c('data.table', 'DT', 'htmltools', 'shiny'))
dpath <- file.path(datauk_path, 'covid', 'vaccine')
dts <- fst::read_fst(file.path(dpath, 'vaccine_adverse_reactions'), as.data.table = TRUE)
dts[, rnk := NULL]
up_date <- format(as.Date(readLines(file.path(dpath, 'vaccine_adverse_reactions.date'))), '%d %B %Y')
js_footer <- function(x){
paste0(
'tot_', x, ' = api.column(', x, ', {search:"applied", page:"all"}).data().reduce(function(a, b){return a + b;})
$(api.column(', x, ').footer()).html(tot_', x, '.toLocaleString());'
)
}
ui <- fluidPage(
titlePanel('UK Covid Vaccines Yellow Card Reporting (potential adverse reactions)'), br(),
shinyWidgets::radioGroupButtons('rdb_grp', 'AGGREGATION:',
choices = c('None', 'Group', 'Class', 'Brand'),
individual = TRUE,
checkIcon = list(
yes = tags$i(class = "fa fa-circle", style = "color: steelblue"),
no = tags$i(class = "fa fa-circle-o", style = "color: steelblue")
)
), br(),
DTOutput('out_tbl')
)
server <- function(input, output, session){
dtbl <- reactive({
switch(input$rdb_grp,
'Group' = {
y <- dts[, .(Total = sum(Total), Fatal = sum(Fatal)), .(Brand, Class, Group)] %>%
dcast(Class+Group~Brand, value.var = c('Total', 'Fatal'), fill = 0)
setcolorder(y, c(
'Class', 'Group',
'Total_AstraZeneca', 'Fatal_AstraZeneca',
'Total_Pfizer', 'Fatal_Pfizer',
'Total_Moderna', 'Fatal_Moderna'
))
sketch <- withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'Class'),
th(rowspan = 2, 'Group'),
th(colspan = 2, span('AstraZeneca', style = "color:gold; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") ),
th(colspan = 2, span('Pfizer', style = "color:cyan; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") ),
th(colspan = 2, span('Moderna', style = "color:red; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") )
),
tr( th('Total'), th('Fatal'), th('Total'), th('Fatal'), th('Total'), th('Fatal') )
),
tableFooter(c('', 'TOTAL TABLE: ', 0, 0, 0, 0, 0, 0))
))
foot_dt <- paste(js_footer(2), js_footer(3), js_footer(4), js_footer(5), js_footer(6), js_footer(7))
},
'Class' = {
y <- dts[, .(Total = sum(Total), Fatal = sum(Fatal)), .(Brand, Class)] %>%
dcast(Class~Brand, value.var = c('Total', 'Fatal'), fill = 0)
setcolorder(y, c('Class', 'Total_AstraZeneca', 'Fatal_AstraZeneca', 'Total_Pfizer', 'Fatal_Pfizer', 'Total_Moderna', 'Fatal_Moderna'))
sketch <- withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'Class'),
th(colspan = 2, span('AstraZeneca', style = "color:gold; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") ),
th(colspan = 2, span('Pfizer', style = "color:cyan; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") ),
th(colspan = 2, span('Moderna', style = "color:red; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") )
),
tr(
th('Total', style = "text-align: center"), th('Fatal', style = "text-align: center"),
th('Total', style = "text-align: center"), th('Fatal', style = "text-align: center"),
th('Total', style = "text-align: center"), th('Fatal', style = "text-align: center")
)
),
tableFooter(c('TOTAL TABLE: ', 0, 0, 0, 0, 0, 0))
))
foot_dt <- paste(js_footer(1), js_footer(2), js_footer(3), js_footer(4), js_footer(5), js_footer(6))
},
'Brand' = {
y <- dts[, .(Total = sum(Total), Fatal = sum(Fatal)), Brand]
sketch <- withTags(table(
class = 'display',
thead( tr( th(colspan = 1, 'Brand'), th(colspan = 1, 'Total'), th(colspan = 1, 'Fatal') )),
tableFooter(c('TOTAL TABLE: ', 0, 0))
))
foot_dt <- paste(js_footer(1), js_footer(2))
},
{
y <- dcast(dts, Class+Group+Reaction~Brand, value.var = c('Total', 'Fatal'), fill = 0)
setcolorder(y, c('Class', 'Group', 'Reaction', 'Total_AstraZeneca', 'Fatal_AstraZeneca', 'Total_Pfizer', 'Fatal_Pfizer', 'Total_Moderna', 'Fatal_Moderna'))
sketch <- withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'Class'),
th(rowspan = 2, 'Group'),
th(rowspan = 2, 'Reaction'),
th(colspan = 2, span('AstraZeneca', style = "color:gold; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") ),
th(colspan = 2, span('Pfizer', style = "color:cyan; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") ),
th(colspan = 2, span('Moderna', style = "color:red; font-family:'times'; font-size:20pt; display:table; margin:0 auto;") )
),
tr( th('Total'), th('Fatal'), th('Total'), th('Fatal') , th('Total'), th('Fatal') )
),
tableFooter(c('', '', 'TOTAL TABLE: ', 0, 0, 0, 0, 0, 0))
))
foot_dt <- paste(js_footer(3), js_footer(4), js_footer(5), js_footer(6), js_footer(7), js_footer(8))
}
)
y[y == 0] <- NA
dt <- datatable(
y,
rownames = FALSE,
container = sketch,
selection = 'none',
class = 'cell-border nowrap',
extensions = c('Buttons', 'Scroller'),
caption = tags$caption(
style = 'caption-side:bottom;text-align:right;font-size:12px',
withTags(div(HTML(paste0(
'<em>Data From ',
'<a href="https://www.gov.uk/government/publications/coronavirus-covid-19-vaccine-adverse-reactions/coronavirus-vaccine-summary-of-yellow-card-reporting">MHRA UK</a>. ',
'Last Updated: ', up_date,
' (App code on <a href=" https://github.com/lvalnegri/shiny-uk_covid_vaccine_adverse_reactions">Github</a>)<em>'
))))
),
options = list(
scrollX = TRUE,
scrollY = 600,
scroller = TRUE,
ordering = TRUE,
searchHighlight = TRUE,
deferRender = TRUE,
# buttons = c('copy', 'csv', 'print'),
buttons = list( 'copy', 'print', list( extend = 'collection', buttons = c('csv', 'excel', 'pdf'), text = 'Download') ),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff', 'text-align': 'center', 'font-size': '120%'});",
"$(this.api().table().footer()).css({'background-color': '#000', 'color': '#fff', 'text-align': 'center', 'font-size': '120%'});",
"}"
),
footerCallback = JS(paste0(
"function( tfoot, data, start, end, display ) {",
"var api = this.api(), data;", foot_dt,
"}"
)),
dom = 'Biftp'
)
)
if(input$rdb_grp == 'Brand'){
dt <- dt %>% formatCurrency(c('Total', 'Fatal'), '', digits = 0)
} else {
dt <- dt %>% formatCurrency(c('Total_AstraZeneca', 'Fatal_AstraZeneca', 'Total_Pfizer', 'Fatal_Pfizer', 'Total_Moderna', 'Fatal_Moderna'), '', digits = 0)
}
dt
})
output$out_tbl <- renderDT( dtbl(), server = FALSE )
}
shinyApp( ui = ui, server = server )
Raw
data.R
########################################################
# CoViD-19 UK * DATA COVID - VACCINE ADVERSE REACTIONS #
########################################################
message('Validating update...')
url <- 'https://www.gov.uk/government/publications/coronavirus-covid-19-vaccine-adverse-reactions/coronavirus-vaccine-summary-of-yellow-card-reporting'
x1 <- as.Date(
gsub('Updated ', '', rvest::html_text(rvest::html_node(xml2::read_html(url),'.publication-header__last-changed'))),
'%d %B %Y'
)
x2 <- readLines(file.path(dmpkg.funs::datauk_path, 'covid', 'vaccine', 'vaccine_adverse_reactions.date'))
if(is.na(x1)) q(save = 'no')
if(x1==x2) q(save = 'no')
message('Loading packages...')
dmpkg.funs::load_pkgs(c('data.table', 'rvest'))
file.copy(
file.path(datauk_path,'covid', 'vaccine', 'vaccine_adverse_reactions'),
file.path(datauk_path,'covid', 'vaccine', paste0('vaccine_adverse_reactions_', x2))
)
lnks <- xml2::read_html(url) %>% html_nodes('.govuk-link') %>% html_attr('href')
brands <- c(
'Pfizer' = lnks[grepl('pfizer.*pdf', tolower(lnks))],
'AstraZeneca' = lnks[grepl('astra.*pdf', tolower(lnks))],
'Moderna' = gsub('draft-', '', lnks[grepl('moderna.*pdf', tolower(lnks))])
)
get_data <- function(x){
message('\nProcessing brand: ', names(x), '...')
message(' - Downloading file and extracting tables...')
y <- tabulizer::extract_tables(x, method = 'stream')
message(' - Processing output... ')
ydt <- data.table()
for(idx in 1:length(y)){
yt <- y[[idx]]
if(length(yt) > 1){
if(ncol(yt) > 3){
if(ncol(yt) == 4){
if(yt[1,2] == ''){
yt <- yt[, c(1, 3, 4)]
} else if(yt[1,4] == ''){
yt <- yt[, c(1, 2, 4)]
} else {
message('Format not recognized!')
}
} else if(ncol(yt) == 5){
yt <- yt[, c(1, 3, 5)]
} else {
message('Too many columns!')
}
}
yt <- if(nrow(yt) == 3) data.table(t(yt[-(1:2), ])) else data.table(yt[-(1:2), ])
ydt <- rbindlist(list( ydt, yt), use.names = FALSE)
}
}
message(' - Data Engineering... ')
ydt <- ydt[!grepl('^TOTAL', V1)]
ydt[, V4 := ifelse(V3 == '', V1, NA)][, V4 := zoo::na.locf(V4)]
ydt[, V5 := ifelse(grepl('TOTAL$', V1), V1, NA)][, V5 := zoo::na.locf(V5, fromLast = TRUE)]
ydt <- ydt[!(V3 == '' | grepl('TOTAL$', V1))]
ydt[, `:=`( V2 = as.integer(V2), V3 = as.integer(V3), 'Brand' = names(x) )]
setcolorder(ydt, c('Brand', 'V5', 'V4'))
setnames(ydt, c('Brand', 'Class', 'Group', 'Reaction', 'Total', 'Fatal'))
ydt[, Class := gsub(' SOC TOTAL', '', Class)]
}
ydt <- rbindlist(list( get_data(brands[1]), get_data(brands[2]), get_data(brands[3]) ))
message('Check totals...')
ydt[, .(Total = sum(Total), Fatal = sum(Fatal)), Brand]
ydt[, .(Total = sum(Total), Fatal = sum(Fatal)), .(Brand, Class)]
message('Add Rank over Total by Class... ')
ydt[, rnk := frank(-Total, ties.method = 'random'), .(Brand, Class)]
message('Writing datasets to files...')
fst::write_fst(ydt, file.path(datauk_path,'covid', 'vaccine', 'vaccine_adverse_reactions'))
writeLines(as.character(x1), file.path(datauk_path, 'covid', 'vaccine', 'vaccine_adverse_reactions.date'))
message('Done!')
rm(list = ls())
gc()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment