闪亮：互动ggplot与垂直线和数据标签在鼠标悬停点

Question

我想看看我是否能在一个闪亮的应用程序，创建一个折线图：

• 绘制通过垂直线，并
• 标签

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

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

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

1. 当鼠标位于图的边界之外时，我该如何摆脱垂直线？我试过的所有东西（例如，如果input$plot_hover为NULL，则通过NULL到xintercept）会导致绘图错误。
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取决于连续变化，或者被复位为null input$plot_hover$x。

建议的解决方案

• 使用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)