Javascript 在屏幕中使用用户输入触发鼠标单击事件

我正在写一个闪亮的应用程序，上面有一张生动的太阳爆发图。
在我提供了适当格式的数据帧之后，我必须单击sunburst图表“向下钻取”

是否可以模拟此鼠标“单击”事件来控制用户输入（如selectInput（））的“向下搜索”

如何链接selectInput（），以便它也能控制闪亮的阳光？也许是某种类型的观察事件？谢谢你的帮助

这是一个reprex：

library(shiny)
library(plotly)
library(DT)


d <- data.frame(
  ids = c(
    "North America", "Europe", "Australia", "North America - Football", "Soccer",
    "North America - Rugby", "Europe - Football", "Rugby",
    "Europe - American Football","Australia - Football", "Association",
    "Australian Rules", "Autstralia - American Football", "Australia - Rugby",
    "Rugby League", "Rugby Union"
  ),
  labels = c(
    "North<br>America", "Europe", "Australia", "Football", "Soccer", "Rugby",
    "Football", "Rugby", "American<br>Football", "Football", "Association",
    "Australian<br>Rules", "American<br>Football", "Rugby", "Rugby<br>League",
    "Rugby<br>Union"
  ),
  parents = c(
    "", "", "", "North America", "North America", "North America", "Europe",
    "Europe", "Europe","Australia", "Australia - Football", "Australia - Football",
    "Australia - Football", "Australia - Football", "Australia - Rugby",
    "Australia - Rugby"
  ),
  stringsAsFactors = FALSE
)


ui <- fluidPage(
  
  mainPanel(
    
    # would like to be able to override or mimic mouse click even with this user input
    selectInput( 
      "make_selection", label = h5("Make selection:"),
      choices = c("all" = " ", setNames(nm = d$ids)),
      selectize = TRUE,
      selected = "all"
    ),
    
    plotlyOutput("p"), 
    textOutput("mytext")
    
    
  )
)

server <- function(input, output, session) {
  
  output$p <- renderPlotly({
    
    plot_ly(d, ids = ~ids, labels = ~labels, parents = ~parents, customdata = ~ids, 
            level = input$make_selection, type = 'sunburst', 
            source = "mysource") 
    
    
    
  })
  
  hoverClick <- reactive({
    currentEventData <- unlist(event_data(event = "plotly_click", source = "mysource", priority = "event"))
  })

  output$mytext <- renderText({

    hoverClick()

  })

  observe({
    x <- input$make_selection

    # Can use character(0) to remove all choices
    if (is.null(hoverClick())){
      x <- "all"
    } else {
      x <- as.character(hoverClick()[3])
    }

    updateSelectInput(session, "make_selection",
                      selected = x
                      
                      # can I add something here so that it just updates the selector without actually
                      # triggering a selector event? (Otherwise both plotly and the selector are trying to
                      # choose the level and it is very jerky)
    )
  })
  
}


shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（绘本）
图书馆（DT）
d您可以使用
level
参数指定应该显示哪个级别。我的以下解决方案需要解决两个问题：


更改未设置动画（可能您可以找到解决方案或将其用作起点）
单击绘图时，
make\u selection
不会更新（也许您可以使用
plotly\u sunburstclick
事件进行更新

库（闪亮）
图书馆（绘本）
d感谢您的回复-请查看我的编辑；我不知道plot_ly（）中的“level”参数，这很好，但正如你所说，动画不起作用，我还没有弄明白-我能够从单击事件中获取数据并将其反馈给选择器输入-但是我想在不触发选择器事件的情况下，在绘图单击时更新选择器，有什么想法吗？还有，当我深入到一个术语时最后一个节点，通过单击plotly，我似乎再也不能后退了…感谢您的帮助您可以使用一个标志来确定
selectInput
中的更改是由于用户单击plotly而导致的更新，还是一个真正的更改。但是，我不会在plotly调用中直接使用
input$make\u selection
，因为这样更容易实现标记检查将更新添加到selectInput（）中
library(shiny)
library(plotly)


d <- data.frame(
  ids = c(
    "North America", "Europe", "Australia", "North America - Football", "Soccer",
    "North America - Rugby", "Europe - Football", "Rugby",
    "Europe - American Football","Australia - Football", "Association",
    "Australian Rules", "Autstralia - American Football", "Australia - Rugby",
    "Rugby League", "Rugby Union"
  ),
  labels = c(
    "North<br>America", "Europe", "Australia", "Football", "Soccer", "Rugby",
    "Football", "Rugby", "American<br>Football", "Football", "Association",
    "Australian<br>Rules", "American<br>Football", "Rugby", "Rugby<br>League",
    "Rugby<br>Union"
  ),
  parents = c(
    "", "", "", "North America", "North America", "North America", "Europe",
    "Europe", "Europe","Australia", "Australia - Football", "Australia - Football",
    "Australia - Football", "Australia - Football", "Australia - Rugby",
    "Australia - Rugby"
  ),
  stringsAsFactors = FALSE
)


ui <- fluidPage(
  
  mainPanel(
    
    # would like to be able to override or mimic mouse click even with this user input
    selectInput( 
      "make_selection", label = h5("Make selection:"),
      choices = c("all" = " ", setNames(nm = d$ids)),
      selectize = TRUE,
      selected = "all"
    ),
    
    plotlyOutput("p")
    
    
  )
)

server <- function(input, output, session) {
  
  output$p <- renderPlotly({
    
    plot_ly(d, ids = ~ids, labels = ~labels, parents = ~parents, 
            level = input$make_selection, type = 'sunburst') %>% 
      event_register("plotly_sunburstclick")
    
    
    
  })
  
  observeEvent(event_data("plotly_sunburstclick"), {
    # get the name of the id and update "make_selection"
  })
}

shinyApp(ui = ui, server = server)