r - 如何使用 plotly 中的单击获取数据点标签

Question

每当我在绘图中单击它时，我都想存储数据点标签。标签是出现在我的数据框第一列中的数据点的名称。

例如，如果我将鼠标悬停在一个数据点上，它会显示 x 和 y 信息以及数据点名称:x: 真是:27名称:芝士汉堡

我想要的是将该数据点的标签“芝士汉堡”存储为变量以备后用。

我试过使用 plotly_click 并访问 event_data 但它返回 x 和 y 值，我想要的只是数据点名称。这是我的代码:

    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. 
  })
    
  })

Answer 1

根据 OP 的评论更新，即每个点的标签使用 geom_text(label()) 放置并转换为 plotly 对象

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)