将鼠标悬停在 Shiny 中的元素上时如何更改绘图？

我正在寻找一种解决方案，当用户将鼠标悬停在同一面板中的超链接上时，可以更改 Shiny 应用程序中的绘图。这是一个简单的例子：

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)

在此示例中，每当我将鼠标悬停在图上方的超链接（示例中的超链接或无意义的超链接，但这不是问题）上时，我想突出显示 ggplot 的一个条（例如，更改其颜色）。正如您在示例中看到的，所有栏都与一个超链接“关联”。

该解决方案应该非常敏感（即快速）。也许，情节有帮助？我不太了解情节，无法说。

我没有任何 JavaScript 经验。我很想了解解决方案，如果涉及任何 JavaScript，所以请尝试广泛评论。多谢！

我附上了应用程序的屏幕截图，因此如果您不想，则不必运行示例代码。

The shinyjs https://deanattali.com/2015/04/23/shinyjs-r-package/包确实可以简化这类事情。我们可以使用onevent使用“mouseenter”作为参数来捕获这些事件的函数。为了让它工作，我们必须给元素一个 id，或者将它们包装在一个带有我们可以引用的 id 的 div 中。然后我们可以使用它们来更新reactiveVal保存当前悬停的元素，该元素又用于reactive这改变了我们的data.frame被绘制。我们可以重置reactiveVal还可以监听“mouseleave”事件。

我希望这有帮助！

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)