server <- function(input, output, session) { hideTab(inputId = 'RadaRtabs', target = 'Data') output$disclaimerText = renderText('you must confirm understanding the disclaimer') # define data selection --------------------------------------------------- data_select <- reactive({if (input$box2.6_first != 365) { radar_data %>% filter(specialty_shiny %in% input$specialtyInput & department %in% input$departmentInput & Materiaal %in% input$materialInput) %>% 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 & Materiaal %in% input$materialInput) } }) # 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 (input$allDepartments) { if (!is.null(x)) { update_departments <- radar_data %>% filter(specialty_shiny %in% input$specialtyInput) x <- sort(unique(update_departments$department)) } else { x <- character(0) } } else { x <- character(0) } updateCheckboxGroupInput( session, inputId = "departmentInput", label = NULL, choices = sort(unique(radar_data$department)), selected = x ) }) observeEvent(input$btnDisclaimerUnderstood, { if (input$cbDisclaimerRead == T) { showTab(inputId = 'RadaRtabs', target = 'Data', select = T) } }) # 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 = trnslt("Positive & negative cultures"), div( style = "position: absolute; left: 0.5em; bottom: 0.5em;", dropdown( radioGroupButtons( inputId = "box2.1_group", 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")), 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 = trnslt("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 = 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")), 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 = trnslt("Use slider to select by count"), choices = seq(0, n_distinct(radar_data$mo), 10), selected = c(0, 10) ), size = "xs", label = trnslt("Select top ..."), up = TRUE) ), div( style = "position: absolute; left: 12em; bottom: 0.5em;", dropdown( radioGroupButtons( inputId = "box2.3_pathogen", label = trnslt("Select pathogen group"), choiceNames = c("all", "definite", "probable", "improbable"), choiceValues = c(0, 1, 2, 3), selected = 0 ), size = "xs", label = trnslt("Pathogens"), up = TRUE )), div( style = "position: absolute; left: 18.7em; bottom: 0.5em;", dropdown( selectInput( inputId = "box2.5_search", label = trnslt("Search and select isolates"), choices = mo_fullname(unique(radar_data$mo)[which(!is.na(unique(radar_data$mo)))]), multiple = TRUE ), size = "xs", label = trnslt("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 = trnslt("Define first isolate guidelines"), up = TRUE )), div( style = "position: absolute; right: 3.5em; bottom: 0.5em;", dropdown( downloadButton(outputId = "down_box_patho", label = trnslt("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 = trnslt("First isolates per episode"), div( style = "position: absolute; left: 0.5em; bottom: 0.5em;", dropdown( radioGroupButtons( inputId = "box2.2_group", 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")), 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 & Materiaal %in% input$materialInput) %>% 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 = trnslt("Count"), fill = "", title = trnslt("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({ if (!is.null(input$box2.5_search)) { mos <- as.mo(input$box2.5_search) } else { mos <- character(0) } mo_search <- c("none", mos) 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 = trnslt("Count"), title = trnslt("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(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)) %>% 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 = trnslt("Count"), y = trnslt("Episode"), title = trnslt("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 = trnslt("Resistance profile"), div( style = "position: absolute; left: 0.5em; bottom: 0.5em;", dropdown( radioGroupButtons( inputId = "box1.2_group", 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")), 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 = trnslt("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 = trnslt("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(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")'))), justified = TRUE, width = 150, choiceNames = c(trnslt("Only all tested"), trnslt("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 = trnslt("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") { out <- .data %>% filter(mo == as.mo(mo_selected)) print(paste("rijen voor ", mo_selected, ":", nrow(out))) abx <- gsub("Co-trimoxazole", "Trimetoprim / sufamethoxazole", abx) if (nrow(out) > 0) { out %>% select(mo, as.character(as.ab(abx))) %>% count_df(., translate_ab = "name", language = language) } else { out } # .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) # }} } cat('Implicit join in get_resistance_df(..) @server.R:692\n') 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)) %>% mutate(flag = "") # 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 = trnslt("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) + # flag not used at the moment - for intrinsic resistance 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 = trnslt("Download"))), lengthMenu = list( c(10, 20, -1), c(10, 20, trnslt("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 & Materiaal %in% input$materialInput) %>% 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 & Materiaal %in% input$materialInput) %>% 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() } } } }) }