inst/app/app.R
In ocelhay/AMULaos: App on Antimicrobial Use (AMU) in Laos.
# Load packages ----
library(bsplus)
library(DT)
library(formattable)
library(glue)
library(highcharter)
library(janitor)
library(knitr)
library(leaflet)
library(lubridate)
library(rgdal)
library(shiny)
library(shinyBS)
library(shinythemes)
library(shinyWidgets)
library(tidyverse)
library(readxl)
library(vov)
source("./www/fun_test_data_odk.R", local = TRUE)
coords <- read.csv("www/data/hospital_geo_coordinates.csv", stringsAsFactors = FALSE)
shp_lao_provinces <- readOGR("www/data/shapefiles/provinces.shp")
antimicrobial <- read_xlsx("./www/data/antimicrobial_matrix_2020-03-06.xlsx") %>%
rename(antimicrobial_class = `Antimicrobial classes`,
antimicrobial_sub_class = `Antimicrobial sub_classes`,
antiname = `Antimicrobial agent`)
source("./www/prepare_data_odk.R", local = TRUE)
patient <- left_join(patient, antimicrobial,
by = c("antiname" = "antiname")) %>%
replace_na(list(antimicrobial_class = "Unknown", antimicrobial_sub_class = "Unknown"))
# For filters
hospitals_list <- ward %>% pull(hospcd) %>% unique() %>% sort()
date_survey_vec <- c(ward %>% pull(surdate) %>% min(),
ward %>% pull(surdate) %>% max())
specialty_list <- patient %>% pull(specialty) %>% unique() %>% sort()
antimicrobial_class_list <- patient %>% group_by(antimicrobial_class) %>% count() %>% arrange(desc(n)) %>% pull(antimicrobial_class)
colors_ipd_opd <<- c("IPD" = "#af8dc3", "OPD" = "#f1a340") # middle
colors_ipd <<- c("#e7d4e8", "#762a83") # low, high
colors_opd <<- c("#fee0b6", "#b35806")
# Define UI ----
ui <- fluidPage(
# Add favicon
tags$head(tags$link(rel = 'shortcut icon', href = 'www/favicon.ico')),
title = "AMU Laos | Antimicrobial Usage in Laos",
theme = shinytheme("flatly"),
shinyWidgets::chooseSliderSkin('HTML5'),
includeCSS("./www/styles.css"),
use_vov(),
fluidRow(
# Sidebar ----
column(width = 3,
tags$a(href='https://www.tropmedres.ac/units/lomwru-lao-pdr', tags$img(src = 'LOMWRU.jpg', class = 'logo')),
conditionalPanel(condition = "input.tabs == 'welcome'",
br(),
h4("AMU Laos Dashboard: Explore Antimicrobial Usage in Laos"),
# br(),
# prettySwitch("app_data", "Use App Data", value = TRUE, status = "danger"),
# conditionalPanel("input.app_data",
# p("You are using 'App Data', unselect to upload your own data.")
# ),
# conditionalPanel("!input.app_data",
# h4(icon("file-upload"), "Upload Data"),
# p("Upload", strong(" one or several files "), "with PPS data. Content of all provided files will be automatically merged."),
# fileInput("file_upload", label = NULL, accept = ".xlsx", multiple = TRUE, buttonLabel = "Upload Data (.xlsx)")
# )
),
conditionalPanel(condition = "input.tabs != 'welcome'",
div(id = "floatingfilter",
div(class = "box_outputs",
h4(icon("filter"), "Filter Data:"),
prettyCheckboxGroup(inputId = "filter_age_category", label = "Age Categories:",
status = "primary", inline = TRUE,
choices = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown"),
selected = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown")),
pickerInput(inputId = "filter_hospitals", label = "Hospitals:", multiple = TRUE,
choices = hospitals_list, selected = hospitals_list,
options = list(
`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
dateRangeInput("filter_date_survey", label = "Range of Dates of Survey:",
start = date_survey_vec[1], end = date_survey_vec[2], startview = "year"),
prettyCheckboxGroup(inputId = "filter_ipd_opd", label = "Inpatient/Outpatient:",
shape = "curve", status = "primary", inline = TRUE,
choices = c("Inpatient", "Outpatient"), selected = c("Inpatient", "Outpatient")),
pickerInput(inputId = "filter_specialty", label = "Specialty:", multiple = TRUE,
choices = specialty_list, selected = specialty_list,
options = list(
`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
pickerInput(inputId = "filter_antimicrobial_class", label = "Antimicrobial Classes:", multiple = TRUE,
choices = antimicrobial_class_list, selected = antimicrobial_class_list,
options = list(
`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
br(),
htmlOutput("feedback_filters"),
div(class = "right",
actionLink(inputId = "reset_filters", label = span(icon("times"), " Reset Filters"))
)
)
)
)
),
# Main Content ----
column(width = 9,
navbarPage(NULL, id = "tabs", windowTitle = "AMU Laos", collapsible = TRUE,
tabPanel("Welcome", value = "welcome",
fluidRow(
column(6,
h4("About the AMU Laos Project"),
bs_accordion(id = "amu_info") %>%
bs_set_opts(panel_type = "default", use_heading_link = TRUE) %>%
bs_append(title = "What do we know about antimicrobial use (AMU) in hospital in Laos?", content = includeMarkdown('www/markdown/amu_info_1.md')) %>%
bs_append(title = "Why is it needed?", content = includeMarkdown('www/markdown/amu_info_2.md')) %>%
bs_append(title = "Where is surveillance being done?", content = includeMarkdown('www/markdown/amu_info_3.md')) %>%
bs_append(title = "Acknowledgements & Credits", content = includeMarkdown('www/markdown/amu_credits.md')) %>%
bs_append(title = "Contact", content = includeMarkdown('www/markdown/amu_contact.md')) %>%
bs_append(title = "Disclaimer", content = includeMarkdown('www/markdown/amu_disclaimer.md')),
),
column(5, offset = 1,
h4("Prescriptions per hospitals"),
htmlOutput("text_map"),
leafletOutput("welcome_map", height = 450)
),
)
),
tabPanel("AMU in Laos", value = "tab_1",
downloadLink("report", label = span(icon("file-word"), "Generate Report (.docx)")),
fluidRow(
column(3, br(), htmlOutput("n_overview_patient"),
br(), htmlOutput("n_overview_prescriptions"),
br(), htmlOutput("n_overview_survey")
),
column(9,
div(class = "box_outputs",
h4("Patients Receiving an Antimicrobial Prescription"),
radioButtons(inputId = "period_display", label = NULL, inline = TRUE,
choices = c("per Year" = "year", "per Quarter" = "quarter")),
highchartOutput("tab_1_patients_quarter"),
span(icon("lightbulb"), "Tip: to show the evolution of prescriptions for a subset of patients (e.g. outpatients prescribed with Beta lactams antimicrobials),
filter the data.")
)
)
),
div(class = "box_outputs",
h4("Purpose of Antimicrobial Prescriptions"),
fluidRow(
column(6,
highchartOutput("tab_1_purpose_IPD"),
formattableOutput("tab_1_table_purpose_IPD")),
column(6, highchartOutput("tab_1_purpose_OPD"),
formattableOutput("tab_1_table_purpose_OPD"))
),
),
fluidRow(
column(6,
div(class = "box_outputs",
h4("Prescribed Antimicrobial Agents per Patient"),
highchartOutput("tab_1_number_prescribed")
)
),
column(6,
div(class = "box_outputs",
h4("Route of Given Antimicrobials"),
highchartOutput("tab_1_route"))
)
),
div(class = "box_outputs",
h4("Antimicrobial Prescriptions"),
radioButtons(inputId = "var_pivot", label = NULL, inline = TRUE,
choices = c("by Age Category" = "age_category", "by Specialty" = "specialty",
"by Antimicobial Class" = "antimicrobial_class",
"by Antimicrobial Sub-Class" = "antimicrobial_sub_class")),
htmlOutput("feedback_subclass"),
fluidRow(
column(6, highchartOutput("tab_1_prescriptions_var_IPD")),
column(6, highchartOutput("tab_1_prescriptions_var_OPD"))
)
),
div(class = "box_outputs",
h4("Antimicrobial Prescriptions per Diagnosis"),
fluidRow(
column(6, highchartOutput("tab_1_prescriptions_diagnosis_IPD")),
column(6, highchartOutput("tab_1_prescriptions_diagnosis_OPD"))
)
),
fluidRow(
column(12,
div(class = "box_outputs",
h4("Antimicrobial Prescriptions per Class"),
dataTableOutput("tab_1_table_antimicrobial")
)
)
)
)
)
)
)
)
# Define server logic ----
server <- function(input, output, session) {
# Stop the shiny app when the browser window is closed.
session$onSessionEnded(function() {
stopApp()
})
# Reactive data management ----
data_provided <- reactiveVal(TRUE)
patients <- reactiveVal(patient)
wards <- reactiveVal(ward)
patients_filter <- reactive(
patients() %>%
filter(age_category %in% input$filter_age_category,
hospcd %in% input$filter_hospitals,
surdate >= input$filter_date_survey[1],
surdate <= input$filter_date_survey[2],
ipdopd %in% input$filter_ipd_opd,
specialty %in% input$filter_specialty,
antimicrobial_class %in% input$filter_antimicrobial_class)
)
wards_filter <- reactive(
wards() %>%
filter(hospcd %in% input$filter_hospitals,
surdate >= input$filter_date_survey[1],
surdate <= input$filter_date_survey[2],
ipdopd %in% input$filter_ipd_opd,
specialty %in% input$filter_specialty)
)
# Source code to generate outputs ----
file_list <- list.files(path = "./www/R_output", pattern = "*.R")
for (file in file_list) source(paste0("./www/R_output/", file), local = TRUE)$value
# Reset all filters.
observeEvent(input$reset_filters, {
updatePrettyCheckboxGroup(session = session, inputId = "filter_age_category", inline = TRUE,
choices = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown"),
selected = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown"))
updatePrettyCheckboxGroup(session = session, inputId = "filter_ipd_opd", inline = TRUE,
choices = c("Inpatient", "Outpatient"), selected = c("Inpatient", "Outpatient"))
# As in the update filters above.
hospitals_list <- patients() %>% pull(hospcd) %>% unique() %>% sort()
updatePickerInput(session = session, inputId = "filter_hospitals",
choices = hospitals_list, selected = hospitals_list)
date_survey_vec <- c(patients() %>% pull(surdate) %>% min(),
patients() %>% pull(surdate) %>% max())
updateDateRangeInput(session = session, inputId = "filter_date_survey",
start = date_survey_vec[1], end = date_survey_vec[2])
specialty_list <- patients() %>% pull(specialty) %>% unique() %>% sort()
updatePickerInput(session = session, inputId = "filter_specialty",
choices = specialty_list, selected = specialty_list)
antimicrobial_class_list <- patients() %>% group_by(antimicrobial_class) %>% count() %>% arrange(desc(n)) %>% pull(antimicrobial_class)
updatePickerInput(session = session, inputId = "filter_antimicrobial_class",
choices = antimicrobial_class_list, selected = antimicrobial_class_list)
})
# Events on selection or non-selection of "Use App Data"
# observe(
# if(input$app_data == TRUE){
# data_provided(TRUE)
# patients(patient)
# wards(ward)
# msg <- test_data_odk(patients(), wards())
# if(!is.null(msg)) showNotification(msg, type = "error", duration = NULL)
# showTab(inputId = "tabs", target = "tab_1")
# }
# )
#
# observe(
# if(input$app_data == FALSE){
# data_provided(FALSE)
# patients(NULL)
# wards(NULL)
# hideTab(inputId = "tabs", target = "tab_1")
# }
# )
# Events on upload of files ----
# observeEvent(input$file_upload, ignoreNULL = TRUE, ignoreInit = TRUE, {
# dta <- NULL
# test_format <- TRUE
#
# # Test of the format of provided files is correct.
# for(nr in 1:length(input$file_upload[, 1])) {
# temp_dta <- read_excel(input$file_upload[[nr, 'datapath']])
#
# expected_column_names <- c("label", "round", "hospcd", "hospital_district",
# "hospital_province", "surveyor1", "surveyor2", "surveyor3", "surdate",
# "ward", "specialty", "age_year", "age_month", "age_day", "antiname",
# "route", "diasite", "typeind", "reason", "stop_review",
# "treatment", "ipdopd")
#
# ifelse(all(names(temp_dta) %in% expected_column_names, expected_column_names %in% names(temp_dta)),
# dta <- rbind(dta, temp_dta),
# test_format <- FALSE)
# }
#
# if(!test_format) {
# showNotification(id = "format", ui = "The format of (at least) one of the provided file isn't correct. Please reupload.",
# type = "error", duration = NULL)
# }
#
# if(test_format) {
# removeNotification(id = "format")
# showNotification(ui = "Data uploaded and in correct format!", type = "message")
#
# source("./www/prepare_data.R", local = TRUE)
# patients(dta)
#
# data_provided(TRUE)
#
# # Update filters.
# hospitals_list <- patients() %>% pull(hospcd) %>% unique() %>% sort()
# updatePickerInput(session = session, inputId = "filter_hospitals",
# choices = hospitals_list, selected = hospitals_list)
#
# date_survey_vec <- c(patients() %>% pull(surdate) %>% min(),
# patients() %>% pull(surdate) %>% max())
# updateDateRangeInput(session = session, inputId = "filter_date_survey",
# start = date_survey_vec[1], end = date_survey_vec[2])
#
# specialty_list <- patients() %>% pull(specialty) %>% unique() %>% sort()
# updatePickerInput(session = session, inputId = "filter_specialty",
# choices = specialty_list, selected = specialty_list)
#
# antimicrobial_class_list <- patients() %>% group_by(antimicrobial_class) %>% count() %>% arrange(desc(n)) %>% pull(antimicrobial_class)
# updatePickerInput(session = session, inputId = "filter_antimicrobial_class",
# choices = antimicrobial_class_list, selected = antimicrobial_class_list)
#
# # Show tab 1.
# showTab(inputId = "tabs", target = "tab_1")
# }
# })
# Report Generation ----
feedback_download <- reactiveValues(download_flag = 0)
output$report <- downloadHandler(
filename = "AMU in Laos Report.docx",
content = function(file) {
feedback_download$download_flag <- feedback_download$download_flag + 1
if(feedback_download$download_flag > 0) {
showNotification(HTML("Generation of the report typically takes 5 to 30 seconds"), duration = NULL, type = "message", id = "report_generation", session = session)
}
tempReport <- file.path(tempdir(), "report.Rmd")
tempLogo <- file.path(tempdir(), "LOMWRU.jpg")
file.copy("./www/report/report.Rmd", tempReport, overwrite = TRUE)
file.copy("./www/LOMWRU.jpg", tempLogo, overwrite = TRUE)
rmarkdown::render(tempReport, output_file = file)
removeNotification(id = "report_generation", session = session)
showNotification(HTML("Report Generated"), duration = 4, type = "message", id = "report_generated", session = session)
}
)
}
# Return the App ----
shinyApp(ui = ui, server = server)
ocelhay/AMULaos documentation built on Oct. 29, 2020, 5:54 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Load packages ----
library(bsplus)
library(DT)
library(formattable)
library(glue)
library(highcharter)
library(janitor)
library(knitr)
library(leaflet)
library(lubridate)
library(rgdal)
library(shiny)
library(shinyBS)
library(shinythemes)
library(shinyWidgets)
library(tidyverse)
library(readxl)
library(vov)
source("./www/fun_test_data_odk.R", local = TRUE)
coords <- read.csv("www/data/hospital_geo_coordinates.csv", stringsAsFactors = FALSE)
shp_lao_provinces <- readOGR("www/data/shapefiles/provinces.shp")
antimicrobial <- read_xlsx("./www/data/antimicrobial_matrix_2020-03-06.xlsx") %>%
rename(antimicrobial_class = `Antimicrobial classes`,
antimicrobial_sub_class = `Antimicrobial sub_classes`,
antiname = `Antimicrobial agent`)
source("./www/prepare_data_odk.R", local = TRUE)
patient <- left_join(patient, antimicrobial,
by = c("antiname" = "antiname")) %>%
replace_na(list(antimicrobial_class = "Unknown", antimicrobial_sub_class = "Unknown"))
# For filters
hospitals_list <- ward %>% pull(hospcd) %>% unique() %>% sort()
date_survey_vec <- c(ward %>% pull(surdate) %>% min(),
ward %>% pull(surdate) %>% max())
specialty_list <- patient %>% pull(specialty) %>% unique() %>% sort()
antimicrobial_class_list <- patient %>% group_by(antimicrobial_class) %>% count() %>% arrange(desc(n)) %>% pull(antimicrobial_class)
colors_ipd_opd <<- c("IPD" = "#af8dc3", "OPD" = "#f1a340") # middle
colors_ipd <<- c("#e7d4e8", "#762a83") # low, high
colors_opd <<- c("#fee0b6", "#b35806")
# Define UI ----
ui <- fluidPage(
# Add favicon
tags$head(tags$link(rel = 'shortcut icon', href = 'www/favicon.ico')),
title = "AMU Laos | Antimicrobial Usage in Laos",
theme = shinytheme("flatly"),
shinyWidgets::chooseSliderSkin('HTML5'),
includeCSS("./www/styles.css"),
use_vov(),
fluidRow(
# Sidebar ----
column(width = 3,
tags$a(href='https://www.tropmedres.ac/units/lomwru-lao-pdr', tags$img(src = 'LOMWRU.jpg', class = 'logo')),
conditionalPanel(condition = "input.tabs == 'welcome'",
br(),
h4("AMU Laos Dashboard: Explore Antimicrobial Usage in Laos"),
# br(),
# prettySwitch("app_data", "Use App Data", value = TRUE, status = "danger"),
# conditionalPanel("input.app_data",
# p("You are using 'App Data', unselect to upload your own data.")
# ),
# conditionalPanel("!input.app_data",
# h4(icon("file-upload"), "Upload Data"),
# p("Upload", strong(" one or several files "), "with PPS data. Content of all provided files will be automatically merged."),
# fileInput("file_upload", label = NULL, accept = ".xlsx", multiple = TRUE, buttonLabel = "Upload Data (.xlsx)")
# )
),
conditionalPanel(condition = "input.tabs != 'welcome'",
div(id = "floatingfilter",
div(class = "box_outputs",
h4(icon("filter"), "Filter Data:"),
prettyCheckboxGroup(inputId = "filter_age_category", label = "Age Categories:",
status = "primary", inline = TRUE,
choices = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown"),
selected = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown")),
pickerInput(inputId = "filter_hospitals", label = "Hospitals:", multiple = TRUE,
choices = hospitals_list, selected = hospitals_list,
options = list(
`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
dateRangeInput("filter_date_survey", label = "Range of Dates of Survey:",
start = date_survey_vec[1], end = date_survey_vec[2], startview = "year"),
prettyCheckboxGroup(inputId = "filter_ipd_opd", label = "Inpatient/Outpatient:",
shape = "curve", status = "primary", inline = TRUE,
choices = c("Inpatient", "Outpatient"), selected = c("Inpatient", "Outpatient")),
pickerInput(inputId = "filter_specialty", label = "Specialty:", multiple = TRUE,
choices = specialty_list, selected = specialty_list,
options = list(
`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
pickerInput(inputId = "filter_antimicrobial_class", label = "Antimicrobial Classes:", multiple = TRUE,
choices = antimicrobial_class_list, selected = antimicrobial_class_list,
options = list(
`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
br(),
htmlOutput("feedback_filters"),
div(class = "right",
actionLink(inputId = "reset_filters", label = span(icon("times"), " Reset Filters"))
)
)
)
)
),
# Main Content ----
column(width = 9,
navbarPage(NULL, id = "tabs", windowTitle = "AMU Laos", collapsible = TRUE,
tabPanel("Welcome", value = "welcome",
fluidRow(
column(6,
h4("About the AMU Laos Project"),
bs_accordion(id = "amu_info") %>%
bs_set_opts(panel_type = "default", use_heading_link = TRUE) %>%
bs_append(title = "What do we know about antimicrobial use (AMU) in hospital in Laos?", content = includeMarkdown('www/markdown/amu_info_1.md')) %>%
bs_append(title = "Why is it needed?", content = includeMarkdown('www/markdown/amu_info_2.md')) %>%
bs_append(title = "Where is surveillance being done?", content = includeMarkdown('www/markdown/amu_info_3.md')) %>%
bs_append(title = "Acknowledgements & Credits", content = includeMarkdown('www/markdown/amu_credits.md')) %>%
bs_append(title = "Contact", content = includeMarkdown('www/markdown/amu_contact.md')) %>%
bs_append(title = "Disclaimer", content = includeMarkdown('www/markdown/amu_disclaimer.md')),
),
column(5, offset = 1,
h4("Prescriptions per hospitals"),
htmlOutput("text_map"),
leafletOutput("welcome_map", height = 450)
),
)
),
tabPanel("AMU in Laos", value = "tab_1",
downloadLink("report", label = span(icon("file-word"), "Generate Report (.docx)")),
fluidRow(
column(3, br(), htmlOutput("n_overview_patient"),
br(), htmlOutput("n_overview_prescriptions"),
br(), htmlOutput("n_overview_survey")
),
column(9,
div(class = "box_outputs",
h4("Patients Receiving an Antimicrobial Prescription"),
radioButtons(inputId = "period_display", label = NULL, inline = TRUE,
choices = c("per Year" = "year", "per Quarter" = "quarter")),
highchartOutput("tab_1_patients_quarter"),
span(icon("lightbulb"), "Tip: to show the evolution of prescriptions for a subset of patients (e.g. outpatients prescribed with Beta lactams antimicrobials),
filter the data.")
)
)
),
div(class = "box_outputs",
h4("Purpose of Antimicrobial Prescriptions"),
fluidRow(
column(6,
highchartOutput("tab_1_purpose_IPD"),
formattableOutput("tab_1_table_purpose_IPD")),
column(6, highchartOutput("tab_1_purpose_OPD"),
formattableOutput("tab_1_table_purpose_OPD"))
),
),
fluidRow(
column(6,
div(class = "box_outputs",
h4("Prescribed Antimicrobial Agents per Patient"),
highchartOutput("tab_1_number_prescribed")
)
),
column(6,
div(class = "box_outputs",
h4("Route of Given Antimicrobials"),
highchartOutput("tab_1_route"))
)
),
div(class = "box_outputs",
h4("Antimicrobial Prescriptions"),
radioButtons(inputId = "var_pivot", label = NULL, inline = TRUE,
choices = c("by Age Category" = "age_category", "by Specialty" = "specialty",
"by Antimicobial Class" = "antimicrobial_class",
"by Antimicrobial Sub-Class" = "antimicrobial_sub_class")),
htmlOutput("feedback_subclass"),
fluidRow(
column(6, highchartOutput("tab_1_prescriptions_var_IPD")),
column(6, highchartOutput("tab_1_prescriptions_var_OPD"))
)
),
div(class = "box_outputs",
h4("Antimicrobial Prescriptions per Diagnosis"),
fluidRow(
column(6, highchartOutput("tab_1_prescriptions_diagnosis_IPD")),
column(6, highchartOutput("tab_1_prescriptions_diagnosis_OPD"))
)
),
fluidRow(
column(12,
div(class = "box_outputs",
h4("Antimicrobial Prescriptions per Class"),
dataTableOutput("tab_1_table_antimicrobial")
)
)
)
)
)
)
)
)
# Define server logic ----
server <- function(input, output, session) {
# Stop the shiny app when the browser window is closed.
session$onSessionEnded(function() {
stopApp()
})
# Reactive data management ----
data_provided <- reactiveVal(TRUE)
patients <- reactiveVal(patient)
wards <- reactiveVal(ward)
patients_filter <- reactive(
patients() %>%
filter(age_category %in% input$filter_age_category,
hospcd %in% input$filter_hospitals,
surdate >= input$filter_date_survey[1],
surdate <= input$filter_date_survey[2],
ipdopd %in% input$filter_ipd_opd,
specialty %in% input$filter_specialty,
antimicrobial_class %in% input$filter_antimicrobial_class)
)
wards_filter <- reactive(
wards() %>%
filter(hospcd %in% input$filter_hospitals,
surdate >= input$filter_date_survey[1],
surdate <= input$filter_date_survey[2],
ipdopd %in% input$filter_ipd_opd,
specialty %in% input$filter_specialty)
)
# Source code to generate outputs ----
file_list <- list.files(path = "./www/R_output", pattern = "*.R")
for (file in file_list) source(paste0("./www/R_output/", file), local = TRUE)$value
# Reset all filters.
observeEvent(input$reset_filters, {
updatePrettyCheckboxGroup(session = session, inputId = "filter_age_category", inline = TRUE,
choices = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown"),
selected = c("< 1 y.o.", "1 to 5 y.o.", "5 to 15 y.o.", "> 15 y.o.", "Unknown"))
updatePrettyCheckboxGroup(session = session, inputId = "filter_ipd_opd", inline = TRUE,
choices = c("Inpatient", "Outpatient"), selected = c("Inpatient", "Outpatient"))
# As in the update filters above.
hospitals_list <- patients() %>% pull(hospcd) %>% unique() %>% sort()
updatePickerInput(session = session, inputId = "filter_hospitals",
choices = hospitals_list, selected = hospitals_list)
date_survey_vec <- c(patients() %>% pull(surdate) %>% min(),
patients() %>% pull(surdate) %>% max())
updateDateRangeInput(session = session, inputId = "filter_date_survey",
start = date_survey_vec[1], end = date_survey_vec[2])
specialty_list <- patients() %>% pull(specialty) %>% unique() %>% sort()
updatePickerInput(session = session, inputId = "filter_specialty",
choices = specialty_list, selected = specialty_list)
antimicrobial_class_list <- patients() %>% group_by(antimicrobial_class) %>% count() %>% arrange(desc(n)) %>% pull(antimicrobial_class)
updatePickerInput(session = session, inputId = "filter_antimicrobial_class",
choices = antimicrobial_class_list, selected = antimicrobial_class_list)
})
# Events on selection or non-selection of "Use App Data"
# observe(
# if(input$app_data == TRUE){
# data_provided(TRUE)
# patients(patient)
# wards(ward)
# msg <- test_data_odk(patients(), wards())
# if(!is.null(msg)) showNotification(msg, type = "error", duration = NULL)
# showTab(inputId = "tabs", target = "tab_1")
# }
# )
#
# observe(
# if(input$app_data == FALSE){
# data_provided(FALSE)
# patients(NULL)
# wards(NULL)
# hideTab(inputId = "tabs", target = "tab_1")
# }
# )
# Events on upload of files ----
# observeEvent(input$file_upload, ignoreNULL = TRUE, ignoreInit = TRUE, {
# dta <- NULL
# test_format <- TRUE
#
# # Test of the format of provided files is correct.
# for(nr in 1:length(input$file_upload[, 1])) {
# temp_dta <- read_excel(input$file_upload[[nr, 'datapath']])
#
# expected_column_names <- c("label", "round", "hospcd", "hospital_district",
# "hospital_province", "surveyor1", "surveyor2", "surveyor3", "surdate",
# "ward", "specialty", "age_year", "age_month", "age_day", "antiname",
# "route", "diasite", "typeind", "reason", "stop_review",
# "treatment", "ipdopd")
#
# ifelse(all(names(temp_dta) %in% expected_column_names, expected_column_names %in% names(temp_dta)),
# dta <- rbind(dta, temp_dta),
# test_format <- FALSE)
# }
#
# if(!test_format) {
# showNotification(id = "format", ui = "The format of (at least) one of the provided file isn't correct. Please reupload.",
# type = "error", duration = NULL)
# }
#
# if(test_format) {
# removeNotification(id = "format")
# showNotification(ui = "Data uploaded and in correct format!", type = "message")
#
# source("./www/prepare_data.R", local = TRUE)
# patients(dta)
#
# data_provided(TRUE)
#
# # Update filters.
# hospitals_list <- patients() %>% pull(hospcd) %>% unique() %>% sort()
# updatePickerInput(session = session, inputId = "filter_hospitals",
# choices = hospitals_list, selected = hospitals_list)
#
# date_survey_vec <- c(patients() %>% pull(surdate) %>% min(),
# patients() %>% pull(surdate) %>% max())
# updateDateRangeInput(session = session, inputId = "filter_date_survey",
# start = date_survey_vec[1], end = date_survey_vec[2])
#
# specialty_list <- patients() %>% pull(specialty) %>% unique() %>% sort()
# updatePickerInput(session = session, inputId = "filter_specialty",
# choices = specialty_list, selected = specialty_list)
#
# antimicrobial_class_list <- patients() %>% group_by(antimicrobial_class) %>% count() %>% arrange(desc(n)) %>% pull(antimicrobial_class)
# updatePickerInput(session = session, inputId = "filter_antimicrobial_class",
# choices = antimicrobial_class_list, selected = antimicrobial_class_list)
#
# # Show tab 1.
# showTab(inputId = "tabs", target = "tab_1")
# }
# })
# Report Generation ----
feedback_download <- reactiveValues(download_flag = 0)
output$report <- downloadHandler(
filename = "AMU in Laos Report.docx",
content = function(file) {
feedback_download$download_flag <- feedback_download$download_flag + 1
if(feedback_download$download_flag > 0) {
showNotification(HTML("Generation of the report typically takes 5 to 30 seconds"), duration = NULL, type = "message", id = "report_generation", session = session)
}
tempReport <- file.path(tempdir(), "report.Rmd")
tempLogo <- file.path(tempdir(), "LOMWRU.jpg")
file.copy("./www/report/report.Rmd", tempReport, overwrite = TRUE)
file.copy("./www/LOMWRU.jpg", tempLogo, overwrite = TRUE)
rmarkdown::render(tempReport, output_file = file)
removeNotification(id = "report_generation", session = session)
showNotification(HTML("Report Generated"), duration = 4, type = "message", id = "report_generated", session = session)
}
)
}
# Return the App ----
shinyApp(ui = ui, server = server)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.