How to persist event_data across tabs in Shiny? - r

Question

I have a shiny application in which I'd like to capture which bar a user clicks on and store that value in a reactive expression to be referenced elsewhere for filtering. The problem is that the reactive expression reruns when I switch tabs and so the value doesn't sync up between the two tabs.
I have a reproducible example below.
When you load the app and click on the Goats bar, the selection at the bottom changes to 'Goats', but if you then change the tab to Bar2 the reactive expression reruns and therefore returns Giraffes again. So I end up with two separate values for the reactive expression across the different tabs. If I choose Goats on the first tab, I want it to remain when I switch to Bar2 tab and only update when I make another click.
Note that I realize I can resolve this in this example by removing the source argument from the event_data function, but in my application I have other charts which I do not want the user to be able to click on so I need to set the source to only these charts.
library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)
df_test <- data.frame(c("Giraffes","Goats"),c(1,4))
df_test <- setNames(df_test,c("species","amount"))
ui <- dashboardPage(
dashboardHeader(title = "Click Example",
titleWidth = 300),
dashboardSidebar(
width = 300,
sidebarMenu(
menuItem("Tab", tabName = "tab")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab",
fluidRow(
column(12, tabBox(
title = "",
id = "tabSet",
width = 12,
height = 500,
tabPanel("Bar1", plotlyOutput(outputId="bar_one")),
tabPanel("Bar2", plotlyOutput(outputId="bar_two"))
)
),
column(12,textOutput(outputId = "selection")))
)
)
)
)
server <- function(input, output, session) {
click_reactive = reactive({
d <- event_data("plotly_click",source=input$tabSet)
if (length(d) == 0) {species = as.vector(df_test$species[1])}
else {species = as.character(d[4])}
return(species)
})
output$bar_one <- renderPlotly({
p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar1")
})
output$bar_two <- renderPlotly({
p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar2")
})
output$selection <- renderText({
species <- click_reactive()
return(species)
})
}
shinyApp(ui, server)

Answer 1

You need to change the source to be under one name:
library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)
df_test <- data.frame(c("Giraffes","Goats"),c(1,4))
df_test <- setNames(df_test,c("species","amount"))
ui <- dashboardPage(
dashboardHeader(title = "Click Example",
titleWidth = 300),
dashboardSidebar(
width = 300,
sidebarMenu(
menuItem("Tab", tabName = "tab")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab",
fluidRow(
column(12, tabBox(
title = "",
id = "tabSet",
width = 12,
height = 500,
tabPanel("Bar1", plotlyOutput(outputId="bar_one")),
tabPanel("Bar2", plotlyOutput(outputId="bar_two"))
)
),
column(12,textOutput(outputId = "selection")))
)
)
)
)
server <- function(input, output, session) {
v <- reactiveValues()
observe({
d <- event_data("plotly_click",source="Bar1")
if (length(d) == 0) {species = as.vector(df_test$species[1])}
else {species = as.character(d[4])}
v$click <- species
})
output$bar_one <- renderPlotly({
p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar1")
})
output$bar_two <- renderPlotly({
p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar1")
})
output$selection <- renderText({
v$click
})
}
shinyApp(ui, server)