observeEvent brush within a reactive event in RShiny - r

Question

I am showing tabbed graphs for each line that is selected in my initial table. I would like those graphs to have the brush/zoom functionality found here.
Here is my code :
library(shiny)
library(DT)
library(ggplot2)
library(scales)
library(reshape2)
First the ui : the main table with a tabbed UI below that is generated in response to selection of rows in the main table
ui <- fluidPage(
mainPanel(
fluidRow(
column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
),
fluidRow(
uiOutput("selectedTabs")
)
)
)
Then the server function : the main table values are generated randomly for the sake of the example. The brush functionality is directly lifted from the link provided. I suspect my issue has to do with a reactive function within a reactive function but I'm happy to let the experts decide.
server <- function(input,output){
output$tableCurrencies <- DT::renderDataTable({datatable(data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10)))})
origTable_selected <- reactive({
ids <- input$tableCurrencies_rows_selected
return(ids)
})
rangeRates <- reactiveValues(xRate = NULL, yRate = NULL)
output$selectedTabs <- renderUI({
myTabs <- lapply(origTable_selected(),function(i) {
tabName <- paste0("test",i)
a <- renderPlot({
hist(rnorm(50))
})
output[[paste0(tabName,"rates")]] <- a
#plot of realized vol and implied vols over 5 years
observeEvent(input[[paste0(tabName,"rates_dblclick")]], {
brush <- input[[paste0(tabName,"rates_brush")]]
if (!is.null(brush)) {
rangeRates$xRate <- c(brush$xmin, brush$xmax)
rangeRates$yRate <- c(brush$ymin, brush$ymax)
} else {
rangeRates$xRate <- NULL
rangeRates$yRate <- NULL
}
})
return(tabPanel(
tabName,
fluidRow(
column(6,plotOutput(paste0(tabName,"rates")))
)
))
})
return(do.call(tabsetPanel,myTabs))
})
}
app = shinyApp(ui,server)
runApp(app,port=3250,host='0.0.0.0')

Answer 1

You need to assign the "doubleclick id" and the "brush id" in the plotOutput call
column(6, plotOutput(paste0(tabName, "rates"),
dblclick = paste0(tabName, "rates_dblclick"),
brush = brushOpts(
id = paste0(tabName, "rates_brush"),
resetOnNew = TRUE
)))
Now the observers trigger properly and send the right information. There is still a second issue with rangeRates not having any effect on the plots which can be solved the following way
a <- renderPlot({
if (!is.null(rangeRates$xRate))
hist(rnorm(50), xlim = rangeRates$xRate,
ylim = rangeRates$yRate)
else
hist(rnorm(50))
})
Here is the full working version
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
fluidRow(column(12, DT::dataTableOutput(outputId = 'tableCurrencies'))),
fluidRow(uiOutput("selectedTabs"))
)
)
server <- function(input, output){
output$tableCurrencies <- DT::renderDataTable({
data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))
})
origTable_selected <- reactive({
ids <- input$tableCurrencies_rows_selected
return(ids)
})
rangeRates <- reactiveValues(xRate = NULL, yRate = NULL)
output$selectedTabs <- renderUI({
myTabs <- lapply(
origTable_selected(),
function(i) {
tabName <- paste0("test", i)
output[[paste0(tabName, "rates")]] <- renderPlot({
if( !is.null(rangeRates$xRate) )
hist(rnorm(50), xlim = rangeRates$xRate,
ylim = rangeRates$yRate)
else
hist(rnorm(50))
})
observeEvent(input[[paste0(tabName, "rates_dblclick")]], {
brush <- input[[paste0(tabName, "rates_brush")]]
if (!is.null(brush)) {
rangeRates$xRate <- c(brush$xmin, brush$xmax)
rangeRates$yRate <- c(brush$ymin, brush$ymax)
} else {
rangeRates$xRate <- NULL
rangeRates$yRate <- NULL
}
})
tabPanel(
tabName,
fluidRow(column(6, plotOutput(
paste0(tabName, "rates"),
dblclick = paste0(tabName, "rates_dblclick"),
brush = brushOpts(
id = paste0(tabName, "rates_brush"),
resetOnNew = TRUE)
)))
)
})
return(do.call(tabsetPanel, myTabs))
})
}
shinyApp(ui, server)