閃亮：互動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)