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()绘制它们。我距离我想要的终点（上面已解释过）几步之遥，但我的直接问题是：

当鼠标超出情节边界时，如何摆脱垂直线？我尝试过的所有内容（如NULL为xintercept时将input$plot_hover传递给NULL）会导致情节错误。
为什么当鼠标位于情节范围内时，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，在loc更改时更改input$plot_hover$x的值

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)

闪亮：在鼠标悬停点处具有垂直线和数据标签的交互式ggplot

1 个答案: