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.
selectInput
to display a single column from the choicesselectizeInput
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.