1078 lines
38 KiB
R
1078 lines
38 KiB
R
|
|
|
|
server <- function(input, output, session) {
|
|
|
|
|
|
# define data selection ---------------------------------------------------
|
|
|
|
|
|
data_select <- reactive({if (input$box2.6_first != 365) {
|
|
radar_data %>%
|
|
filter(specialty_shiny %in% input$specialtyInput & department %in% input$departmentInput) %>%
|
|
filter_first_isolate(col_patient_id = "patientid", episode_days = input$box2.6_first) %>%
|
|
mutate(mo = as.mo(mo, Becker = TRUE))
|
|
} else {
|
|
radar_data_first %>%
|
|
filter(specialty_shiny %in% input$specialtyInput & department %in% input$departmentInput)
|
|
}
|
|
})
|
|
|
|
# update specialties & departments --------------------------------------------------------------
|
|
|
|
observe({
|
|
x <- input$allInput
|
|
if (x == TRUE) {
|
|
x <- sort(unique(radar_data$specialty_shiny))
|
|
}
|
|
else {
|
|
x <- character(0)
|
|
}
|
|
|
|
updateCheckboxGroupInput(
|
|
session,
|
|
"specialtyInput",
|
|
label = NULL,
|
|
choices = sort(unique(radar_data$specialty_shiny)),
|
|
selected = x
|
|
)
|
|
})
|
|
|
|
observe({
|
|
x <- input$specialtyInput
|
|
if (!is.null(x)) {
|
|
update_departments <-
|
|
radar_data %>% filter(specialty_shiny %in% input$specialtyInput)
|
|
x <- sort(unique(update_departments$department))
|
|
}
|
|
else {
|
|
x <- character(0)
|
|
}
|
|
updateCheckboxGroupInput(
|
|
session,
|
|
inputId = "departmentInput",
|
|
label = NULL,
|
|
choices = sort(unique(radar_data$department)),
|
|
selected = x
|
|
)
|
|
})
|
|
|
|
|
|
# sidebar hover -----------------------------------------------------------
|
|
|
|
onevent("mouseenter", "sidebarCollapsed", shinyjs::removeCssClass(selector = "body", class = "sidebar-collapse"))
|
|
onevent("mouseleave", "sidebarCollapsed", shinyjs::addCssClass(selector = "body", class = "sidebar-collapse"))
|
|
|
|
# BOX top left -----------------------------------------------------------
|
|
|
|
output$box2 <- renderUI({
|
|
div(
|
|
style = "position: relative",
|
|
tabBox(
|
|
id = "box2",
|
|
width = NULL,
|
|
height = 500,
|
|
tabPanel(
|
|
title = "Positive & negative cultures",
|
|
div(
|
|
style = "position: absolute; left: 0.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
radioGroupButtons(
|
|
inputId = "box2.1_group",
|
|
label = "Select group",
|
|
choiceNames = c("All", "Year", "Gender", "Department", "Specialty", "Specialty code", "ICU status", "Clinical status", "Outward status"),
|
|
choiceValues = c("group_all", "year", "gender", "department", "specialty", "specialism", "is_icu", "is_clinical", "is_outward"),
|
|
selected = "group_all",
|
|
direction = "vertical",
|
|
),
|
|
size = "xs",
|
|
icon = icon("gear", class = "opt"),
|
|
up = TRUE
|
|
)
|
|
),
|
|
div(
|
|
style = "position: absolute; right: 3.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
downloadButton(outputId = "down_box_pos_neg", label = "Download plot"),
|
|
size = "xs",
|
|
icon = icon("download", class = "opt"),
|
|
up = TRUE
|
|
)
|
|
),
|
|
withSpinner(
|
|
girafeOutput("pos_neg_plot", height = 400),
|
|
type = 4,
|
|
color = "#d33724",
|
|
size = 0.7
|
|
)
|
|
),tabPanel(
|
|
title = "Isolates (and pathogens) detected",
|
|
div(
|
|
style = "position: absolute; left: 0.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
radioGroupButtons(
|
|
inputId = "box2.3_group",
|
|
label = "Select group",
|
|
choiceNames = c("All", "Year", "Gender", "Department", "Specialty", "Specialty code", "ICU status", "Clinical status", "Outward status"),
|
|
choiceValues = c("group_all", "year", "gender", "department", "specialty", "specialism", "is_icu", "is_clinical", "is_outward"),
|
|
selected = "group_all",
|
|
direction = "vertical"
|
|
),
|
|
size = "xs",
|
|
icon = icon("gear", class = "opt"),
|
|
up = TRUE
|
|
)
|
|
),
|
|
div(
|
|
style = "position: absolute; left: 4.6em; bottom: 0.5em;",
|
|
dropdown(
|
|
sliderTextInput(
|
|
inputId = "box2.4_top",
|
|
label = "Use slider to select by count",
|
|
choices = seq(0, n_distinct(radar_data$mo), 10),
|
|
selected = c(0, 10)
|
|
),
|
|
size = "xs",
|
|
label = "Select top ...",
|
|
up = TRUE)
|
|
),
|
|
div(
|
|
style = "position: absolute; left: 12em; bottom: 0.5em;",
|
|
dropdown(
|
|
radioGroupButtons(
|
|
inputId = "box2.3_pathogen",
|
|
label = "Select pathogen group",
|
|
choiceNames = c("all", "definite", "probable", "improbable"),
|
|
choiceValues = c(0, 1, 2, 3),
|
|
selected = 0
|
|
),
|
|
size = "xs",
|
|
label = "Pathogens",
|
|
up = TRUE
|
|
)),
|
|
div(
|
|
style = "position: absolute; left: 18.7em; bottom: 0.5em;",
|
|
dropdown(
|
|
selectInput(
|
|
inputId = "box2.5_search",
|
|
label = "Search and select isolates",
|
|
choices = mo_fullname(unique(radar_data$mo)[which(!is.na(unique(radar_data$mo)))]),
|
|
|
|
multiple = TRUE
|
|
),
|
|
size = "xs",
|
|
label = "Search isolates",
|
|
up = TRUE
|
|
)),
|
|
div(
|
|
style = "position: absolute; left: 27em; bottom: 0.5em;",
|
|
dropdown(
|
|
sliderTextInput(
|
|
inputId = "box2.6_first",
|
|
label = "Select range in days (use standard = 365 if not specially requested otherwise)",
|
|
choices = c(15, 30, 60, 90, 365),
|
|
selected = 365
|
|
),
|
|
size = "xs",
|
|
label = "Define first isolate guidelines",
|
|
up = TRUE
|
|
)),
|
|
div(
|
|
style = "position: absolute; right: 3.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
downloadButton(outputId = "down_box_patho", label = "Download plot"),
|
|
size = "xs",
|
|
icon = icon("download", class = "opt"),
|
|
up = TRUE
|
|
)
|
|
),
|
|
withSpinner(
|
|
girafeOutput("patho_plot", height = 400),
|
|
type = 4,
|
|
color = "#d33724",
|
|
size = 0.7
|
|
)
|
|
),
|
|
tabPanel(
|
|
title = "First isolates per episode",
|
|
div(
|
|
style = "position: absolute; left: 0.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
radioGroupButtons(
|
|
inputId = "box2.2_group",
|
|
label = "Select group",
|
|
choiceNames = c("All", "Year", "Gender", "Department", "Department type", "Specialty", "ICU status", "Clinical status", "Outward status"),
|
|
choiceValues = c("group_all", "year", "gender", "department", "type_dept", "specialism", "is_icu", "is_clinical", "is_outward"),
|
|
selected = "group_all",
|
|
direction = "vertical"
|
|
),
|
|
size = "xs",
|
|
icon = icon("gear", class = "opt"),
|
|
up = TRUE
|
|
)
|
|
),
|
|
withSpinner(
|
|
plotOutput("test_plot", height = 400),
|
|
type = 4,
|
|
color = "#d33724",
|
|
size = 0.7
|
|
)
|
|
),
|
|
div(
|
|
style = "position:absolute;right:0.5em;bottom: 0.5em;",
|
|
conditionalPanel(
|
|
"input.box2 == 'Positive & negative cultures'",
|
|
actionBttn(
|
|
inputId = "pos_neg_plus",
|
|
icon = icon("search-plus", class = "opt"),
|
|
style = "fill",
|
|
color = "danger",
|
|
size = "xs"
|
|
)
|
|
)
|
|
),
|
|
div(
|
|
style = "position:absolute;right:0.5em;bottom: 0.5em;",
|
|
conditionalPanel(
|
|
"input.box2 == 'First isolates per episode'",
|
|
actionBttn(
|
|
inputId = "test_plus",
|
|
icon = icon("search-plus", class = "opt"),
|
|
style = "fill",
|
|
color = "danger",
|
|
size = "xs"
|
|
)
|
|
)
|
|
),
|
|
div(
|
|
style = "position:absolute;right:0.5em;bottom: 0.5em;",
|
|
conditionalPanel(
|
|
"input.box2 == 'Isolates (and pathogens) detected'",
|
|
actionBttn(
|
|
inputId = "patho_plus",
|
|
icon = icon("search-plus", class = "opt"),
|
|
style = "fill",
|
|
color = "danger",
|
|
size = "xs"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
})
|
|
|
|
observeEvent((input$test_plus), {
|
|
showModal(modalDialog(
|
|
renderPlot({
|
|
test_plot() + theme(
|
|
text = element_text(family = "Arial"),
|
|
axis.title = element_text(size = 20),
|
|
text = element_text(size = 20),
|
|
plot.title = element_text(size = 26)
|
|
)
|
|
}, height = 600),
|
|
easyClose = TRUE,
|
|
size = "l",
|
|
footer = NULL
|
|
))
|
|
})
|
|
|
|
observeEvent((input$pos_neg_plus), {
|
|
showModal(modalDialog(
|
|
renderPlot({
|
|
pos_neg_plot() + theme(
|
|
axis.title = element_text(size = 20),
|
|
text = element_text(size = 20),
|
|
plot.title = element_text(size = 26)
|
|
)
|
|
}, height = 600),
|
|
easyClose = TRUE,
|
|
size = "l",
|
|
footer = NULL
|
|
))
|
|
})
|
|
|
|
observeEvent((input$patho_plus), {
|
|
showModal(modalDialog(
|
|
renderPlot({
|
|
patho_plot() + theme(
|
|
text = element_text(family = "Arial"),
|
|
axis.title = element_text(size = 20),
|
|
plot.title = element_text(size = 26)
|
|
)
|
|
}, height = 600),
|
|
easyClose = TRUE,
|
|
size = "l",
|
|
footer = NULL
|
|
))
|
|
})
|
|
|
|
|
|
# positive negative plot --------------------------------------------------
|
|
|
|
pos_neg_plot <- reactive({
|
|
|
|
pos_neg_plot <- radar_data %>%
|
|
filter(specialty_shiny %in% input$specialtyInput & department %in% input$departmentInput) %>%
|
|
group_by_at(input$box2.1_group) %>%
|
|
summarise(patients = n_distinct(patientid),
|
|
total = n_distinct(sampleid),
|
|
positive = n_distinct(sampleid[!is.na(mo)]),
|
|
negative = total - positive) %>%
|
|
pivot_longer(cols = c("total", "positive", "negative")) %>%
|
|
mutate(name = factor(name, levels = c("total", "negative", "positive")))
|
|
|
|
pos_neg_plot %>%
|
|
ggplot(aes(name, value, fill = name, tooltip = value)) +
|
|
geom_col_interactive(colour = "black") +
|
|
scale_fill_manual(values = c("white", "lightgrey", "darkred")) +
|
|
labs(x = "", y = "Count", fill = "", title = "Number of positive & negative blood culture tests") +
|
|
theme_minimal() +
|
|
theme(text = element_text(family = "Arial"),
|
|
legend.title = element_blank(),
|
|
legend.text = element_text(margin = margin(l = 5)),
|
|
axis.title.y = element_blank(),
|
|
axis.text = element_text(size = 12),
|
|
plot.title = element_text(face = "bold", size = 14),
|
|
plot.caption = element_text(colour = "grey")) +
|
|
{if (input$box2.1_group != "group_all") {
|
|
facet_wrap(input$box2.1_group)
|
|
}} +
|
|
NULL
|
|
|
|
})
|
|
|
|
output$pos_neg_plot <- renderGirafe({
|
|
|
|
ggiraph(ggobj = pos_neg_plot(),
|
|
height_svg = 6,
|
|
width_svg = 10,
|
|
selection_type = "none")
|
|
})
|
|
|
|
output$down_box_pos_neg <- download_box("positive_negative_plot", pos_neg_plot())
|
|
|
|
# pathogen distribution plot ---------------------------------------------------
|
|
|
|
patho_plot <- reactive({
|
|
|
|
mo_search <- c("none", as.mo(input$box2.5_search))
|
|
|
|
top_10 <- data_select() %>%
|
|
filter(!is.na(mo)) %>%
|
|
{if(input$box2.3_pathogen != 0) {
|
|
filter(., pathogen_group == input$box2.3_pathogen | mo %in% mo_search)
|
|
} else {
|
|
.
|
|
}} %>%
|
|
count(mo) %>%
|
|
mutate(rank = rank(-n, ties.method = "first")) %>%
|
|
filter(rank >= min(input$box2.4_top) & rank <= max(input$box2.4_top))
|
|
|
|
patho_plot <- data_select() %>%
|
|
{if(input$box2.3_pathogen != 0) {
|
|
filter(., pathogen_group == input$box2.3_pathogen | mo %in% mo_search)
|
|
} else {
|
|
.
|
|
}} %>%
|
|
filter(mo %in% top_10$mo | mo %in% mo_search) %>%
|
|
mutate(show = if_else(!is.na(mo_search) & mo %in% mo_search, TRUE, FALSE))
|
|
|
|
patho_plot %>%
|
|
ggplot(aes(fct_rev(fct_infreq(mo_name(mo))),
|
|
tooltip = ..count..,
|
|
data_id = mo_name(mo),
|
|
fill = show)) +
|
|
geom_bar_interactive(
|
|
colour = "black"
|
|
) +
|
|
scale_fill_manual(breaks = c(TRUE, FALSE), values = c("red", "darkgrey")) +
|
|
scale_y_continuous(limits = if (max(patho_plot %>% count(mo) %>% pull(n)) < 25) {
|
|
c(0, 25)
|
|
} else {
|
|
c(0, max(patho_plot %>% count(mo) %>% pull(n)))
|
|
}) +
|
|
labs(x = "", y = "Count", title = "Number of first isolates detected") +
|
|
coord_flip() +
|
|
theme_minimal() +
|
|
theme(text = element_text(family = "Arial"),
|
|
legend.title = element_blank(),
|
|
legend.position = "none",
|
|
legend.text = element_text(margin = margin(l = 5)),
|
|
axis.title.y = element_blank(),
|
|
axis.title.x = element_blank(),
|
|
axis.text = element_text(size = 12),
|
|
axis.text.y = element_text(face = "italic"),
|
|
plot.title = element_text(face = "bold", size = 14),
|
|
plot.caption = element_text(colour = "grey")) +
|
|
{if (input$box2.3_group != "group_all") {
|
|
facet_wrap(input$box2.3_group)
|
|
}} +
|
|
NULL
|
|
|
|
})
|
|
|
|
output$patho_plot <- renderGirafe({
|
|
ggiraph(ggobj = patho_plot(),
|
|
height_svg = 6,
|
|
width_svg = 10,
|
|
selection_type = "single")
|
|
|
|
})
|
|
|
|
output$down_box_patho <- download_box("pathogen_distribution", patho_plot())
|
|
|
|
|
|
|
|
|
|
# episode plot ---------------------------------------------------------------
|
|
|
|
test_plot <- reactive({
|
|
|
|
radar_data %>%
|
|
mutate(first_14 = first_isolate(radar_data, episode_days = 14, col_patient_id = "patientid"),
|
|
first_30 = first_isolate(radar_data, episode_days = 30, col_patient_id = "patientid"),
|
|
first_60 = first_isolate(radar_data, episode_days = 60, col_patient_id = "patientid")) %>%
|
|
group_by_at(input$box2.2_group) %>%
|
|
summarise("14 days" = sum(first_14, na.rm = TRUE),
|
|
"30 days" = sum(first_30, na.rm = TRUE),
|
|
"60 days" = sum(first_60, na.rm = TRUE)) %>%
|
|
pivot_longer(cols = c("14 days", "30 days", "60 days"))
|
|
|
|
})
|
|
|
|
output$test_plot <- renderPlot({
|
|
test_plot() %>%
|
|
ggplot(aes(value, name)) +
|
|
geom_col(colour = "black", fill = "lightgrey") +
|
|
labs(x = "Count", y = "Episode", title = "Number of first isolates per episode") +
|
|
theme_minimal() +
|
|
theme(text = element_text(family = "Arial"),
|
|
legend.title = element_blank(),
|
|
legend.text = element_text(margin = margin(l = 5)),
|
|
axis.title.y = element_blank(),
|
|
axis.text = element_text(size = 12),
|
|
plot.title = element_text(face = "bold", size = 14),
|
|
plot.caption = element_text(colour = "grey")) +
|
|
{if (input$box2.2_group != "group_all") {
|
|
facet_wrap(input$box2.2_group)
|
|
}} +
|
|
NULL
|
|
})
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# BOX top right ------------------------------------------------------
|
|
|
|
output$box1 <- renderUI({
|
|
div(
|
|
style = "position: relative",
|
|
tabBox(
|
|
id = "box1",
|
|
width = NULL,
|
|
height = 500,
|
|
tabPanel(
|
|
title = "Resistance profile",
|
|
div(
|
|
style = "position: absolute; left: 0.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
radioGroupButtons(
|
|
inputId = "box1.2_group",
|
|
label = "Select group",
|
|
choiceNames = c("All", "Year", "Gender", "Department", "Specialty", "Specialty code", "ICU status", "Clinical status", "Outward status"),
|
|
choiceValues = c("mo", "year", "gender", "department", "specialty", "specialism", "is_icu", "is_clinical", "is_outward"),
|
|
selected = "mo",
|
|
direction = "vertical"
|
|
),
|
|
size = "xs",
|
|
icon = icon("gear", class = "opt"),
|
|
up = TRUE
|
|
)
|
|
),
|
|
div(
|
|
style = "position: absolute; right: 3.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
downloadButton(outputId = "down_box_res_prop", label = "Download plot"),
|
|
size = "xs",
|
|
icon = icon("download", class = "opt"),
|
|
up = TRUE,
|
|
right = TRUE
|
|
)
|
|
),
|
|
withSpinner(
|
|
girafeOutput("isolate_prop_plot", height = 400),
|
|
type = 4,
|
|
color = "#d33724",
|
|
size = 0.7
|
|
),
|
|
div(
|
|
style = "position:absolute;right:0.5em;bottom: 0.5em;",
|
|
conditionalPanel(
|
|
"input.box1 == 'Resistance profile'",
|
|
actionBttn(
|
|
inputId = "res_prop_plus",
|
|
icon = icon("search-plus", class = "opt"),
|
|
style = "fill",
|
|
color = "danger",
|
|
size = "xs"
|
|
)
|
|
)
|
|
)
|
|
),
|
|
tabPanel(
|
|
title = "Combination therapy",
|
|
withSpinner(
|
|
girafeOutput("comb_plot", height = 400),
|
|
type = 4,
|
|
color = "#d33724",
|
|
size = 0.7
|
|
),
|
|
div(
|
|
style = "position: absolute; left: 0.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
label = "HANDLE WITH CARE",
|
|
radioGroupButtons(
|
|
inputId = "comb",
|
|
label = HTML("Please read the documentation before interpreting results and modifying underlying algorithm",
|
|
as.character(actionLink(inputId = "action_link", label = "(click here)", onclick = 'window.open("https://msberends.github.io/AMR/reference/proportion.html#combination-therapy")'))),
|
|
justified = TRUE,
|
|
width = 150,
|
|
choiceNames = c("Only all tested", "All"),
|
|
choiceValues = c(TRUE, FALSE),
|
|
size = "xs",
|
|
direction = "vertical"
|
|
),
|
|
icon = icon("info-circle"),
|
|
size = "xs",
|
|
up = TRUE
|
|
)
|
|
),
|
|
div(
|
|
style = "position: absolute; right: 3.5em; bottom: 0.5em;",
|
|
dropdown(
|
|
downloadButton(outputId = "down_box_comb_prop", label = "Download plot"),
|
|
size = "xs",
|
|
icon = icon("download", class = "opt"),
|
|
up = TRUE,
|
|
right = TRUE
|
|
)
|
|
),
|
|
div(
|
|
style = "position:absolute;right:0.5em;bottom: 0.5em;",
|
|
actionBttn(
|
|
inputId = "res_comb_plus",
|
|
icon = icon("search-plus", class = "opt"),
|
|
style = "fill",
|
|
color = "danger",
|
|
size = "xs"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
})
|
|
|
|
observeEvent((input$res_prop_plus), {
|
|
showModal(modalDialog(
|
|
renderPlot({
|
|
isolate_prop_plot() + theme(
|
|
text = element_text(family = "Arial"),
|
|
axis.title = element_text(size = 20),
|
|
text = element_text(size = 20),
|
|
plot.title = element_text(size = 26)
|
|
)
|
|
}, height = 600),
|
|
easyClose = TRUE,
|
|
size = "l",
|
|
footer = NULL
|
|
))
|
|
})
|
|
|
|
observeEvent((input$res_comb_plus), {
|
|
showModal(modalDialog(
|
|
renderPlot({
|
|
comb_plot() + theme(
|
|
text = element_text(family = "Arial"),
|
|
axis.title = element_text(size = 20),
|
|
text = element_text(size = 20),
|
|
plot.title = element_text(size = 26)
|
|
)
|
|
}, height = 600),
|
|
easyClose = TRUE,
|
|
size = "l",
|
|
footer = NULL
|
|
))
|
|
})
|
|
|
|
|
|
# plot resistance proportion ---------------------------------------------------
|
|
|
|
isolate_prop_data <- reactive({
|
|
|
|
# mo_selected <- input$box1_mo
|
|
mo_selected <- input$patho_plot_selected
|
|
|
|
e_coli_ab <- c("Amoxicillin",
|
|
"Amoxicillin/clavulanic acid",
|
|
"Piperacillin/tazobactam",
|
|
"Cefuroxim",
|
|
"Ceftriaxone",
|
|
"Ceftazidime",
|
|
"Meropenem",
|
|
"Ciprofloxacin",
|
|
"Gentamicin",
|
|
"Tobramycin",
|
|
"Fosfomycin",
|
|
"Trimethoprim",
|
|
"Co-trimoxazole",
|
|
"Nitrofurantoine")
|
|
|
|
e_cloacae_ab <- c("Ciprofloxacin",
|
|
"Gentamicin",
|
|
"Tobramycin",
|
|
"Co-trimoxazole",
|
|
"Meropenem")
|
|
|
|
p_aeruginosa_ab <- c("Piperacillin/tazobactam",
|
|
"Ceftazidime",
|
|
"Meropenem",
|
|
"Ciprofloxacin",
|
|
"Gentamicin",
|
|
"Tobramycin")
|
|
|
|
s_aureus_ab <- c("Flucloxacillin",
|
|
"Penicillin",
|
|
"Ciprofloxacin",
|
|
"Gentamicin",
|
|
"Erythromycin",
|
|
"Clindamycin",
|
|
"Doxycycline",
|
|
"Linezolid",
|
|
"Co-trimoxazol",
|
|
"Rifampicin")
|
|
|
|
cons_ab <- c(#"Flucloxacillin",
|
|
"Ciprofloxacin",
|
|
"Gentamicin",
|
|
"Erythromycin",
|
|
"Clindamycin",
|
|
"Doxycycline",
|
|
"Linezolid",
|
|
"Co-trimoxazol",
|
|
"Rifampicin")
|
|
|
|
e_faecalis_ab <- c("Amoxicillin",
|
|
"Vancomycin")
|
|
|
|
get_resistance_df <- function(.data, mo_selected, abx, language = "en") {
|
|
.data %>%
|
|
filter(mo == as.mo(mo_selected)) %>%
|
|
{if (nrow(.) != 0) {
|
|
group_by_at(., input$box1.2_group) %>%
|
|
select(group_vars(.), as.character(as.ab(abx))) %>%
|
|
count_df(., translate_ab = "name", language = language)
|
|
}}
|
|
}
|
|
|
|
get_resistance_df(data_select(),
|
|
mo_selected = mo_selected,
|
|
abx = if (mo_genus(mo_selected) %in% mo_genus(c("E. coli",
|
|
"K. pneumoniae",
|
|
"P. mirabilis"))) {
|
|
e_coli_ab
|
|
} else if (mo_genus(mo_selected) %in% mo_genus(c("E. cloacae"))) {
|
|
e_cloacae_ab
|
|
} else if (mo_genus(mo_selected) %in% mo_genus(c("P. aeruginosa"))) {
|
|
p_aeruginosa_ab
|
|
} else if (as.mo(mo_selected) == as.mo("S. aureus")) {
|
|
s_aureus_ab
|
|
} else if (as.mo(mo_selected, Becker = TRUE) == as.mo("CoNS")) {
|
|
cons_ab
|
|
} else if (mo_genus(mo_selected) %in% mo_genus(c("E. faecalis"))) {
|
|
e_faecalis_ab
|
|
} else {
|
|
radar_data %>% select_if(is.rsi) %>% names()
|
|
}
|
|
) %>%
|
|
pivot_wider(names_from = interpretation, values_from = value) %>%
|
|
mutate(value_r = R,
|
|
value_si = SI,
|
|
all = R+SI,
|
|
percent_r = percent(R/all, 0.1),
|
|
percent_si = percent(SI/all, 0.1)) %>%
|
|
pivot_longer(cols = c("SI", "R"), names_to = "interpretation", values_to = "value") %>%
|
|
mutate(mo = as.mo(input$patho_plot_selected)) %>%
|
|
left_join(intrinsic_info) %>%
|
|
mutate(flag = if_else(intrinsic_r == TRUE, "(intrinsic resistance)", NA_character_))
|
|
|
|
})
|
|
|
|
isolate_prop_plot <- reactive({
|
|
|
|
if (class(try(isolate_prop_data())) == "try-error") {
|
|
ggplot(data.frame(), aes(x = 1, y = 1, label = "No tests available")) +
|
|
geom_text(size = 5, colour = "red", fontface = "bold", family = "Arial") +
|
|
theme_void()
|
|
} else {
|
|
|
|
ggplot(isolate_prop_data(), aes(value, reorder(antibiotic, value_r), fill = factor(interpretation, levels = c("SI", "R")),
|
|
tooltip = paste0("R = ", value_r, " (", percent_r, ")\n", "SI = ", value_si, " (", percent_si, ")")
|
|
)) +
|
|
|
|
geom_col_interactive(colour = "black", position = "fill") +
|
|
scale_fill_manual(limits = c("R", "SI"),
|
|
breaks = c("SI", "R"),
|
|
values = c("#FDE725FF", "#440154FF"),
|
|
na.value = "lightgrey") +
|
|
scale_x_continuous(labels = percent) +
|
|
geom_text(data = isolate_prop_data(), aes(0.5, reorder(antibiotic, value_r), label = flag), colour = "red") +
|
|
ggtitle(label = paste0("Selected isolates: *", mo_fullname(as.mo(input$patho_plot_selected)), "*"),
|
|
subtitle = if (any(isolate_prop_data()$all < 30)) {
|
|
"Minimum number of valid tests per agent not reached (n < 30)"
|
|
} else {
|
|
""
|
|
}) +
|
|
{if (input$box1.2_group != "mo") {
|
|
facet_wrap(input$box1.2_group)
|
|
}} +
|
|
theme_minimal() +
|
|
theme(text = element_text(family = "Arial"),
|
|
legend.title = element_blank(),
|
|
legend.text = element_text(margin = margin(l = 5)),
|
|
axis.title.y = element_blank(),
|
|
axis.title.x = element_blank(),
|
|
axis.text = element_text(size = 12),
|
|
plot.title = ggtext::element_markdown(face = "bold", size = 14),
|
|
plot.subtitle = element_text(colour = "red", face = "bold"))
|
|
}
|
|
|
|
})
|
|
|
|
output$isolate_prop_plot <- renderGirafe({
|
|
validate(
|
|
need(input$patho_plot_selected, 'Please select from the tab: Isolates (and pathogens) detected'))
|
|
ggiraph(ggobj = isolate_prop_plot(),
|
|
height_svg = 6,
|
|
width_svg = 10,
|
|
selection_type = "single")
|
|
})
|
|
|
|
output$down_box_res_prop <- download_box("resistance_prop", isolate_prop_plot())
|
|
|
|
|
|
# combination therapy -----------------------------------------------------
|
|
|
|
comb_data <- reactive({
|
|
|
|
d <- data_select() %>%
|
|
filter(mo == as.mo(input$patho_plot_selected))
|
|
|
|
# resistance proportion
|
|
|
|
amc_tob <- d %>%
|
|
resistance(AMC, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
amc_gen <- d %>%
|
|
resistance(AMC, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
cxm_tob <- d %>%
|
|
resistance(CXM, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
cxm_gen <- d %>%
|
|
resistance(CXM, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
cro_tob <- d %>%
|
|
resistance(CRO, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
cro_gen <- d %>%
|
|
resistance(CRO, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
pip_taz_tob <- d %>%
|
|
resistance(TZP, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
pip_taz_gen <- d %>%
|
|
resistance(TZP, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
|
|
prop <- tibble(
|
|
"Amoxicillin/clavulanic acid &\nTobramycin" = amc_tob,
|
|
"Amoxicillin/clavulanic acid &\nGentamicin" = amc_gen,
|
|
"Cefuroxime &\nTobramycin" = cxm_tob,
|
|
"Cefuroxime & \nGentamicin" = cxm_gen,
|
|
"Ceftriaxone &\nTobramycin" = cro_tob,
|
|
"Ceftriaxone &\nGentamicin" = cro_gen,
|
|
"Piperacillin/tazobactam &\nTobramycin" = pip_taz_tob,
|
|
"Piperacillin/tazobactam &\nGentamicin" = pip_taz_gen) %>%
|
|
bind_rows(summarise_all(., ~.)) %>%
|
|
bind_rows(summarise_all(., ~1 - .)) %>%
|
|
bind_cols(interpretation = c("R", "R_max", "SI", "SI_max")) %>%
|
|
pivot_longer(cols = c("Amoxicillin/clavulanic acid &\nTobramycin":"Piperacillin/tazobactam &\nGentamicin")) %>%
|
|
pivot_wider(names_from = interpretation, values_from = value) %>%
|
|
pivot_longer(cols = c("R", "SI"), names_to = "interpretation")
|
|
|
|
|
|
amc_tob_c <- d %>%
|
|
count_R(AMC, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
amc_gen_c <- d %>%
|
|
count_R(AMC, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
cxm_tob_c <- d %>%
|
|
count_R(CXM, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
cxm_gen_c <- d %>%
|
|
count_R(CXM, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
cro_tob_c <- d %>%
|
|
count_R(CRO, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
cro_gen_c <- d %>%
|
|
count_R(CRO, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
pip_taz_tob_c <- d %>%
|
|
count_R(TZP, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
pip_taz_gen_c <- d %>%
|
|
count_R(TZP, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
# SI
|
|
amc_tob_c_si <- d %>%
|
|
count_SI(AMC, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
amc_gen_c_si <- d %>%
|
|
count_SI(AMC, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
cxm_tob_c_si <- d %>%
|
|
count_SI(CXM, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
cxm_gen_c_si <- d %>%
|
|
count_SI(CXM, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
cro_tob_c_si <- d %>%
|
|
count_SI(CRO, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
cro_gen_c_si <- d %>%
|
|
count_SI(CRO, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
pip_taz_tob_c_si <- d %>%
|
|
count_SI(TZP, TOB, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
pip_taz_gen_c_si <- d %>%
|
|
count_SI(TZP, GEN, only_all_tested = as.logical(input$comb), minimum = 0)
|
|
|
|
count_r <- tibble(
|
|
"Amoxicillin/clavulanic acid &\nTobramycin" = amc_tob_c,
|
|
"Amoxicillin/clavulanic acid &\nGentamicin" = amc_gen_c,
|
|
"Cefuroxime &\nTobramycin" = cxm_tob_c,
|
|
"Cefuroxime & \nGentamicin" = cxm_gen_c,
|
|
"Ceftriaxone &\nTobramycin" = cro_tob_c,
|
|
"Ceftriaxone &\nGentamicin" = cro_gen_c,
|
|
"Piperacillin/tazobactam &\nTobramycin" = pip_taz_tob_c,
|
|
"Piperacillin/tazobactam &\nGentamicin" = pip_taz_gen_c) %>%
|
|
bind_cols(interpretation = c("R")) %>%
|
|
pivot_longer(cols = c("Amoxicillin/clavulanic acid &\nTobramycin":"Piperacillin/tazobactam &\nGentamicin")) %>%
|
|
pivot_wider(names_from = interpretation, values_from = value) %>%
|
|
pivot_longer(cols = "R", names_to = "interpretation", values_to = "count_r")
|
|
|
|
count_si <- tibble(
|
|
"Amoxicillin/clavulanic acid &\nTobramycin" = amc_tob_c_si,
|
|
"Amoxicillin/clavulanic acid &\nGentamicin" = amc_gen_c_si,
|
|
"Cefuroxime &\nTobramycin" = cxm_tob_c_si,
|
|
"Cefuroxime & \nGentamicin" = cxm_gen_c_si,
|
|
"Ceftriaxone &\nTobramycin" = cro_tob_c_si,
|
|
"Ceftriaxone &\nGentamicin" = cro_gen_c_si,
|
|
"Piperacillin/tazobactam &\nTobramycin" = pip_taz_tob_c_si,
|
|
"Piperacillin/tazobactam &\nGentamicin" = pip_taz_gen_c_si) %>%
|
|
bind_cols(interpretation = c("SI")) %>%
|
|
pivot_longer(cols = c("Amoxicillin/clavulanic acid &\nTobramycin":"Piperacillin/tazobactam &\nGentamicin")) %>%
|
|
pivot_wider(names_from = interpretation, values_from = value) %>%
|
|
pivot_longer(cols = "SI", names_to = "interpretation", values_to = "count_si")
|
|
|
|
prop %>%
|
|
left_join(count_r) %>%
|
|
left_join(count_si) %>%
|
|
pivot_longer(cols = c("count_r", "count_si"), names_to = "count", values_to = "value_count") %>%
|
|
filter(!is.na(value_count)) %>%
|
|
group_by(name) %>%
|
|
mutate(all = sum(value_count)) %>%
|
|
ungroup() %>%
|
|
mutate(value_count = paste0(value_count, " (", percent(value, 0.1), ")"))
|
|
|
|
|
|
})
|
|
|
|
comb_plot <- reactive({
|
|
|
|
if ((!as.mo(input$patho_plot_selected) %in% as.mo(c("E. coli", "K. pneumoniae")))) {
|
|
ggplot(data.frame(), aes(x = 1, y = 1, label = "No tests available\nor not applicable for selected isolate\n(results only available for E. coli and K. pneumoniae)")) +
|
|
geom_text(size = 5, colour = "red", fontface = "bold", family = "Arial") +
|
|
theme_void()
|
|
} else {
|
|
|
|
ggplot(comb_data(), aes(value, name,
|
|
fill = factor(interpretation, levels = c("SI", "R")),
|
|
tooltip = paste0("R = ", percent(R_max, 0.01))),
|
|
data_id = name) +
|
|
geom_col_interactive(colour = "black", position = "fill") +
|
|
scale_fill_manual(limits = c("R", "SI"),
|
|
breaks = c("SI", "R"),
|
|
values = c("#FDE725FF", "#440154FF"),
|
|
na.value = "lightgrey") +
|
|
scale_x_continuous(labels = percent) +
|
|
ggtitle(label = paste("Selected isolates: ", mo_fullname(as.mo(input$patho_plot_selected))),
|
|
subtitle = if (any(isolate_prop_data()$all < 30)) {
|
|
"Minimum number of valid tests per agent not reached (n < 30)"
|
|
} else {
|
|
""
|
|
}) +
|
|
theme_minimal() +
|
|
theme(text = element_text(family = "Arial"),
|
|
legend.title = element_blank(),
|
|
legend.text = element_text(margin = margin(l = 5)),
|
|
axis.title.y = element_blank(),
|
|
axis.title.x = element_blank(),
|
|
plot.title = element_text(face = "bold", size = 14),
|
|
axis.text = element_text(size = 12),
|
|
plot.subtitle = element_text(colour = "red", face = "bold")) +
|
|
{if (input$box1.2_group != "mo") {
|
|
facet_wrap(input$box1.2_group)
|
|
}} +
|
|
NULL
|
|
}
|
|
|
|
})
|
|
|
|
output$comb_plot <- renderGirafe({
|
|
|
|
validate(
|
|
need(input$patho_plot_selected, 'Please select from the tab: Isolates (and pathogens) detected'))
|
|
|
|
|
|
ggiraph(ggobj = comb_plot(),
|
|
height_svg = 6,
|
|
width_svg = 10,
|
|
selection_type = "single")
|
|
|
|
})
|
|
|
|
output$down_box_comb_prop <- download_box("resistance_combination", comb_plot())
|
|
|
|
# table -------------------------------------------------------------------
|
|
|
|
output$box3 <- renderUI({
|
|
div(
|
|
style = "position: relative",
|
|
tabBox(
|
|
id = "box3",
|
|
width = NULL,
|
|
height = 550,
|
|
tabPanel(title = "",
|
|
dataTableOutput("test_table"),
|
|
style = "height:500px; overflow-y: scroll;overflow-x: scroll;")))
|
|
|
|
})
|
|
|
|
dt_custom <- function(data) {
|
|
datatable(data, rownames = FALSE,
|
|
extensions = c('Buttons', 'Scroller'),
|
|
options = list(
|
|
dom = "Bftp",
|
|
buttons =
|
|
list("copy", list(
|
|
extend = "collection",
|
|
buttons = c("csv", "excel", "pdf"),
|
|
text = "Download")),
|
|
lengthMenu = list( c(10, 20, -1), c(10, 20, "All")) ,
|
|
pageLength = -1,
|
|
columnDefs = list(list(className = 'dt-right', targets = "_all"))))
|
|
}
|
|
|
|
output$test_table <- renderDataTable({
|
|
|
|
# isolate_prop_data() %>%
|
|
if (input$box2 == "Positive & negative cultures") {
|
|
all <- radar_data %>%
|
|
filter(specialty_shiny %in% input$specialtyInput & department %in% input$departmentInput) %>%
|
|
rename(group = input$box2.1_group) %>%
|
|
filter(!is.na(group)) %>%
|
|
distinct(patientid, .keep_all = TRUE) %>%
|
|
count(group) %>%
|
|
rename(n_all = n)
|
|
pos <- radar_data %>%
|
|
filter(specialty_shiny %in% input$specialtyInput & department %in% input$departmentInput) %>%
|
|
rename(group = input$box2.1_group) %>%
|
|
group_by(group) %>%
|
|
# group_by_at("gender") %>%
|
|
filter(!is.na(mo)) %>%
|
|
distinct(patientid) %>%
|
|
count(group) %>%
|
|
# count_("gender") %>%
|
|
left_join(all) %>%
|
|
mutate(n_rel = percent(n/n_all, 0.1)) %>%
|
|
select(group, n, n_rel, n_all) %>%
|
|
rename("Patients (n) with at least 1 positive culture" = n,
|
|
"Patients (%) with at least 1 positive culture" = n_rel,
|
|
"All patients (n)" = n_all) %>%
|
|
{if (input$box2.1_group == "group_all") {
|
|
# select(., -group)
|
|
mutate(., group = "All patients")
|
|
} else {
|
|
.
|
|
}
|
|
} %>%
|
|
rename_all(str_to_sentence) %>%
|
|
dt_custom()
|
|
} else if (input$box2 == "First isolates per episode") {
|
|
test_plot() %>%
|
|
select("Episode selected" = name, "First isolates" = value) %>%
|
|
dt_custom()
|
|
} else {
|
|
data_select() %>%
|
|
freq(mo) %>%
|
|
mutate(Name = mo_name(item),
|
|
percent = percent(percent, accuracy = 0.1),
|
|
cum_percent = percent(cum_percent)) %>%
|
|
select(-cum_percent) %>%
|
|
select(Name, n = count, "%" = percent, "n (cummulative)" = cum_count) %>%
|
|
dt_custom()
|
|
}
|
|
|
|
})
|
|
|
|
output$box4 <- renderUI({
|
|
div(
|
|
style = "position: relative",
|
|
tabBox(
|
|
id = "box4",
|
|
width = NULL,
|
|
height = 550,
|
|
tabPanel(title = "",
|
|
dataTableOutput("res_table"), style = "height:500px; overflow-y: scroll;")))
|
|
})
|
|
|
|
output$res_table <- renderDataTable({
|
|
|
|
validate(
|
|
need(input$patho_plot_selected, 'Please select from the tab: Isolates (and pathogens) detected'))
|
|
|
|
if (class(try(isolate_prop_data())) == "try-error") {
|
|
data.frame()
|
|
} else {
|
|
|
|
if (input$box1 == "Resistance profile") {
|
|
isolate_prop_data() %>%
|
|
group_by(antibiotic) %>%
|
|
mutate(percent = percent(value/all, 0.1),
|
|
join = paste0(value, " (", percent, ")")) %>%
|
|
pivot_wider(id_cols = c(antibiotic, all), names_from = interpretation, values_from = join) %>%
|
|
rename(Antibiotic = antibiotic,
|
|
total = all) %>%
|
|
dt_custom()
|
|
} else {
|
|
if (as.mo(input$patho_plot_selected) %in% as.mo(c("E. coli", "K. pneumoniae"))) {
|
|
comb_data() %>%
|
|
pivot_wider(id_cols = c(name, all), names_from = interpretation, values_from = value_count) %>%
|
|
select(Combination = name, total = all, SI, R) %>%
|
|
dt_custom()
|
|
} else {
|
|
data.frame()
|
|
}
|
|
}
|
|
}
|
|
})
|
|
|
|
|
|
} |