I am writing a shiny app with a plotly sunburst chart.
After I supply the appropriately formatted dataframe, I have to click on the sunburst chart to "drill-down."
Is is possible to mimic this mouse "click" event to control the "drill-down" from a userinput such as a selectInput()?
How do I link the selectInput() so that it will also control the shiny sunburst? Perhaps some type of observe event? Thanks for your help.
Here is a 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)
You can use the level
argument to specify which level should be shown. My solution below needs work on 2 issues:
plotly.animate
or use it as a starting point)make_selection
gets not updated when one clicks on the plot instead (maybe you can play around with the plotly_sunburstclick
event to update itlibrary(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)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.