I want to create a clickable histogram in shiny but I don't know if it is possible.

Some months ago I saw a clickable volcano plot which gives you a table of what you click.

Source:

One example (but not clickable) in shiny:

library(shiny)
library(ggplot2)
library(scales)
library(dplyr)

ui <- fluidPage(
  
  titlePanel("Histogram"),
  
  sidebarLayout(
    sidebarPanel(
    ),
    
    mainPanel(
      plotOutput("hist"),
    )
  )
)

mtcars <- mtcars %>% 
  select("hp")
mtcars <- as.matrix(mtcars)

server <- function(input, output) {
  
  output$hist <- renderPlot({
    
    pp <- qplot(mtcars, geom = "histogram", bins = 10, xlab="values", 
                ylab="Frequency", main="Histogram",
                fill=I("red"), col=I("black"), alpha=I(0.4))
    
   pp   scale_x_continuous(breaks=pretty(mtcars, n=10))
  })
  
  
}

shinyApp(ui = ui, server = server)

Does anyone know how to do it?

Thanks very much in advance!

Regards

CodePudding user response：

This is a great question, and what makes it challenging is that the qplot/ggplot charts are static images. The below app.r is an example of how I would do it. I'd love to see other approaches.

In essence:

1. Create a sequence of numbers that will be used both as the breaks in your histogram and as intervals in your dataframe. I based these on user inputs, but you could hardcode them.
2. Assign a "bin" value to each row in the dataframe based on the interval in which the value falls.
3. Record the x-coordinate from the user's click event and assign that a "bin" value based on the same set of intervals.
4. Subset your dataframe and retain only those records where the "bin" value of the data matches the "bin" value of the x-coordinate from the user's click event.

Otherwise, if you're willing to go the d3 route, you could explore

CodePudding user response：

Well, someone answered. Since I took the time to put it together, here is another potential solution.

library(shiny)
library(ggplot2)
library(scales)
library(dplyr)
library(DescTools)                             # added for Closest()

ui <- fluidPage(                    
  
  titlePanel("Histogram"),
  sidebarLayout(
    sidebarPanel(
    ),
    
    mainPanel(
      plotOutput("hist", click = 'plot_click'),  # added plot_click
      verbatimTextOutput("x_value"),             # added queues for interactivity
      verbatimTextOutput("selected_rows")        # added table for bin values
    )
  )
)

# this can be a dataframe or matrix for qplot or ggplot 
           # (not sure if there was another reason you had this code?)
# mtcars <- mtcars %>% 
#   select("hp")                      # if you only want hp
# mtcars <- as.matrix(mtcars)         # I suggest making row names a column
                                      # to keep 2 columns 

pp <- ggplot(mtcars)  
  geom_histogram(aes(x = hp),
                 bins = 10,
                 fill = "red",
                 color = "black",
                 alpha = .4)  
  labs(x = "values",
       y = "Frequency",
       title = "Histogram")

# extract data from plot to find where each value falls within the histogram bins
        # I kept the pkg name, function in more than one library
bd <- ggplot_build(ggplot2::last_plot())$data[[1]]   

# add the assigned bin number to the mtcars frame; used for filtering matches
mtcars$bins <- lapply(mtcars$hp,
                      function(y) {
                        which(bd$x == Closest(bd$x, y))
                      }) %>% unlist()

server <- function(input, output) { 

  output$hist <- renderPlot({
    # moved the plot outside of server, so that global variables could be created
    
    # pp <- qplot(mtcars[,"hp"], geom = "histogram", bins = 10, xlab="values", 
    #             ylab = "Frequency", main = "Histogram",
    #             fill = I("red"), col = I("black"), alpha = I(0.4))
    # scale_x_continuous(breaks=pretty(mtcars, n=10)) # can't use this

    pp
  })
  # # Print the name of the x value                 # added all that's below with server()
  output$x_value <- renderPrint({
    if (is.null(input$plot_click$x)) return()

    # find the closest bin center to show where the user clicked on the histogram
    cBin <- which(bd$x == Closest(bd$x, input$plot_click$x))
    paste0("You selected bin ", cBin)   # print out selected value based on bin center
  })
  # Print the rows of the data frame which match the x value
  output$selected_rows <- renderPrint({
    if (is.null(input$plot_click$x)) return()
    
    # find the closest bin center to show where the user clicked on the histogram
    cBin <- which(bd$x == Closest(bd$x, input$plot_click$x))
    mtcars %>% filter(bins == cBin)
    # mtcars
  })
}

shinyApp(ui = ui, server = server)