R блестящий и сюжетно получать легенды нажмите кнопку события

У меня есть R блестящая страница, и я фильтрую данные, основанные на Щелчке круговой диаграммы. Было бы здорово, если бы я мог вызвать то же самое событие фильтрации, щелкнув элементы легенды, но я не могу найти триггер события, поэтому он просто фильтрует эту диаграмму, не распространяясь на другие диаграммы. Доступно ли событие щелчка легенды?

library(data.table)
library(plotly)
library(shiny)

dt = as.data.table(mtcars)


ui <- fluidPage(
  plotlyOutput("pie1"),
  plotlyOutput("pie2")
)


server <- function(input, output){

  gearDT = reactive({
    return(dt[,.N,by=gear])
  })

  cylDT = reactive({
    return(dt[,.N,by=cyl])
  })

  output$pie1 <- renderPlotly({

    plot_ly(gearDT(), labels = ~gear, values = ~N, type = "pie") %>%
      layout(showlegend = TRUE)


  })

  output$pie2 <- renderPlotly({

    plot_ly(cylDT(), labels = ~cyl, values = ~N, type = "pie")  %>%
      layout(showlegend = TRUE)


  })
}

shinyApp(ui = ui, server = server)
3 2
shiny plotly

3 ответа:

Для будущих читателей

Плотли теперь создал событие под названием plotly_relayout. Это событие запускается при изменении макета. Щелчок по легенде - одно из таких изменений.

Одна из переменных в этом событии называется hiddenlabels. Эта переменная содержит все имена скрытых трасс легенды. 
observe({
    relayout <- event_data("plotly_relayout")
    hidden_labels <- relayout$hiddenlabels
    print(hidden_labels)
  })
1

Короткий ответ Да, но с оговорками, и это займет больше работы, чем я полностью охватываю в своем ответе.

Пакет plotly включает функцию event_data. В документации вы найдете три описанных события:

  1. plotly_hover
  2. plotly_click
  3. plotly_selected

Примеры их использования приведены в ссылке выше. Они не охватывают взаимодействие с легендой конкретно, а скорее данные в сюжете правильный.

Однако существует postMessage API, предоставляемый plotly, который shiny и другие фреймворки, такие как jupyter, используют для захвата событий. Я не просматривал документацию, чтобы осветить события, связанные с легендой. Для этого потребуется некоторый javascript, доступ к которому можно получить в R с помощью shinyjs.

Усилия могут быть больше, чем вы готовы приложить, чтобы достичь этого непосредственно. Если это не существенно для вас, чтобы пойти по этому пути, то я верю, что вы получите лучшую отдачу от вашего времени, используя блестящий input и reactive функции для фильтрации и перерисовки.

Отредактируйте с помощью обновленного примера

Ваша правка вопроса раскрывает немного больше вашей проблемы. Хотя это не воспроизводимо, manuf не является кольцевым именем для mtcars (я предполагаю, что вы присвоили это имя именам строк). Если ваша легенда является общей для всех участков, Вы можете использовать легенду, сгруппированную по подзаголовкам, как показано на рисунке документация .

Дальнейшая редакция

Круговые диаграммы ведут себя немного странно в подзаголовках, см.this иdocs . Следующий код дает вам минимальное воспроизводимое решение.

dt <- as.data.table(mtcars)

ui <- fluidPage(plotlyOutput("pie"))

server <- function(input, output){

  gearDT <- reactive({return(dt[,.N,by=gear])})  
  cylDT <- reactive({return(dt[,.N,by=cyl])})

  output$pie <- renderPlotly({

    plot_ly() %>%
      add_pie(data = gearDT(), labels = ~gear, values = ~N, name = "gear",
              domain = list(x = c(0, 0.5), y = c(0, 1))) %>%
      add_pie(data = cylDT(), labels = ~cyl, values = ~N, name = "cyl",
              domain = list(x = c(0.5, 1), y = c(0, 1))) %>%
      layout(showlegend = TRUE,
             xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
             yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

  })

}

shinyApp(ui = ui, server = server)

И скриншот, показывающий общий элемент, отфильтрованный из обеих трасс (4).

Введите описание изображения здесь

В то время как ваш первоначальный вопрос включал shiny, и я включил это в свой ответ. Диаграмма plotly независима от этого и будет отлично функционировать в качестве независимого виджета с той же функциональностью. Полезно, возможно, если вы намеревались сделать это в документе rmarkdown и в противном случае не должны зависеть от shiny.

1
library(dygraphs)
library(datasets)



ui <- shinyUI(fluidPage(

    mainPanel(
      dygraphOutput("dygraph"),dygraphOutput("dygraph1"),dygraphOutput("dygraph2")
    )
  )
)

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


  output$dygraph <- renderDygraph({
    dygraph(ldeaths, main = "All", group = "lung-deaths")
  })
  output$dygraph1 <- renderDygraph({
    dygraph(mdeaths, main = "Male", group = "lung-deaths")
  })
  output$dygraph2 <- renderDygraph({
    dygraph(fdeaths, main = "Female", group = "lung-deaths")
  })
})

shinyApp(ui = ui, server = server)
0