I am currently developing a shiny app that includes a plotly sunburst chart.
Once I provide the correctly formatted dataframe, I need to interact with the sunburst chart by clicking on it to "drill-down."
Is there a way to replicate this mouse click action in order to control the drill-down functionality based on user input such as selectInput()?
How can I establish a connection between the selectInput() element and the shiny sunburst so that changes in the selectInput also impact the display of the sunburst? Maybe through the usage of an observer event? Thank you for your assistance.
Below is an example illustrating my issue:
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(
# an option to simulate or mirror the mouse click event using 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
# Using character(0) will clear all choices
if (is.null(hoverClick())){
x <- "all"
} else {
x <- as.character(hoverClick()[3])
}
updateSelectInput(session, "make_selection",
selected = x
# Is it possible to add something here just to update the selector without triggering a selector event?
# (Otherwise both plotly and the selector are trying to choose the level and it results in a jerky behavior)
)
})
}
shinyApp(ui = ui, server = server)