使用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)