Shiny: Interactive ggplot with Vertical Line and Data Labels at Mouse Hover Point

Question

I want to see if I can create a line chart in a Shiny app that:

• Draws a vertical line through, and
• Labels

the data point closest to the x-value of the mouse hover point on each geom_line(), something like a combination of these two charts:

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

This is my first attempt at making my ggplot graph interactive. I've run into some strange behavior that I'm hoping someone can explain to me. My reproducible example is below. It creates two series and plots them with geom_line(). I'm a few steps from my desired endstate (explained above), but my immediate questions are:

1. How can I get rid of the vertical line when the mouse is outside the bounds of the plot? Everything I've tried (like passing NULL to xintercept if input$plot_hover is NULL) causes the plot to error out.
2. Why, when the mouse is inside the bounds of the plot, does the geom_vline bounce all over the place? Why does it go back to x = 0 when the mouse stops moving?

Thank You.

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

A suggested solution to fix the issue is to use reactiveValues and debounce instead of throttle.

The issue

distPlot depends on the input$plot_hover$x which changes continuously, or gets reset to null.

Suggested solution

• use values <- reactiveValues(loc = 0) to hold the value of input$plot_hover$x and initiate it with zero or any value you want.

• use observeEvent, to change the value of loc whenever input$plot_hover$x changes

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

• use debounce instead of throttle to suspend events while the cursor is moving.

I am printing input$plot_hover$x and values$loc to show you the difference.

Note: I made some changes in the code, just to break things down.

---

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)