How to plot histogram in a popup window when clicking on a value in a table in Shiny?

shiny
1

I have a very basic Shiny app that looks something like this:

library(shiny)
library(tidyverse)

dataframe1 <- data.frame(Player = rep(c("Lebron", "Steph", "Harden", 
                                        "Giannis"), each = 30),
                         Game = rep(1:30, 4),
                         Points = round(runif(120, 15, 40), 0))

ui <- fluidPage(
       sidebarPanel(
           selectInput("player", 
                       "Select a player",
                        choices = unique(dataframe1$Player))
  ),

      mainPanel(
           tableOutput("average"),
           plotOutput("ptdist")
  )
 )

server <- function(input, output){
       playerFilt <- reactive({
                       dataframe1 %>% 
                         filter(Player == input$player)
       })

       output$average <- renderTable({
                            playerFilt() %>% 
                               summarise(PPG = sum(Points) / n())
       })

       output$ptdist <- renderPlot({
                            playerFilt() %>%
                               ggplot() + 
                               geom_histogram(aes(x = Points),binwidth = 2.5, fill = "skyblue", color = "black") + 
                               theme_bw()
       })
     }  

shinyApp(ui, server)

What I wanted to do, however, was hide this plot, and only show it in a pop up window, when someone clicked on the PPG value. Something like this, but making the value on the table clickable instead of creating an actionButton. I saw
Bárbara Borges' rstudio::conf() talk where she did something very close to what I'm looking for, but she took values from an entire row and it generated a text instead of a plot.

Is this possible? Can anyone help?

Thanks in advance!

2

If you are using a datatable, you can use the callback argument with javascript code to determine if you clicked on the cell. If you signal this event back to R, you can use it to open a popup. See this example.

edit: see below for how this could work

library(shiny)
library(tidyverse)
library(DT)

dataframe1 <- data.frame(Player = rep(c("Lebron", "Steph", "Harden",
                                        "Giannis"), each = 30),
                         Game = rep(1:30, 4),
                         Points = round(runif(120, 15, 40), 0))

ui <- fluidPage(
  sidebarPanel(
    selectInput("player",
                "Select a player",
                choices = unique(dataframe1$Player))
  ),

  mainPanel(
    dataTableOutput("average")
  )
)

server <- function(input, output, session){
  playerFilt <- reactive({
    dataframe1 %>%
      filter(Player == input$player)
  })

  output$average <- renderDataTable({
    datatable(playerFilt() %>%
                summarise(PPG = sum(Points) / n()), rownames = FALSE, selection = 'none',
                callback = JS("table.on('click.dt', 'td', function() {
                               Shiny.onInputChange('click', Math.random());
                });"))
  })

  # define modal
  plotModal <- function() {
    modalDialog(
      plotOutput("ptdist")
    )
  }

  observeEvent(input$click, {
    print("Clicked!")
    removeModal()
    showModal(plotModal())
  })

  output$ptdist <- renderPlot({
    playerFilt() %>%
      ggplot() +
      geom_histogram(aes(x = Points),binwidth = 2.5, fill = "skyblue", color = "black") +
      theme_bw()
  })
}

shinyApp(ui, server)
1 Like