#' Visualize contact tracing data #' #' @description #' Run an application that visualizes contact tracing data that can be used to #' estimate incubation and latency time using the doublIn package. #' #' @return R Shiny application. #' #' @details #' We have used this app to visualize contact tracing data that was collected #' using a tailor-made contact tracing form. For details and source code, have #' a look at the Github page of Manh Nguyen Duc. #' #' @references Manh Nguyen Duc (2024) Contact tracing form using KoboToolbox #' https://github.com/manhnguy/Contact-Tracing-for-Respiratory-Transmitted-Diseases #' #' @author Vera Arntzen, \email{v.h.arntzen@@math.leidenuniv.nl} #' @keywords survival #' @rawNamespace import(mStats, except = c("label", "recode")) #' @import tools #' @import shiny #' @import magrittr #' @import dplyr #' @rawNamespace import(plotly, except = last_plot) #' @import xtable #' @rawNamespace import(epicontacts, except = thin) #' @import visNetwork #' @rawNamespace import(lubridate, except = c(day, month, is.Date, year)) #' @import shinythemes #' @rawNamespace import(DT, except = c(formatDate, dataTableOutput, renderDataTable)) #' @import shinyWidgets #' @import shinydashboard #' @importFrom methods is #' #' @examples #' # To run the app: #' if(interactive()){Visualize_contact_tracing_data()} #' #' @export Visualize_contact_tracing_data <- function(){ # This function consists of three parts: (i) preparation of the contact network; # (ii) the R Shiny 'ui' and the (iii) R Shiny 'server'. # General remarks # .[[]]: corrects for the fact that colName is a string. # observe (...) updateSelectizeInput (...): the drop-down menu depends on data set. # . . . . . Prepare the network . . . . . . . . . . . . . . . . . . . . . . . prepare_network <- function(dat){ dat <- rename(dat, case_id = id) # ID has to be the first variable dat <- dat[ , c(which( (colnames(dat) == "case_id") == TRUE) , which( (colnames(dat)!="case_id") == TRUE))] # Uses package epicontacts l1 <- sapply(dat$infector, length) contacts_rep <- rep(dat$case_id, l1) case_unl <- unlist(dat$infector) contacts <- cbind(contacts_rep, case_unl) contacts <- contacts[!is.na(contacts[,2]),] colnames(contacts) <- c("case_id", "infector") x <- make_epicontacts(linelist = dat, contacts = contacts, id = "case_id", to = "case_id", from = "infector", directed = TRUE) return(x) } # Function to prepare the network prepare_network_new <- function(dat, case_id, infector_id){ dat <- rename(dat, case_id = case_id, infector = infector_id) dat <- dat[ , c(which( (colnames(dat) == case_id) == TRUE) , which( (colnames(dat)!= case_id) == TRUE))] l1 <- sapply(dat$infector, length) contacts_rep <- rep(dat$case_id, l1) case_unl <- unlist(dat$infector) contacts <- cbind(contacts_rep, case_unl) contacts <- contacts[!is.na(contacts[,2]),] colnames(contacts) <- c("case_id", "infector") x <- make_epicontacts(linelist = dat, contacts = contacts, id = "case_id", to = "case_id", from = "infector", directed = TRUE) return(x) } # . . . . . UI . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . # UI consists of a header, a sidebar and a body. # Header header <- dashboardHeader( title = "Visualize contacts" ) # Sidebar sidebar <- dashboardSidebar( sidebarMenu( menuItem("Load data", tabName = "loaddata"), menuItem("Contact network", tabName = "network") ) ) # Body body <- dashboardBody( tabItems( # Tab 1: Load a contact tracing data set tabItem(tabName = "loaddata", h2(""), # Title fluidRow( tabBox(width = 6, title = "Step 1", tabPanel("Load the data.", # Select a data set fileInput(width = 400, inputId = "file1", label = "Select a RDS file with contact tracing data to import.", accept = ".rds") ) ), tabBox(width = 6, title = "Getting started in three steps.", p("The aim of this application is to visualize contact tracing data, facilitating data cleaning and processing steps. Before you move on to the other tabs, import a data set in .RDS format. To save data as .RDS file, use"), code("saveRDS(data)."), p("If everything is correct, the data table should show up. Next, select the required variables. All ID variables need to be in text format; dates need to be in the date format. To check if the format is correct, use the following R functions:"), code("type <- class(data$variable_name); is.Date(type); is.character(type); is.factor(type)") ) ), fluidRow( tabBox(width = 6, title = "Step 2", tabPanel("Check if contact tracing data is imported correctly.", dataTableOutput("table")), ), # Choice of variables tabBox(width = 6, title = "Step 3", tabPanel("Choose variables.", selectizeInput(width = 400, 'case_var', 'IDs of the infectees:', choices = list(), multiple = FALSE ), selectizeInput(width = 400, 'infector_var', 'IDs of infector(s), i.e. possible sources:', choices = list(), multiple = FALSE), selectizeInput(width = 400, 'start_of_exposure', 'Start of exposure (E0):', choices = list(), multiple = FALSE), selectizeInput(width = 400, 'end_of_exposure', 'End of exposure (E1)', choices = list(), multiple = FALSE), selectizeInput(width = 400, 'symptom_onset', 'Symptom onset (S)', choices = list(), multiple = FALSE), selectizeInput(width = 400, 'last_negative', 'Last negative test (P0)', choices = list(), multiple = FALSE), selectizeInput(width = 400, 'first_positive', 'First positive test (P1)', choices = list(), multiple = FALSE) )) ) ), # Tab 2: Visualize the contact network tabItem(tabName = "network", fluidRow( tabBox(width = 6, tabPanel("Settings", selectizeInput( 'nodecol', 'Color network nodes by:', choices = list(), multiple = FALSE ), checkboxInput('show_symptoms', "Incubation time (infection to symptom onset)", value = TRUE, width = NULL), checkboxInput('show_testwindow', "Latency time (here: infection to PCR positivity)", value = FALSE, width = NULL) ) ), tabBox(width = 6, title = "Description", p("The network graph displays the possible transmission between infectee and potential sources. Each arrow represents one possible infection, from infector to infectee. To select a cluster of cases to display in the timeline figure on the right and the table below, click on a central case in the network for two seconds."), p("The figure below visualizes the time of the start- end endpoint for selected observations. Start- and endpoint differs per quantity of interest, i.e. incubation or latency time. Time of infection is typically known to fall in a certain window only. The same holds for start of infectiousness, that is assumed to occur in between the last negative and first positive PCR-test. Start and and of the window are represented by a '0' and '1', respectively. When these are not displayed, they are missing in the data."), ) ), fluidRow( tabBox(tabPanel("Network", visNetworkOutput("network"))), tabBox(tabPanel("Figure", plotlyOutput("timeline"))) ), fluidRow( tabBox(width = 12, tabPanel("Table", dataTableOutput("table_selected_nodes"))) ) ) # End tabItem ) # End tabitems ) # End dashboardbody # Combine ui <- dashboardPage( header, sidebar, body ) # . . . . . Server . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . server <- shinyServer(function(input, output, session) { output$image <- renderImage({ list(src = "Timeline_diagram.jpeg", alt = "This is alternate text", height = 400, width = 400 ) }, deleteFile = TRUE) output$text <- renderText({ input$txt }) output$text2 <- renderText({ input$txt2 }) # Load the data mydat <- reactive({ if (is.null(input$file1$datapath)) { # Hashed for testing # readRDS("inst/extdata/df2.RDS") } else { readRDS(input$file1$datapath) } }) selected_data <- reactive({ as.data.frame(dat_for_tab()) }) # Inputs for subset observe({ updateSelectizeInput(session, "nodecol", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "infector_var", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "case_var", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "start_of_exposure", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "end_of_exposure", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "symptom_onset", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "last_negative", choices = names(selected_data())) }) observe({ updateSelectizeInput(session, "first_positive", choices = names(selected_data())) }) nodecol <- reactive({ input$nodecol }) # For figure: should symptoms and last neg. - first pos. test be plotted? show_symptoms <- reactive({input$show_symptoms}) show_testwindow <- reactive({ input$show_testwindow }) # Subset of data (based on selection options on the left) dat_for_tab <- reactive({mydat() %>% mutate(row_nr = row_number()) %>% relocate(row_nr) }) # Create data table output$table <- renderDataTable({ as.data.frame( dat_for_tab() ) %>% datatable( options = list(scrollX = TRUE)) %>% formatStyle(1:ncol(dat_for_tab()), lineHeight='60%') }) dat_network <- reactive({ prepare_network_new(dat_for_tab(), input$case_var, input$infector_var) }) output$network <- renderVisNetwork({ vis_epicontacts(dat_network(), node_color = input$nodecol) %>% visOptions(highlightNearest=TRUE, nodesIdSelection = TRUE) %>% visInteraction(multiselect = TRUE) %>% visEvents(select = "function(data) { Shiny.onInputChange('current_nodes_selection', data.nodes); Shiny.onInputChange('current_edges_selection', data.edges); ;}") }) # Node selection to subset data selected_nodes <- reactive({ input$current_nodes_selection }) # Table selected nodes output$table_selected_nodes <- renderDataTable({ as.data.frame( dat_for_tab() ) %>% filter( (Case_ID %in% selected_nodes()) |(infector %in% selected_nodes() ) ) %>% datatable( options = list(scrollX = TRUE)) %>% formatStyle(1:ncol(dat_for_tab()), lineHeight='60%') }) # Timeline output$timeline <- renderPlotly({ colors <- c("exposure window" = "blue", "symptom onset" = "orange", "last neg. to first pos." = "purple", "reported" = "green", "ID" = "black") shapes <- c(95, 43) mydat <- as.data.frame( dat_for_tab() ) %>% filter( (.[[input$case_var]] %in% selected_nodes()) |(.[[input$infector_var]] %in% selected_nodes() ) ) %>% mutate(case_var = .[[input$case_var]], start_of_exposure = .[[input$start_of_exposure]], end_of_exposure = .[[input$end_of_exposure]], symptom_onset = .[[input$symptom_onset]], last_negative = .[[input$last_negative]], first_positive = .[[input$first_positive]] ) %>% mutate(new_row_nr = row_number(), xloc = min(start_of_exposure, na.rm = TRUE)) p <- ggplot(data = mydat) + geom_rect(aes(y = new_row_nr, xmin = start_of_exposure, xmax = end_of_exposure, ymin = new_row_nr - 0.5, ymax = new_row_nr + 0.5), fill = "blue", alpha = .25) + geom_rect(aes(y = new_row_nr, xmin = last_negative, xmax = first_positive, ymin = new_row_nr - 0.5, ymax = new_row_nr + 0.5), fill = "purple", alpha = .25) + geom_text(aes(x = start_of_exposure, y = new_row_nr, color = "exposure window"), size = 4, label = "E0") + geom_text(aes(x = end_of_exposure, y = new_row_nr, color = "exposure window"), size = 4, label = "E1") if(show_symptoms() == TRUE){ p <- p + geom_point(aes(x = symptom_onset, y = new_row_nr, color = "symptom onset"), size=2) } if(show_testwindow() == TRUE){ p <- p + geom_text(aes(x = last_negative, y = new_row_nr, color = "last neg. to first pos."), size = 4, label = "P0") + geom_text(aes(x = first_positive, y = new_row_nr, color="last neg. to first pos."), size = 4, label = "P1") } p <- p + geom_text(aes(x = xloc, y = new_row_nr + 0.5, label = case_var, color = "ID"), size = 2) + scale_x_date("Calender time") + scale_y_discrete(paste("Cases (one per row)")) + labs(color = "") + theme_bw() + scale_color_manual(values = colors) + theme(axis.text.y = element_blank(), axis.ticks.y= element_blank(), axis.text.x=element_text(color = "black"), panel.grid.major = element_blank() ) ggplotly(p, height = 400) %>% layout( showlegend = T, legend = list(x = 0, y = 1.15, orientation = 'h'), xaxis = list(color = "transparent"), yaxis = list(color = "transparent") ) }) # Data selected nodes dat_plot_nodes <- reactive({ mydat() %>% filter( (id %in% selected_nodes()) |(infector %in% selected_nodes() ) ) %>% mutate(row_nr = row_number()) %>% relocate(row_nr) }) }) # . . . . . Run the app . . . . . . . . . . . . . . . . . . . . . . . shinyApp(ui, server) }