Linking dataTableOutput and plot in Shiny in R

I am wanting to link a dataTableOutput and a plot within a shiny app, so that when a row or a cell is selected within the table, the plot will reactively update with the data associated with that row.

Here is my data:-

Data

#relevant libraries
library(wakefield)#for generating the Status variable
library(dplyr)
library(stringi)
library(Pareto)
library(uuid)
library(ggplot2)
library(shiny)
library(DT)


#mock data creation
set.seed(1)
#data<-data.frame()
Date<-seq(as.Date("2015-01-01"), as.Date("2015-12-31"), by = "1 day")
Date<-sample(rep(Date,each=10),replace = T)

event<-r_sample_factor(x = c("Wrestling", "Drama", 
                                    "Information", "Football", "Rugby", "Movie", "Music", "News"), n=length(Date))

channel<-r_sample_factor(x = c("Channel 1", "Channel 2", "Channel 3", "Channel 4"), n=length(Date))

Hour<-r_sample_factor(x = c(0:23), n=length(Date))

Group<-r_sample_factor(x = c("A","B","C","D","E"), n=length(Date))

#creating user ID

set.seed(1)

n_users <- 100
n_rows <- 3650

relative_probs <- rPareto(n = n_users, t = 1, alpha = 0.3, truncation = 500) 
unique_ids <- UUIDgenerate(n = n_users)

AnonID <- sample(unique_ids, size = n_rows, prob = relative_probs, replace = TRUE)


data<-data.frame(AnonID,Group,Date,Hour,channel,event)
data$Hour<-as.numeric(data$Hour)
head(data)

And here is my shiny app so far:-

Shiny code


#ui================================
ui<-fluidPage(
  titlePanel("Example panel"),
  tabsetPanel(
    tabPanel("example text",
             sidebarPanel(width = 4,
                          dateRangeInput("daterange","Select dates", format = "yyyy-mm-dd",
                                         start = min("2015-01-01"),
                                         end = max("2015-01-10")),
                          numericInput("hourmin", "Select mininum hour",10,0,23),
                          numericInput("hourmax", "Select maximum hour", 22,0,23),
                          pickerInput("channel", "Select channel",
                                      choices = unique(channel), options = list('actions-box'=T,'live-search'=T),multiple = T)),#end of sidebarPanel
             mainPanel(
               column(width = 10, plotOutput("barplot", width = "100%")),
                      column(width = 8, dataTableOutput("table"))
             )#end of mainPanel
                          
             )
             )#end of tabPanel
  )#end of tabsetPanel
)#end of fluidPage


#server===========================================

server<-function(input,output,session){

  
 rv <- reactiveVal(NULL)  
  
  observe({
    
    rv(data)
  
    output$table<-renderDT({
      rv()%>%
        arrange(desc(Date))%>%
        filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
        filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
        filter(channel %in% input$channel)%>%  
        group_by(channel,Date)%>%
        arrange(Date)%>%
        summarise(Programme=paste0(Hour,":",substr(event,1,3)), .groups = 'drop')%>%
        #mutate(rn=rowid(Date))%>%
        pivot_wider(names_from = Date,values_from = Programme) # %>%
      #select(-rn)
    })
    output$barplot<-renderPlot({
      
      rv()%>%
        filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
        filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
        filter(channel %in% input$channel)%>%
        group_by(Date,Group)%>%
        summarise(UniqueID=n_distinct(AnonID))%>%
        ggplot()+
        geom_bar(aes(x=Date,y=UniqueID, fill=Group), stat = "identity", position = "dodge")
        
      
    })
    
    })#end of observe
  }

shinyApp(ui,server)

Which will give you this:-

What I want to do is be able to click on a row in the dataTableOutput (which is by Date and Hour) and then plot the number of unique UniqueID in the data which is associated with that date and time. What am I missing from my code that would allow me to do this?

Thanks!

Solution

