Selection of activity trace in a chart and display in a data table in R shiny

Question

If you run the R shiny script below, you get two boxes in an R shiny dashboard, The chart on the left displays a plot for all the traces or set of activities that occur in t

Answer 1

Since you have given such a huge example and its hard to decode each and every line in your code, I have removed some code to get the rows for your selected event.

Instead of event_data("plotly_click")[["y"]]) I am using the x as vent_data("plotly_click")$x and getting the trace_id by using paste0 function.

The part of the code that I have modified to get the rows is:

 output$trace_table <- renderDataTable({
      req(event_data("plotly_click"))
       trace = event_data("plotly_click")$x
      Values <- dta() %>% 
        filter(variable == paste0("trace_",trace))# %>% 
        #select(value)


      datatable(Values)
      # valueText <- paste0(Values[[1]] %>% na.omit(),collapse = "")
      # agg <- aggregate(handling~patient, data = patients10(), FUN = function(y)
      # {paste0(unique(y),collapse = "")})
      # 
      # currentPatient <- agg$patient[agg$handling == valueText]
      # 
      # patients10_final <- patients10() %>%
      #   filter(patient %in% currentPatient)
      # 
      # datatable(patients10_final, options = list(paging = FALSE, searching = 
      #                                              FALSE))
    })

EDIT: Here is the full code:

  library(shiny)
  library(shinydashboard)
  library(bupaR)
  library(lubridate)
  library(dplyr)
  library(xml2)
  library(ggplot2)
  library(ggthemes)
  library(glue)
  library(tibble)
  library(miniUI)
  library(tidyr)
  library(shinyWidgets)
  library(plotly)
  library(DT)
  library(splitstackshape)
  library(scales)
  dta <- reactive({
    tr <- data.frame(traces(patients, output_traces = T, output_cases = F))
    tr.df <- cSplit(tr, "trace", ",")
    tr.df$af_percent <-
      percent(tr.df$absolute_frequency/sum(tr.df$absolute_frequency))
    pos <- c(1,4:ncol(tr.df))
    tr.df <- tr.df[,..pos]
    tr.df <- melt(tr.df, id.vars = c("trace_id","af_percent"))
    tr.df
  })
  patients10 <- reactive({
    patients11 <- arrange(patients, patient)
    patients12 <- patients11 %>% arrange(patient, time,handling_id)
    patients12 %>%
      group_by(patient) %>%
      mutate(time = as.POSIXct(time, format = "%m/%d/%Y %H:%M"),diff_in_sec = time 
             - lag(time)) %>% 
      mutate(diff_in_sec = ifelse(is.na(diff_in_sec),0,diff_in_sec)) %>% 
      mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% 
      mutate(diff_in_days = as.numeric(diff_in_hours/24))
  })
  ui <- dashboardPage(
    dashboardHeader(title = "Sankey Chart"),
    dashboardSidebar(
      width = 0
    ),
    dashboardBody(
      box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader = 
            T,
          plotlyOutput("trace_plot")),

      box( title = "Case Summary", status = "primary", height = "455",solidHeader 
           = T, 
           dataTableOutput("trace_table"))
    )
  )
  server <- function(input, output) 
  { 
    output$trace_plot <- renderPlotly({
      mp1 = ggplot(data = dta(), aes(x = variable,y = trace_id, fill = value,
                                     label = value,
                                     text=paste("Variable:",variable,"<br> Trace 
                                                ID:",trace_id,"<br> 
                                                Value:",value,"<br> Actuals:",af_percent))) +
        geom_tile(colour = "white") +
        geom_text(colour = "white", fontface = "bold", size = 2) +
        scale_fill_discrete(na.value="transparent") +
        theme(legend.position="none") + labs(x = "Traces", y = "Activities")
      ggplotly(mp1, tooltip=c("text"), height = 516, width = 605)

    })
    output$trace_table <- renderDataTable({
      req(event_data("plotly_click"))
       trace = event_data("plotly_click")$x
      Values <- dta() %>% 
        filter(variable == paste0("trace_",trace))# %>% 
        #select(value)


      datatable(Values)
      # valueText <- paste0(Values[[1]] %>% na.omit(),collapse = "")
      # agg <- aggregate(handling~patient, data = patients10(), FUN = function(y)
      # {paste0(unique(y),collapse = "")})
      # 
      # currentPatient <- agg$patient[agg$handling == valueText]
      # 
      # patients10_final <- patients10() %>%
      #   filter(patient %in% currentPatient)
      # 
      # datatable(patients10_final, options = list(paging = FALSE, searching = 
      #                                              FALSE))
    })
  }
  shinyApp(ui, server)

Hope it helps!