我一直在为同样的问题挣扎，我希望这能帮助你自己和其他可能在同一条船上的人。
我不确定这是否是最漂亮的修复，但本质上，我只能通过定义一个函数来创建注解定义（列表）的递归列表，从而让relayout在注解中绘制。换句话说：包含定义每个所需Plotly注解的各个列表的列表（每个类似于Python字典）。
希望这一切都有意义！

library(shiny)
    library(shinyjs)
    library(plotly)
    
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          radioButtons(inputId = "Race", label = "Race", choices = c("Humans", "Goblins"), selected = "Humans"),
          actionButton(inputId = "Go", label = "Plot")
        ),
        mainPanel(
          plotlyOutput(outputId = "Height_Weight_plot"),
          selectizeInput(inputId = "Names", label = "Search for characters", choices = NULL, multiple = TRUE)
        )
      )
    )
    
    server <- function(input, output, session) {
      
      character_data <- eventReactive(input$Go,{
        if(input$Race == "Humans"){
          data.frame(
            Name = c("Arthur", "Rodrick", "Elaine", "Katherine", "Gunther", "Samuel", "Marcus", "Selene"),
            Role = c("Nobleman", "Soldier", "Soldier", "Priestess", "Mage", "Squire", "Merchant", "Witch"),
            Sex = c("M", "M", "F", "F", "M", "M", "M", "F"),
            Age = c(39, 41, 29, 46, 55, 17, 42, 40),
            Height = c(6.00, 5.10, 5.80, 5.20, 6.30, 5.10, 5.40, 6.20),
            Weight = c(160, 165, 154, 129, 171, 144, 131, 144)
          )
        }else if(input$Race == "Goblins"){
          data.frame(
            Name = c("Grog", "Dirk", "Kane", "Yilde", "Moldred", "Vizir", "Igret", "Baelon"),
            Role = c("Pirate", "Pirate", "Pirate", "Bandit", "Merchant", "Bandit", "Merchant", "Shaman"),
            Sex = c("M", "M", "M", "F", "F", "M", "F", "M"),
            Age = c(178, 251, 118, 490, 231, 171, 211, 621),
            Height = c(3.80, 3.50, 3.10, 4.00, 4.10, 3.70, 3.20, 4.00),
            Weight = c(100, 96, 88, 113, 92, 101, 94, 112)
          )
          
        }
      },ignoreNULL = T)
      
      observe({
        updateSelectizeInput(session, "Names", choices = character_data()$Name)
      })
      
      ##function that creates plotly dictionary object for single annotation
      listify_func <- function(x, y, text){
        return(list(
          x = x,
          y = y,
          text = as.character(text),
          xref = "x",
          yref = "y",
          showarrow = TRUE,
          arrowhead = 7,
          arrowcolor = "#ff9900",
          font = list(color = "#000000", size = 10),
          ax = runif(1, 1, 90),
          ay = -runif(1, 1, 90),
          bgcolor = "#f5f5f5",
          bordercolor = "#b3b3b3"
        ))
      }
      
      ##creating reactive object containing the subsetted data:
      highlighted <- eventReactive(input$Names,{
        character_data_sub <- character_data() %>% dplyr::filter(Name %in% input$Names)
      })
      
      ##creating a recursive list of annotation lists for selected genes 
      annotation_list <- reactiveValues(data = NULL)
      observeEvent(input$Names,{
        x <- highlighted()$Height
        y <- highlighted()$Weight
        text <- highlighted()$Name
        ##create dataframe with relative x, y and text values to create 
        ##annotations:
        df <- data.frame(x = x, y = y, text = text)
        ##create matrix of lists defining each annotation
        ma <- mapply(listify_func, df$x, df$y, df$text)
        if(length(ma) > 0){
          ##convert matrix to list of lists:
          annotation_list$data <- lapply(seq_len(ncol(ma)), function(i) ma[,i])
        }
      })
      ##if nothing is selected, clear recursive list (i.e. remove annotations):
      observe({
        if(is.null(input$Names)){
          annotation_list$data <- list()
        }
      })
      
      output$Height_Weight_plot <- renderPlotly({
        p <- plot_ly(character_data(), 
                     x = ~Height, 
                     y = ~Weight, 
                     type = "scatter",  
                     mode = "markers", 
                     hoverinfo = "text",
                     hovertext = ~paste("Name: ",Name, 
                                        "\nRole: ",Role,
                                        "\nAge: ",Age,
                                        "\nHeight: ",Height,
                                        "\nWight: ",Weight))
      })
      
      
      ##proxy updating recursive list for annotations
      observeEvent(annotation_list$data,{
            plotlyProxy("Height_Weight_plot", session) %>%
              plotlyProxyInvoke(
                "relayout",
                list(annotations = annotation_list$data)
              )
      })
      
    
    }
    
    # Run the application 
    shinyApp(ui = ui, server = server)

字符串

我试图用mtcars数据集提供一个最小的可行示例。此外，与@lucaanholt的mapply和lapply序列相比，我试图将列表列表的列表的创建简化为一个步骤。

library(shiny)
library(plotly)

ui <- fluidPage(
  mainPanel(plotlyOutput("plot1"))
)

server <- function(input, output, session) {
  mycars <- mtcars
  mycars[, "name"] <- rownames(mtcars)

  # Define plot --------------------------------------------------------------
  output$plot1 <- renderPlotly({
    ply <- plotly::plot_ly(
      data = mycars,
      x = ~hp,
      y = ~qsec,
      text = ~name,
      customdata = ~name,
      mode = "markers",
      type = "scatter",
      source = "plot1_src"
    )
  })

  # Function that creates a plotly list object for a single annotation
  get_single_anno_list <- function(x, y, text) {
    return(list(
      x = x,
      y = y,
      text = as.character(text),
      xref = "x",
      yref = "y",
      showarrow = TRUE,
      arrowhead = 2,
      arrowcolor = "#ff9900",
      font = list(color = "#000000", size = 10),
      ax = runif(1, 1, 90),
      ay = -runif(1, 1, 90)
    ))
  }

  # Set annotation -----------------------------------------------------------
  observeEvent(
    eventExpr = event_data("plotly_selected", source = "plot1_src"),
    handlerExpr = {
      selected_points <- event_data("plotly_selected", source = "plot1_src")
      tmp_selected_df <- subset(mycars, name %in% selected_points$customdata)

      # Build list of lists for all points to be annotated
      if (nrow(tmp_selected_df) == 0) {
        list_selected_anno <- list()
      } else {
        list_selected_anno <- lapply(
          seq_len(nrow(tmp_selected_df)), function(i) {
            get_single_anno_list(
              x = tmp_selected_df[i, "hp"], 
              y = tmp_selected_df[i, "qsec"], 
              text = tmp_selected_df[i, "name"]
            )
          }
        )
      }

      proxy <- plotlyProxy("plot1", session = session) %>%
        plotlyProxyInvoke(
          "relayout", list(annotations = list_selected_anno)
        )
    }
  )

  # Remove annotation -------------------------------------------------------
  # ... when in zoom mode
  observeEvent(event_data("plotly_doubleclick", source = "plot1_src"), {
    plotlyProxy("plot1", session) %>%
      plotlyProxyInvoke("relayout", list(annotations = list()))
  })
  # ... when in selection mode
  observeEvent(event_data("plotly_deselect", source = "plot1_src"), {
    plotlyProxy("plot1", session) %>%
      plotlyProxyInvoke("relayout", list(annotations = list()))
  })
}
# END SERVER ----

# RUN APP --------------------------------------------------------
shinyApp(ui, server, options = list(launch.browser = F))

字符串