Reputation: 423
I would like to store the data point label whenever I click it in my plotly plot. The label is the name of the data point that appears in the first column of my data frame.
For example if I hover over a data point it will show me the x and y information as well as the data point name: x: TRUE y: 27 Name: cheeseburger
What I want is to store the label of that data point, 'cheeseburger' as a variable to use later.
I have tried using plotly_click and accessing the event_data but it returns x and y values and all I want is the data point name. This is my code:
library(shiny)
library(plotly)
ui <- navbarPage(fluid = TRUE, id = "navbarID",
theme = shinytheme("superhero"),
tabsetPanel(type = "tabs",
tabPanel("File Upload",
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
mainPanel(
# Output: Data file ----
tableOutput("contents")
),
)
),
tabPanel("firstbox",
uiOutput("box"),
),
tabPanel("facet_plots",
mainPanel(plotlyOutput("ind_plot"))
) # Main panel for displaying outputs ----
))
# server ----
# Define server logic to plot various variables against
server <- function(input, output, session) {
my_data <- reactive({
inFile <- input$file1
req(inFile)
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
tryCatch(
{
df_x <<- read.csv(inFile$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
}
)
if(input$disp == "head") {
return(head(df_x))
}
else {
return(df_x)
}
})
#server logic for file upload tab
output$contents <- renderTable({
my_data()
})
#server logic for boxplot tab
output$box <- renderUI({
tabPanel("first_box",
sidebarPanel(
selectInput("variable", "Name:", unique(qc$Action)),
sliderInput("quantile", "Quantile Range:",
min = 75, max = 95, value = c(85), step = 5),
br(),
br(),
mainPanel(
h2("title", align = "center"),
plotlyOutput("plot", height = '1000px', width = "100%")
)
)
})
observeEvent(input$file1, {
req(df_x)
source("db_prep.R")
fn <- reactive(get(paste0("s_", input$quantile)))
output$plot <- renderPlotly(fn()(input$variable))
}) # ^^^ note the reactive value goes fn()(var)
s_75 <- function(var) box_75(var)
s_80 <- function(var) box_80(var)
s_85 <- function(var) box_85(var)
s_90 <- function(var) box_90(var)
s_95 <- function(var) box_95(var)
m_p <- function(var) com_g(var)
#Below is that part I am running into trouble
#create reactive for subset plot on second tab
observeEvent(input$variable, {
s <- reactive({
event_data("plotly_click", source = 'sub_plot')
})
observeEvent(s(), {
updateTabsetPanel(session, inputId = "navbarID", selected = "facet_plots")
})
output$ind_plot <- renderPlotly({
req(s())
m_p(s()) # <-- problem here. I need to feed data point label as a string into this function to transform and render new sub plot.
})
})
Upvotes: 3
Views: 1935
Reputation: 24722
Updated based on OP's comment that the label for each point is placed using geom_text(label())
and converted to plotly object
library(shiny)
library(plotly)
library(data.table)
data = data.table(x=1:10, y=sample(1:100, 10))
food_labels = sample(c("cheeseburger", "hamburger", "salad", "fries"), 10, replace=T)
get_plotly <- function() {
ggplotly(ggplot(data,aes(x,y)) + geom_point() + geom_text(label=food_labels))
}
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput(outputId = "clicked_point")
)
server <- function(input, output, session) {
plt <- reactive(get_plotly())
output$plot <- renderPlotly(plt())
s <- reactive(event_data("plotly_click"))
label_name <- eventReactive(s(), {
data.table(
x = plt()$x$data[[2]]$x,
y = plt()$x$data[[2]]$y,
text = plt()$x$data[[2]]$text
)[x==s()$x & y==s()$y, text]
})
output$clicked_point = renderPrint(label_name())
}
shinyApp(ui, server)
Upvotes: 2