将鼠标悬停在Shiny中的元素上时如何更改情节? [英] How to change a plot when hovering over elements in Shiny?

问题描述

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

 库(发光)单词<-sort(sapply(1:50，USE.NAMES = F，FUN = function(x)paste(sample(letters，15)，塌陷=")))，递减= T)dat<-data.frame(words，f = sort(rgamma(50，shape = 5，scale = 1)))ui<-pageWithSidebar(headerPanel("Playground")，sidebarPanel()，mainPanel(uiOutput("links")，plotOutput("out.plot")))服务器<-功能(输入，输出，会话){网址<-lapply(dat $ words，FUN = function(x){a(paste0("，x，")，href = paste0("https://"，x，".de")，target ="_blank")})output $ links<-renderUI({tagList(网址)})output $ out.plot<-renderPlot({ggplot(dat，aes(x =单词，y = f))+geom_bar(stat ="identity")+主题(axis.text.x = element_text(angle = 90))})}ShinyApp(用户界面，服务器) 

在此示例中，每当我将鼠标悬停在图形上方的超链接(示例中的超链接或无意义的链接，但这不是问题)时，我都希望突出显示ggplot的一个条(例如，更改其颜色).如示例中所示，所有的条都与一个超链接关联".

该解决方案应响应迅速(即快速).也许，一个阴谋可以帮上忙吗?我不知道该说什么.

我没有任何JavaScript经验.如果涉及JavaScript，我很想了解解决方案，因此请尝试广泛评论.非常感谢！

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

解决方案

---

 库(发光)图书馆(shinyjs)图书馆(dplyr)库(ggplot2)set.seed(1)单词<-sort(sapply(1:50，USE.NAMES = F，FUN = function(x)paste(sample(letters，15)，塌陷=")))，递减= 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()))服务器<-功能(输入，输出，会话){网址<-lapply(dat $ words，FUN = function(x){div(id = x，a(paste0("，x，")，href = paste0("https://"，x，".de")，target ="_blank"))})output $ links<-renderUI({tagList(网址)})#添加一个reactieVal，我们可以在对象悬停后进行更新.hovered_element<-reactVal('')#为dat $ words中的每个元素添加事件，以更新reactVal.lapply(dat $ words，function(x){onevent(event ='mouseleave'，id = x，hovered_element(''))onevent(event ='mouseenter'，id = x，hovered_element(x))})#为数据集添加一个反应堆，我们对其进行去抖动处理，这样它就不会太频繁地失效.my_data<-反应性({dat $ color<-ifelse(dat $ words == hovered_element()，'hovered'，'')达特})my_data<-my_data％>％去抖动(50)#调整响应速度# 阴谋output $ out.plot<-renderPlot({ggplot(my_data()，aes(x =单词，y = f，填充=颜色))+geom_bar(stat ="identity")+主题(axis.text.x = element_text(angle = 90))+主题(legend.position ="none")})}ShinyApp(用户界面，服务器) 

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.

解决方案

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)

这篇关于将鼠标悬停在Shiny中的元素上时如何更改情节?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！