As a first step, we can use reactiveValues to hold the data from the rendered datatable.

rv <- reactiveValues(data = NULL)

Second, we can use the possibility to select rows from a DT table.

    output$table <- DT::renderDataTable({
      DT::datatable(rv$data, selection = list(target = "row"))
    })

Now all that remains is capturing the hours and dates contained in the resulting table and use that information to create de barplot.

Note that this table will contain the dates as column names and the hours contained inside a string because of how pivot_table was previously used.

Code:

# relevant libraries
library(wakefield) # for generating the Status variable
library(tidyverse)
library(stringi)
library(Pareto)
library(uuid)
library(shiny)
library(DT)
library(shinyWidgets)

################### // UI //###################

ui <- fluidPage(
  titlePanel("Example panel"),
  tabsetPanel(
    tabPanel(
      "example text",
      sidebarPanel(
        width = 4,
        dateRangeInput("daterange", "Select dates",
          format = "yyyy-mm-dd",
          start = min("2015-01-01"),
          end = max("2015-01-10")
        ),
        numericInput("hourmin", "Select mininum hour", 10, 0, 23),
        numericInput("hourmax", "Select maximum hour", 22, 0, 23),
        pickerInput("channel", "Select channel",
          choices = unique(channel),
          options = list("actions-box" = T, "live-search" = T),
          multiple = T,
          selected = unique(channel)
        )
      ), # end of sidebarPanel
      mainPanel(
        column(width = 10, plotOutput("barplot", width = "100%")),
        column(width = 8, DTOutput("table"))
      ) # end of mainPanel
    ) # end of tabPanel
  ) # end of tabsetPanel
) # end of fluidPage


################### // SERVER //###################


server <- function(input, output, session) {
  rv <- reactiveValues(data = NULL)


  # TABLE -------------------------------------------------------------------

  observe({
    rv$data <-
      data %>% # data was created outside the shiny app meaning that is present in the global env
      arrange(desc(Date)) %>%
      filter(Date >= input$daterange[1] & Date <= input$daterange[2]) %>%
      filter(Hour >= input$hourmin & Hour <= input$hourmax) %>%
      filter(channel %in% input$channel) %>%
      group_by(channel, Date) %>%
      arrange(Date) %>%
      summarise(Programme = paste0(Hour, ":", substr(event, 1, 3)), .groups = "drop") %>%
      pivot_wider(
        names_from = Date,
        values_from = Programme,
        values_fn = as_mapper(~ reduce(., paste, sep = ","))
      )

    output$table <- DT::renderDataTable({
      DT::datatable(rv$data, selection = list(target = "row"))
    })
  })



  observeEvent(input$table_rows_selected, {
    req(input$table_rows_selected)

    # the dates i want are the names of the columns
    dts <- rv$data[input$table_rows_selected, ] %>%
      names() %>%
      `[`(-1)



    hrs <- # this will give me the hours present in the cells selected from DT
      rv$data[input$table_rows_selected, ] %>%
      map(~ str_extract_all(., "\\d+")) %>%
      `[`(-1) %>%
      reduce(c) %>%
      reduce(c)

    # i know that i need the first column only
    channel_values <- rv$data[input$table_rows_selected, 1] %>%
      pull(channel) %>%
      as.character()


    ###### BARPLOT #########
    output$barplot <- renderPlot({
      data %>%
        filter(Date >= min(dts) & Date <= max(dts)) %>%
        filter(Hour >= min(hrs, na.rm = TRUE) & Hour <= max(hrs, na.rm = TRUE)) %>%
        filter(channel %in% channel_values) %>%
        group_by(Date, Group) %>%
        summarise(UniqueID = n_distinct(AnonID)) %>%
        ggplot() +
        geom_bar(aes(x = Date, y = UniqueID, fill = Group), stat = "identity", position = "dodge")
    })
  }) # end of observe
}

shinyApp(ui, server)