Я пытаюсь выяснить, какие следы пользователь скрывает от точечного графика, отменив их выбор в интерактивной легенде о заговоре.

Я прочитал этот qaru.site/questions/14707469/... пост, и подобные вопросы связаны в комментариях ниже, и это привело меня к решению

Текущее решение только частично делает то, что мне нужно. Две вещи, которые я ищу, чтобы улучшить это: - как увидеть, какая легенда графика нажата (глядя на источник 'id'?) - Теперь я вижу, что нажата запись легенды, но мне нужно знать, есть ли она нажата "ВКЛ" (показать трассу) или "ВЫКЛ"

Выходные данные, которые я ищу, выглядят примерно так: input$trace_plot1: который представляет собой список всех отключенных и input$trace_plot1 трассировок, или один номер трассы при каждом щелчке, но который указывает, является ли эта конкретная трассировка сейчас "ВКЛ" или "ВЫКЛ"

Для меня цель состоит в том, чтобы связать визуальное скрытие и отображение с обзором всех моих групп в данных, где пользователь теперь может дать им новые имена, цвета и выбрать сохранение или удаление группы с помощью кнопки с T/Переключатель состояния F за ним. Я хотел бы связать это состояние кнопок T/F с "показать"/"скрыть" следы от конкретного графика (так как в моем приложении есть 5 копий этих графиков, показывающих данные на разных этапах процесса анализа,

Вот моя попытка, которая никак не реагирует на легенду, только на zooom:

library(plotly)
library(shiny)
library(htmlwidgets)

js <- c(
  "function(el, x){",
  "  el.on('plotly_legendclick', function(evtData) {",
  "    Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
  "  });",
  "}")

iris$group <- c(rep(1,50), rep(2, 50), rep(3,50))

ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2"),
  verbatimTextOutput("legendItem")

)


server <- function(input, output){

  output$plot1 <- renderPlotly({
    p <- plot_ly(source = 'plotly1', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
      layout(showlegend = TRUE)

    p %>% onRender(js)

    })

  output$plot2 <- renderPlotly({
    p <- plot_ly(source = 'plotly2', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
      layout(showlegend = TRUE)

    p %>% onRender(js)

  })

  output$legendItem <- renderPrint({
    d <- input$trace
    if (is.null(d)) "Clicked item appear here" else d
  })

  }

shinyApp(ui = ui, server = server)

РЕДАКТИРОВАТЬ: РАБОЧИЙ РЕШЕНИЕ СПАСИБО ЗА БОЛЬШОЙ ОТВЕТ от SL

library(plotly)
library(shiny)
library(htmlwidgets)

js <- c(
  "function(el, x, inputName){",
  "  var id = el.getAttribute('id');",
  "  var d3 = Plotly.d3;",
  "  el.on('plotly_restyle', function(evtData) {",
  "    var out = {};",
  "    d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
  "      var trace = d3.select(this)[0][0].__data__[0].trace;",
  "      out[trace.name] = trace.visible;",
  "    });",
  "    Shiny.setInputValue(inputName, out);",
  "  });",
  "}")


ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2"),
  verbatimTextOutput("tracesPlot1"),
  verbatimTextOutput("tracesPlot2")
)

server <- function(input, output, session) {

output$plot1 <- renderPlotly({
    p1 <- plot_ly()
    p1 <-  add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
    p1 %>% onRender(js, data = "tracesPlot1")    
  })

  output$plot2 <- renderPlotly({
    p2 <- plot_ly()
    p2 <- add_trace(p2, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
    p2 %>% onRender(js, data = "tracesPlot2")  })


  output$tracesPlot1 <- renderPrint({ unlist(input$tracesPlot1)  })

  output$tracesPlot2 <- renderPrint({unlist(input$tracesPlot2)
  })

}

shinyApp(ui, server)