2021-11-01 14:38:23 +01:00
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 (
2021-11-16 12:21:55 +01:00
title = trnslt ( " Positive & negative cultures" ) ,
2021-11-01 14:38:23 +01:00
div (
style = " position: absolute; left: 0.5em; bottom: 0.5em;" ,
dropdown (
radioGroupButtons (
inputId = " box2.1_group" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Select group" ) ,
choiceNames = c ( trnslt ( " All" ) , trnslt ( " Year" ) , trnslt ( " Gender" ) , trnslt ( " Department" ) , trnslt ( " Specialty" ) , trnslt ( " Specialty code" ) , trnslt ( " ICU status" ) , trnslt ( " Clinical status" ) , trnslt ( " Outward status" ) ) ,
2021-11-01 14:38:23 +01:00
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 (
2021-11-16 12:21:55 +01:00
downloadButton ( outputId = " down_box_pos_neg" , label = trnslt ( " Download plot" ) ) ,
2021-11-01 14:38:23 +01:00
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" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Select group" ) ,
choiceNames = c ( trnslt ( " All" ) , trnslt ( " Year" ) , trnslt ( " Gender" ) , trnslt ( " Department" ) , trnslt ( " Specialty" ) , trnslt ( " Specialty code" ) , trnslt ( " ICU status" ) , trnslt ( " Clinical status" ) , trnslt ( " Outward status" ) ) ,
2021-11-01 14:38:23 +01:00
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" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Use slider to select by count" ) ,
2021-11-01 14:38:23 +01:00
choices = seq ( 0 , n_distinct ( radar_data $ mo ) , 10 ) ,
selected = c ( 0 , 10 )
) ,
size = " xs" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Select top ..." ) ,
2021-11-01 14:38:23 +01:00
up = TRUE )
) ,
div (
style = " position: absolute; left: 12em; bottom: 0.5em;" ,
dropdown (
radioGroupButtons (
inputId = " box2.3_pathogen" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Select pathogen group" ) ,
2021-11-01 14:38:23 +01:00
choiceNames = c ( " all" , " definite" , " probable" , " improbable" ) ,
choiceValues = c ( 0 , 1 , 2 , 3 ) ,
selected = 0
) ,
size = " xs" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Pathogens" ) ,
2021-11-01 14:38:23 +01:00
up = TRUE
) ) ,
div (
style = " position: absolute; left: 18.7em; bottom: 0.5em;" ,
dropdown (
selectInput (
inputId = " box2.5_search" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Search and select isolates" ) ,
2021-11-01 14:38:23 +01:00
choices = mo_fullname ( unique ( radar_data $ mo ) [which ( ! is.na ( unique ( radar_data $ mo ) ) ) ] ) ,
multiple = TRUE
) ,
size = " xs" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Search isolates" ) ,
2021-11-01 14:38:23 +01:00
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" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Define first isolate guidelines" ) ,
2021-11-01 14:38:23 +01:00
up = TRUE
) ) ,
div (
style = " position: absolute; right: 3.5em; bottom: 0.5em;" ,
dropdown (
2021-11-16 12:21:55 +01:00
downloadButton ( outputId = " down_box_patho" , label = trnslt ( " Download plot" ) ) ,
2021-11-01 14:38:23 +01:00
size = " xs" ,
icon = icon ( " download" , class = " opt" ) ,
up = TRUE
)
) ,
withSpinner (
girafeOutput ( " patho_plot" , height = 400 ) ,
type = 4 ,
color = " #d33724" ,
size = 0.7
)
) ,
tabPanel (
2021-11-16 12:21:55 +01:00
title = trnslt ( " First isolates per episode" ) ,
2021-11-01 14:38:23 +01:00
div (
style = " position: absolute; left: 0.5em; bottom: 0.5em;" ,
dropdown (
radioGroupButtons (
inputId = " box2.2_group" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Select group" ) ,
choiceNames = c ( trnslt ( " All" ) , trnslt ( " Year" ) , trnslt ( " Gender" ) , trnslt ( " Department" ) , trnslt ( " Department type" ) , trnslt ( " Specialty" ) , trnslt ( " ICU status" ) , trnslt ( " Clinical status" ) , trnslt ( " Outward status" ) ) ,
2021-11-01 14:38:23 +01:00
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" ) ) +
2021-11-16 12:21:55 +01:00
labs ( x = " " , y = trnslt ( " Count" ) , fill = " " , title = trnslt ( " Number of positive & negative blood culture tests" ) ) +
2021-11-01 14:38:23 +01:00
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 ( {
2021-11-16 12:21:55 +01:00
if ( ! is.null ( input $ box2.5_search ) ) {
mos <- as.mo ( input $ box2.5_search )
} else {
mos <- character ( 0 )
}
mo_search <- c ( " none" , mos )
2021-11-01 14:38:23 +01:00
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 ) ) )
} ) +
2021-11-16 12:21:55 +01:00
labs ( x = " " , y = trnslt ( " Count" ) , title = trnslt ( " Number of first isolates detected" ) ) +
2021-11-01 14:38:23 +01:00
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 %>%
2021-11-16 12:21:55 +01:00
mutate ( first_14 = first_isolate ( col_mo = " mo" , col_date = " date" , col_patient_id = " patientid" ,
episode_days = 14 , info = FALSE ) ,
first_30 = first_isolate ( col_mo = " mo" , col_date = " date" , col_patient_id = " patientid" ,
episode_days = 30 , info = FALSE ) ,
first_60 = first_isolate ( col_mo = " mo" , col_date = " date" , col_patient_id = " patientid" ,
episode_days = 60 , info = FALSE ) ) %>%
2021-11-01 14:38:23 +01:00
group_by_at ( input $ box2.2_group ) %>%
summarise ( " 14 days" = sum ( first_14 , na.rm = TRUE ) ,
" 30 days" = sum ( first_30 , na.rm = TRUE ) ,
2021-11-16 12:21:55 +01:00
" 60 days" = sum ( first_60 , na.rm = TRUE ) )
pivot_longer ( cols = c ( " 14 days" , " 30 days" , " 60 days" ) )
2021-11-01 14:38:23 +01:00
} )
output $ test_plot <- renderPlot ( {
test_plot ( ) %>%
ggplot ( aes ( value , name ) ) +
geom_col ( colour = " black" , fill = " lightgrey" ) +
2021-11-16 12:21:55 +01:00
labs ( x = trnslt ( " Count" ) , y = trnslt ( " Episode" ) , title = trnslt ( " Number of first isolates per episode" ) ) +
2021-11-01 14:38:23 +01:00
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 (
2021-11-16 12:21:55 +01:00
title = trnslt ( " Resistance profile" ) ,
2021-11-01 14:38:23 +01:00
div (
style = " position: absolute; left: 0.5em; bottom: 0.5em;" ,
dropdown (
radioGroupButtons (
inputId = " box1.2_group" ,
2021-11-16 12:21:55 +01:00
label = trnslt ( " Select group" ) ,
choiceNames = c ( trnslt ( " All" ) , trnslt ( " Year" ) , trnslt ( " Gender" ) , trnslt ( " Department" ) , trnslt ( " Specialty" ) , trnslt ( " Specialty code" ) , trnslt ( " ICU status" ) , trnslt ( " Clinical status" ) , trnslt ( " Outward status" ) ) ,
2021-11-01 14:38:23 +01:00
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 (
2021-11-16 12:21:55 +01:00
downloadButton ( outputId = " down_box_res_prop" , label = trnslt ( " Download plot" ) ) ,
2021-11-01 14:38:23 +01:00
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 (
2021-11-16 12:21:55 +01:00
title = trnslt ( " Combination therapy" ) ,
2021-11-01 14:38:23 +01:00
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" ,
2021-11-16 12:21:55 +01:00
label = HTML ( trnslt ( " Please read the documentation before interpreting results and modifying underlying algorithm" ) ,
as.character ( actionLink ( inputId = " action_link" , label = trnslt ( " (click here)" ) , onclick = ' window.open("https://msberends.github.io/AMR/reference/proportion.html#combination-therapy")' ) ) ) ,
2021-11-01 14:38:23 +01:00
justified = TRUE ,
width = 150 ,
2021-11-16 12:21:55 +01:00
choiceNames = c ( trnslt ( " Only all tested" ) , trnslt ( " All" ) ) ,
2021-11-01 14:38:23 +01:00
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 (
2021-11-16 12:21:55 +01:00
downloadButton ( outputId = " down_box_comb_prop" , label = trnslt ( " Download plot" ) ) ,
2021-11-01 14:38:23 +01:00
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" ) {
2021-11-16 12:21:55 +01:00
ggplot ( data.frame ( ) , aes ( x = 1 , y = 1 , label = trnslt ( " No tests available" ) ) ) +
2021-11-01 14:38:23 +01:00
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" ) ,
2021-11-16 12:21:55 +01:00
text = trnslt ( " Download" ) ) ) ,
lengthMenu = list ( c ( 10 , 20 , -1 ) , c ( 10 , 20 , trnslt ( " All" ) ) ) ,
2021-11-01 14:38:23 +01:00
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 ( )
}
}
}
} )
2021-11-16 12:21:55 +01:00
}