Reputation: 5716
I have two plotly plots in a shiny dashboard. When I click on the first plotly plot, the interactive event is working fine. But when I perform the same operation on the second plot which is a stacked barplot, the window is closing automatically.
Do you have come across the shiny dashboards with more than one plotly plots? If yes, how to handle the click events on different plotly plots?
I am preparing the reproducible usecase. Soon I will post it.
library(shinydashboard)
library(plotly)
library(shiny)
library(dplyr)
library(ggplot2)
tg <- ToothGrowth
tg$dose <- factor(tg$dose)
skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
if (skin == "")
skin <- "blue"
sidebar <- dashboardSidebar(
sidebarSearchForm(label = "Search...", "searchText", "searchButton"),
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",
fluidRow(
box(
title = "Distribution",
status = "primary",
plotlyOutput("plot1", height = "auto"),
height = 500,
width = 7
),
box(
height = 500, width = 5,
title = "Dist",
plotlyOutput("click", height = 430)
)
)
)
))
header <- dashboardHeader(
title = "My Dashboard"
)
ui <- dashboardPage(header, sidebar, body, skin = skin)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p <- ggplot(data = tg, aes(x=len, y=dose, col=supp, key=supp)) + geom_point()
ggplotly(p)
})
output$click <- renderPlotly({
d <- event_data("plotly_click")
if (is.null(d)){
"Click events appear here (double-click to clear)"
} else {
gSel <- tg %>% filter(dose %in% d$y) %>% group_by(supp) %>% mutate(newLen=floor(len)) %>%
ggplot(aes(x=supp, fill=as.factor(newLen))) + geom_bar()
ggplotly(gSel)
}
})
}
shinyApp(ui, server)
How to avoid the available error in the above image? Text printing in the plot output area.
The first plot is used for iterative click events. When I click a point on y=1
, it produces the second plot
But When I click on the stacked bar, the second plot becomes missing
(In my original scenario, the window closes and not visible. To use the app, I need to rerun the app).
How to receive the click events and check if it is from first plot or second plot?
Upvotes: 4
Views: 2415
Reputation: 615
This is an example:
library(shiny)
library(plotly)
ui <- fluidPage(
fluidRow(
column(width = 6, plotlyOutput("plot1")),
column(width = 6, plotlyOutput("plot2"))
),
fluidRow(
column(width = 6, verbatimTextOutput("selected")),
column(width = 6, verbatimTextOutput("selected2"))
)
)
server <- function(input, output, session) {
nms <- row.names(mtcars)
output$plot1 <- renderPlotly({
plot_ly(mtcars, x = ~mpg, y = ~wt, customdata = nms
,source = "plot1")%>%
layout(dragmode = "select") %>%
event_register("plotly_selecting")
})
output$plot2 <- renderPlotly({
plot_ly(mtcars, x = ~mpg, y = ~wt, customdata = nms,source = "plot2")%>%
layout(dragmode = "select") %>%
event_register("plotly_selecting")
})
output$selected <- renderPrint({
d <- event_data("plotly_selected",source = "plot1")
if (is.null(d)) "Brushed points appear here (double-click to clear)" else d
})
output$selected2 <- renderPrint({
d <- event_data("plotly_selected", source = "plot2")
if (is.null(d)) "Brushed points appear here (double-click to clear)" else d
})
}
shinyApp(ui, server, options = list(display.mode = "showcase"))
############ For your code:
library(shinydashboard)
library(plotly)
library(shiny)
library(dplyr)
library(ggplot2)
tg <- ToothGrowth
tg$dose <- factor(tg$dose)
skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
if (skin == "")
skin <- "blue"
sidebar <- dashboardSidebar(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"),
sidebarSearchForm(label = "Search...", "searchText", "searchButton"),
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",
fluidRow(
box(
title = "Distribution",
status = "primary",
plotlyOutput("plot1", height = "auto"),
height = 500,
width = 7
),
box(
height = 500, width = 5,
title = "Dist",
plotlyOutput("click", height = 430)
)
)
)
))
header <- dashboardHeader(
title = "My Dashboard"
)
ui <- dashboardPage(header, sidebar, body, skin = skin)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p <- ggplot(data = tg, aes(x=len, y=dose, col=supp, key=supp)) + geom_point()
ggplotly(p,source = "sr1")
})
output$click <- renderPlotly({
d <- event_data("plotly_click",source = "sr1")
if (is.null(d)){
"Click events appear here (double-click to clear)"
} else {
gSel <- tg %>% filter(dose %in% d$y) %>% group_by(supp) %>% mutate(newLen=floor(len)) %>%
ggplot(aes(x=supp, fill=as.factor(newLen))) + geom_bar()
ggplotly(gSel)
}
})
}
shinyApp(ui, server)
Upvotes: 0
Reputation: 2899
I use plotly_click
events too, and the way to do it is to add a source argument to the plots
p <- plot_ly(source = paste('plotlyplot', plot.list, sep = ''))
and observe click events and assign the data there
observeEvent(event_data("plotly_click", source = "plot1"), {
values$plot.click.results <- event_data("plotly_click", source = "plot1")
})
for your scenario with rendering a second plot based on click events from the first plot: If you try to render a plot when click event data is zero, and you as in your example try to plot a text message, it makes sense that R can't make a plot out of text. instead build it in a way that says: if click event data is NULL, then output is a renderText, if not NULL then renderPlotly
Upvotes: 2
Reputation: 432
Just for the error suppression problem:- Enter this in your ui part
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
)
For the graph problem. I have the same
Upvotes: 1