简体   繁体   中英

Using selectizeInput and plotly::ggplotly to have interactive hover text in R Shiny

I'm working on a shiny app which "in theory" will allow the user to interactively select the hover text of values shown in a graph made using plotly::ggplotly . Thus far, my approach has been to pass the column names from my selectizeInput into a aes(text = paste0(...)) to try and extract both the column's name and the observation which corresponds to the (x,y) point in the plot.

If I explicitly call the columns in aes(text = paste0(...)) , it works great. However, when I try and use the selectizeInput , I've only successfully extracted the column name and not the corresponding observation.

In the example below, I've included what works which contains the desired output in the hover text. I've also included my best attempt at using the interactive input to replicate the desired output.

To the best of my knowledge, I think my problem is that I'm not correctly telling R to use the column name both as a string and as a column. Any help or suggestions would be greatly appreciated!

# Load Libraries ----
library(tidyverse)
library(shiny)
library(shinydashboard)

# Server ----
server <- function(input, output, session){
  
  # Generate sample values ---- 
  set.seed(12345)
  n_points <- 26
  x <- sample(1:100, n_points, TRUE)
  y <- sample(1:100, n_points, TRUE)
  a <- seq(1:n_points)
  b <- letters[seq(1:n_points)]
  df <- tibble(x, y, a, b)
  
  # Plot_works ----
  output$plot_works <- plotly::renderPlotly({
    pc <- df %>% ggplot(aes(x = x, y = y)) +
      geom_point(aes(text = paste0("a: ", a,"\n", "b: ", b)))
    
    p <- plotly::ggplotly(pc, tooltip = c("x", "y", "text"))   
    
    return(p)  
  })

  # Plot_bugged ----
  output$plot_bugged <- plotly::renderPlotly({
    pc <- df %>% ggplot(aes(x = x, y = y)) +
      geom_point(aes(text = ifelse(is.null(input$hovertext), "",
                                    paste0(input$hovertext,": ", !!input$hovertext, collapse = "\n"))))
    
    p <- plotly::ggplotly(pc, tooltip = c("x", "y", "text"))   
    
    return(p)  
  })
}

# Body ----
body <- dashboardBody(
  column(width = 6,
    h3("This Works"),
    plotly::plotlyOutput("plot_works")
  ),
  column(width = 6,
    h3("This does not work"),
    selectizeInput("hovertext", "Select point hovertext", choices = c("a", "b"), multiple = TRUE),
    plotly::plotlyOutput("plot_bugged")
  )
)

# UI ----
ui <- dashboardPage(
  header = dashboardHeader(disable = TRUE),
  sidebar = dashboardSidebar(disable = TRUE),
  body = body)

# Run App ----
shinyApp(ui = ui, server = server)

The issue is that input$hovertext is just a character string containing the column name. Additionally an ifelse is not the right way to check on NULL . To make your hover text conditional on the the user input you could use an if statement instead to add a column with the hovertext to your df:

output$plot_bugged <- plotly::renderPlotly({
    if (is.null(input$hovertext))
       df$text <- ""
    else
      df$text <- paste0(input$hovertext,": ", df[[input$hovertext]])
  
    pc <- df %>% ggplot(aes(x = x, y = y)) +
      geom_point(aes(text = text))
    
    p <- plotly::ggplotly(pc, tooltip = c("x", "y", "text"))   
    
    return(p)  
  })

Thanks to the help I've gotten, I've managed to get this up and running. I've modified the original code to include 3 different options for displaying the hover text.

  1. Hardcoding the variables to the hover text.
  2. Using the selectInput to display a single column from the choices
  3. Using selectizeInput to display any number/combination of columns from choices.
# Load Libraries ----
library(tidyverse)
library(shiny)
library(shinydashboard)

# Server ----
server <- function(input, output, session){
  
  # Generate sample values ---- 
  set.seed(12345)
  n_points <- 26
  x <- sample(1:100, n_points, TRUE)
  y <- sample(1:100, n_points, TRUE)
  a <- seq(1:n_points)
  b <- letters[seq(1:n_points)]
  c <- LETTERS[seq(1:n_points)]
  df <- tibble(x, y, a, b, c)

  #### Hardcoded Hovertext ####
  # Plot
  output$plot_hardcoded <- plotly::renderPlotly({
    pc <- df %>% ggplot(aes(x = x, y = y)) +
      geom_point(aes(text = paste0("a: ", a,"\n", "b: ", b, "\n", "c: ", c)))
    
    p <- plotly::ggplotly(pc, tooltip = c("x", "y", "text"))   
    
    return(p)  
  })

  #### Single Hovertext ####
  
  # Initialize the hovertext value
  single_hovertext <- NULL
  
  # Reactive to update the hovertext
  updateSingleHovertext <- reactive({
    if(is.null(input$single_hovertext)){return("")}
    single_hovertext <- paste0(input$single_hovertext,": ", df[[input$single_hovertext]])
    return(single_hovertext)
  }) 
  
  # Plot
  output$plot_single_hovertext <- plotly::renderPlotly({
    
    pc <- df %>% 
      mutate(single_hovertext = updateSingleHovertext()) %>%
        ggplot(aes(x = x, y = y)) +
        geom_point(aes(text = single_hovertext))
    
    p <- plotly::ggplotly(pc, tooltip = c("x", "y", "text"))   
    
    return(p)  
  })

  #### Multiple Hovertext ####
  
  # Initialize the hovertext value
  multiple_hovertext <- NULL
  
  # Reactive to update the hovertext
  updateMultipleHovertext <- reactive({
    if(is.null(input$multiple_hovertext)){return("")}
    
    for(i in seq_along(input$multiple_hovertext)){
      curr_text <- paste0(input$multiple_hovertext[[i]], ": ", df[[input$multiple_hovertext[[i]]]], "\n")
      multiple_hovertext <- paste0(multiple_hovertext, curr_text)
    }
    
    # Remove the last "\n" from the point_hovertext
    multiple_hovertext <- gsub('.{1}$', '', multiple_hovertext)
    
    return(multiple_hovertext)
  }) 
  
  # Plot 
  output$plot_multiple_hovertext <- plotly::renderPlotly({
    pc <- df %>%
      mutate(multiple_hovertext = updateMultipleHovertext()) %>%
        ggplot(aes(x = x, y = y)) +
        geom_point(aes(text = multiple_hovertext))
    
    p <- plotly::ggplotly(pc, tooltip = c("x", "y", "text"))   
    
    return(p)  
  })
  
  
} # End server

# Body ----
body <- dashboardBody(
  fluidRow(
    column(width = 4,
      h3("Hardcoded Hovertext"),
      selectizeInput("hardcoded_hovertext", "No Choices available:", choices = ""),
      plotly::plotlyOutput("plot_hardcoded")
    ),
    column(width = 4,
      h3("Single Choice Hovertext"),
      selectInput("single_hovertext", "Select point hovertext:", choices = c("a", "b", "c"), selected = "", multiple = FALSE),
      plotly::plotlyOutput("plot_single_hovertext")
    ),
    column(width = 4, 
      h3("Multiple Choice Hovertext"),
      selectizeInput("multiple_hovertext", "Select point(s) hovertext:", choices = c("a", "b", "c"), multiple = TRUE),
      plotly::plotlyOutput("plot_multiple_hovertext")
    )
  )
)
# UI ----
ui <- dashboardPage(
  header = dashboardHeader(disable = TRUE),
  sidebar = dashboardSidebar(disable = TRUE),
  body = body)

# Run App ----
shinyApp(ui = ui, server = server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM