使用 selectizeInput 和 plotly::ggplotly 在 R Shiny 中具有交互式悬停文本

Question

我正在开发一个闪亮的应用程序，它“理论上”将允许用户以交互方式选择使用plotly::ggplotly 制作的图表中显示的值的悬停文本。到目前为止，我的方法是将列名从我的 selectizeInput 传递到 aes(text = paste0(...)) 以尝试提取列名和对应于图中 (x,y) 点的观察值。

如果我明确调用aes(text = paste0(...)) 中的列，它会很好用。但是，当我尝试使用 selectizeInput 时，我只成功提取了列名，而不是相应的观察结果。

在下面的示例中，我在悬停文本中包含了包含所需输出的有效内容。我还尝试了使用交互式输入复制所需输出的最佳尝试。

据我所知，我认为我的问题是我没有正确地告诉 R 将列名同时用作字符串和列。任何帮助或建议将不胜感激！

# 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)

Answer 1

问题在于input$hovertext 只是一个包含列名的字符串。此外，ifelse 不是检查NULL 的正确方法。要使悬停文本以用户输入为条件，您可以使用 if 语句代替将带有悬停文本的列添加到您的 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)  
  })

Answer 2

感谢我得到的帮助，我已经成功地启动并运行了它。我修改了原始代码以包含 3 个不同的选项来显示悬停文本。

1. 将变量硬编码到悬停文本中。
2. 使用selectInput 显示选项中的单列
3. 使用selectizeInput 显示选项中任意数量/组合的列。

# 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)