How to change a plot when hovering over elements in Shiny?

问题

I am searching for a solution to change a plot in a Shiny app when the user is hovering over a hyperlink in the same panel. Here is a simple example:

library(shiny)

words <- sort(sapply(1:50, USE.NAMES = F, FUN = function (x) paste(sample(letters, 15), collapse = "")), decreasing = T)

dat <- data.frame(words, f = sort(rgamma(50, shape = 5, scale = 1)))

ui <- pageWithSidebar(
  headerPanel("Playground"),
  sidebarPanel(),
  mainPanel(
    uiOutput("links"),
    plotOutput("out.plot")
  )
)

server <- function(input, output, session) {
  urls <- lapply(dat$words, FUN = function (x) {
    a(paste0(" ", x, " "),
      href = paste0("https://", x, ".de"),
      target = "_blank")
  })
  output$links <- renderUI({
    tagList(urls)
  })
  output$out.plot <- renderPlot({
    ggplot(dat, aes(x = words, y = f)) +
      geom_bar(stat = "identity") +
      theme(axis.text.x = element_text(angle = 90))
  })
}

shinyApp(ui, server)

In this example, whenever I am hovering over a hyperlink (the hyperlinks in the example or non-sense, but that is not the problem) above the plot, I want to highlight one bar of the ggplot (e.g., change its color). All the bars are 'associated' with one hyperlink as you can see in the example.

The solution should be very responsive (i.e. fast). Maybe, a plotly plot can help? I don't know plotly well enough to say.

I do not have any experience in JavaScript. I would love to understand the solutions, if any JavaScript is involved, so please try to comment extensively. Thanks a lot!

I am attaching a screenshot of the app so you do not have to run the example code if you don't want to.

回答1:

The shinyjs package can really simplify these kind of things. We can use the onevent function with "mouseenter" as argument to catch those events. In order for that to work we have to give the elements an id, or wrap them in a div with an id that we can refer to. Then we can use them to update a reactiveVal that holds the currently hovered element, which in turn is used in a reactive that modifies our data.frame to be plotted. We can reset the reactiveVal by also listening to "mouseleave" events.

I hope this helps!

library(shiny)
library(shinyjs)
library(dplyr)
library(ggplot2)

set.seed(1)
words <- sort(sapply(1:50, USE.NAMES = F, FUN = function (x) paste(sample(letters, 15), collapse = "")), decreasing = T)

dat <- data.frame(words, f = sort(rgamma(50, shape = 5, scale = 1)),stringsAsFactors = F)

ui <- pageWithSidebar(
  headerPanel("Playground"),
  sidebarPanel(),
  mainPanel(
    uiOutput("links"),
    plotOutput("out.plot"),
    useShinyjs()
  ))

server <- function(input, output, session) {
  urls <- lapply(dat$words, FUN = function (x) {
    div(id=x, a(paste0(" ", x, " "),
      href = paste0("https://", x, ".de"),
      target = "_blank"))
  })
  output$links <- renderUI({
    tagList(urls)
  })

  # Add a reactieVal that we can update once an object is hovered.
  hovered_element <- reactiveVal('')

  # Add onevent for each element in dat$words, to update reactiveVal.
  lapply(dat$words,function(x){
    onevent(event='mouseleave',id=x,hovered_element(''))
    onevent(event='mouseenter',id=x,hovered_element(x))
  })

  # Add a reactive for the dataset, which we debounce so it does not invalidate too often.
  my_data <- reactive({    
    dat$color <- ifelse(dat$words==hovered_element(),'hovered','')
    dat
  })
  my_data <- my_data %>% debounce(50) # tune for responsiveness

  # Plot
  output$out.plot <- renderPlot({
    ggplot(my_data(), aes(x = words, y = f,fill=color)) +
      geom_bar(stat = "identity") +
      theme(axis.text.x = element_text(angle = 90)) + theme(legend.position="none")
  })
}

shinyApp(ui, server)

来源：https://stackoverflow.com/questions/48597530/how-to-change-a-plot-when-hovering-over-elements-in-shiny

标签

javascript

ggplot2

Shiny