Shiny：在鼠标悬停点带有垂直线和数据标签的交互式 ggplot

Question

我想看看我是否可以在 Shiny 应用中创建折线图：

• 画一条垂直线，然后
• 标签

每个geom_line()上最接近鼠标悬停点x值的数据点，类似于这两个图表的组合：

Vertical Line through Mouse Hover Point
Data Label for Point at x-value of Mouse Hover Point

这是我第一次尝试让我的 ggplot 图形交互。我遇到了一些奇怪的行为，希望有人可以向我解释。我的可重现示例如下。它创建两个系列并用geom_line() 绘制它们。我距离我想要的最终状态（如上所述）只有几步之遥，但我的直接问题是：

1. 当鼠标超出绘图范围时，如何消除垂直线？我尝试过的所有操作（比如将NULL 传递给xintercept，如果input$plot_hover 是NULL）会导致绘图出错。
2. 为什么，当鼠标在绘图范围内时，geom_vline 会到处弹跳？为什么鼠标停止移动后又回到x = 0？

谢谢。

library(shiny)
library(ggplot2)
library(tidyr)
library(dplyr)

ui <- fluidPage(

   titlePanel("Interactive Plot"),

   sidebarLayout(
      sidebarPanel(
         sliderInput("points",
                     "Number of points:",
                     min = 10,
                     max = 50,
                     value = 25),
         textOutput(outputId = "x.pos"),
         textOutput(outputId = "y.pos"),
         textOutput(outputId = "num_points")
      ),

      mainPanel(
         plotOutput("distPlot", hover = hoverOpts(id = "plot_hover",
                                                  delay = 100,
                                                  delayType = "throttle")))))

server <- function(input, output) {

  # Create dataframe and plot object
  plot <- reactive({
    x <- 1:input$points
    y1 <- seq(1,10 * input$points, 10)
    y2 <- seq(20,20 * input$points, 20)
    df <- data.frame(x,y1,y2)
    df <- df %>% gather(key = series, value = value, y1:y2)
    ggplot(df,aes(x=x, y=value, group=series, color=series)) + 
      geom_line() + 
      geom_point() +
      geom_vline(xintercept = ifelse(is.null(input$plot_hover),0,input$plot_hover$x))
    })

  # Render Plot
   output$distPlot <- renderPlot({plot()})

  # Render mouse position into text
   output$x.pos <- renderText(paste0("x = ",input$plot_hover$x))
   output$y.pos <- renderText(paste0("y = ",input$plot_hover$y))
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

解决此问题的建议解决方案是使用reactiveValues 和debounce 而不是throttle。

问题

distPlot 取决于input$plot_hover$x，它会不断变化，或者重置为 null。

建议的解决方案

• 使用values <- reactiveValues(loc = 0) 保存input$plot_hover$x 的值，并以零或您想要的任何值启动它。

• 使用observeEvent，在input$plot_hover$x 更改时更改loc 的值

  observeEvent(input$plot_hover$x, { values$loc <- input$plot_hover$x })

• 使用debounce 而不是throttle 在光标移动时暂停事件。

我正在打印 input$plot_hover$x 和 values$loc 以向您展示区别。

注意：我对代码做了一些更改，只是为了分解。

---

library(shiny)
library(ggplot2)
library(tidyr)
library(dplyr)
library(shinySignals)

ui <- fluidPage(

  titlePanel("Interactive Plot"),

  sidebarLayout(
    sidebarPanel(
      sliderInput("points",
                  "Number of points:",
                  min = 10,
                  max = 50,
                  value = 25),
      textOutput(outputId = "x.pos"),
      textOutput(outputId = "y.pos"),
      textOutput(outputId = "num_points")
    ),

    mainPanel(
      plotOutput("distPlot", hover = hoverOpts(id = "plot_hover",
                                               delay = 100,
                                               delayType = "debounce")))))

server <- function(input, output) {


  # Create dataframe and plot object
  plot_data <- reactive({
    x <- 1:input$points
    y1 <- seq(1,10 * input$points, 10)
    y2 <- seq(20,20 * input$points, 20)

    df <- data.frame(x,y1,y2)
    df <- df %>% gather(key = series, value = value, y1:y2)
    return(df)
  })

  # use reactive values -------------------------------
  values <- reactiveValues(loc = 0)

  observeEvent(input$plot_hover$x, {
    values$loc <- input$plot_hover$x
  })

  # if you want to reset the initial position of the vertical line when input$points changes
  observeEvent(input$points, {
    values$loc <- 0
  })

  # Render Plot --------------------------------------
  output$distPlot <- renderPlot({
    ggplot(plot_data(),aes(x=x, y=value, group=series, color=series))+ 
      geom_line() + 
      geom_point()+
    geom_vline(aes(xintercept = values$loc))
  })

  # Render mouse position into text

  output$x.pos <- renderText(paste0("values$loc = ",values$loc))
  output$y.pos <- renderText(paste0("input$plot_hover$x = ",input$plot_hover$x ))
}

# Run the application 
shinyApp(ui = ui, server = server)