Interactive Shiny app with R - Hovering over points and displaying info

Question

I am working in R to create a Shiny App.

Here is the example data I'm working with:

data <- data.frame("name" = c("A", "A", "B", "B", "C", "C"),
                   "code_name" = c("A1", "A2", "B1", "B2", "C1", "C2"),
                   "x" = c(.13, .64, .82, .39, .51, .03),
                   "y" = c(.62, .94, .10, .24, .20, .84))

I'm trying to have a Shiny App that allows users to select one of the options from column name , display a scatterplot of the x and y values, and also print the value from the code_name column under the plot when you hover your mouse near a certain point.

Here is the code for ui :

library(ggplot2)
library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "x",
                  label = "Choose a Letter:",
                  choices = levels(data$name),
                  selected = "A")
    ),
    mainPanel(
      plotOutput(outputId = "scatterplot",
                 hover = hoverOpts(id ="plot_hover")),
      verbatimTextOutput("hover_info")
    )
  )
)

Here is the code for server :

server <- function(input, output) {
  output$scatterplot <- renderPlot({
    data %>%
      filter(name == input$x) %>%
      ggplot(aes(x, y)) +
      geom_point() +
      xlim(c(0, 1)) +
      ylim(c(0, 1))
    })

  output$hover_info <- renderPrint({
    if(!is.null(input$plot_hover)){
      hover = input$plot_hover
      dist = sqrt((hover$x-data$x)^2 + (hover$y-data$y)^2)
      cat("Name\n")
      if(min(dist) < 3)
        data$code_name[which.min(dist)]
    }
  })
}

Then, of course:

shinyApp(ui, server)

The first output object, output$scatterplot , works as desired. It is a scatterplot of the x and y values for observations where data$name is the selected value from input$x .

The problem is with the second object, output$hover_info . What I want is the text box result from renderPrint to only print code_name for observations where data$name == input$x . The way it is now, if I select "A" from the drop-down menu, and hover over one of the plotted points, it correctly prints that point's code_name below the plot. However, if I hover over a random spot that is near neither point, it will pick up the location of one of the other name option points, and display that observation's code_name .

For example, if you run the code as-is (where name == "A" is the default selection in the drop-down), and hover your mouse near the coordinate x = 0.5, y = 0.5, it will print B2 below the plot. I want to avoid this. It's not a big deal here, where there are only 2 data points per name selection, but when using this same framework with larger data sets, it gets very messy.

I've been trying to include some type of filter call in the output$hover_info object in order for it to only consider observations defined through the drop-down menu, but get an error every time I try that.

Any ideas? Thank you!

Answer 1

I generally recommend an approach in which you create a reactive object for any kind of user manipulation of your data, and then refer to that reactive object in your render* call. I find it less constraining than trying to get everything done within the render* call, it's easier to debug, and to get a better understanding of how the reactivity of your data is supposed to work.

Here I've created a filtered_data reactive object that gets filtered based on the drop down, and then it gets referred further down. The reason why your code wasn't working properly is because your dist calculation was done for the full data set, not the filtered data set. Also, I think your threshold of 3 was too wide, so I changed it to 0.3 here.

Finally, note the usage of req() instead of if(!is.null()) , which is cleaner and is more consistent in terms of when we want it to display the data.

server <- function(input, output) {

  filtered_data <- reactive({
    filter(data, name == input$x)
  })

  output$scatterplot <- renderPlot({
    ggplot(filtered_data(), aes(x, y)) +
      geom_point() +
      xlim(c(0, 1)) +
      ylim(c(0, 1))
  })

  displayed_text <- reactive({
    req(input$plot_hover)
    hover <- input$plot_hover
    dist <- sqrt((hover$x - filtered_data()$x)^2 + (hover$y - filtered_data()$y)^2)

    if(min(dist) < 0.3) {
      filtered_data()$code_name[which.min(dist)]
    } else {
      NULL
    }
  })

  output$hover_info <- renderPrint({
    req(displayed_text())

      cat("Name\n")
      displayed_text()
  })
}

Let me know if this is in line with what you were looking for.