coopermj coopermj - 1 month ago 12
R Question

Calling updateDateRangeInput within a Shiny module

I have a Shiny application with multiple

plot_ly
charts on a single page using the same date range. For complicated reasons, I would like each chart in a separate module and be reactive to
plot_ly
zooms.

The way I did this pre-module was to capture
plotly_relayout
and have it call
updateDateRangeInput
to set the entire page to that range, which then cascaded through my other
plot_ly
charts. Now that we're modularizing these charts, I'm unable to have the same behavior. I capture the redraw event, but calling
updateDateRangeInput
on the parent date range seems to have no effect.

I've tried using the namespace's session as well as passing the parent's session and calling with it.

Very simplified code:



app.R:

library(shiny)

source("mod.R", local = TRUE)

ui <- shinyUI(fluidPage(
chartTimeseriesUI("myseries")
, dateRangeInput("dateRange", "Select Date Range:"
, start = Sys.Date() - 600
, end = Sys.Date()
, min = Sys.Date() - 1200
, max = Sys.Date()
)
))

server <- shinyServer(function(input, output, session) {
callModule(chartTimeseries, id = "myseries", reactive(input$dateRange), session)
})

shinyApp(ui = ui, server = server)


mod.R:

chartTimeseriesUI <- function(id) {
ns <- NS(id)
plotlyOutput(outputId = ns("timeseries"))
}

chartTimeseries <- function(input, output, session, dateRange, psession) {
regionRedraw <- reactive({
print("I'm in redraw")
d <- event_data("plotly_relayout", source = "timeseries")
if(is.null(d)) { # double click
startdate <- Sys.Date() - 600
enddate <- Sys.Date()
} else {
xstart <- d$`xaxis.range[0]`
xend <- d$`xaxis.range[1]`

if (is.null(xstart)) {
startdate <- Sys.Date() - 600
enddate <- Sys.Date()
} else {
# Take our X time and convert it out of milliseconds
startdate <- as.POSIXlt(xstart/1000, origin="1970-01-01", tz="America/New_York")
enddate <- as.POSIXlt(xend/1000, origin="1970-01-01", tz="America/New_York")
}
}

absmindate <- Sys.Date() - 1200
absmaxdate <- Sys.Date()
updateDateRangeInput(psession, dateRange, label="Now for a new range:", start=startdate, end=enddate, min=absmindate, max=absmaxdate)
})

observe({
print("date range changed!")
d <- regionRedraw()
})

output$timeseries <- renderPlotly({
rangestart <- dateRange()[1]
rangeend <- dateRange()[2]
diff_in_days = as.numeric(difftime(rangeend, rangestart, units = "days"))
tm <- seq(0, diff_in_days, by = 10)
x <- rangeend - tm
y <- rnorm(length(x))

p <- plot_ly(x = ~x
, y = ~y
, type = "scatter"
, mode = "markers"
, text = paste(tm, "days from today")
, source = "timeseries")
})
}


Output



[1] "date range changed!"
[1] "I'm in redraw"


And then when I select a region, I get:

[1] "date range changed!"
[1] "I'm in redraw"


And the plot zooms in, the date range does not change to the new selection and the
dateRangeInput
label does not change.

I appreciate any help!

Answer

I was able to get this to work by updating the date range outside of the module: The module:

chartTimeseriesUI <- function(id) {
  ns <- NS(id)
  plotlyOutput(outputId = ns("timeseries"))
}

chartTimeseries <- function(input, output, session, dateRange) {
  regionRedraw <- reactive({
    print("I'm in redraw")
    d <- event_data("plotly_relayout", source = "timeseries") 
    if(is.null(d)) { # double click
      startdate <- Sys.Date() - 600
      enddate <- Sys.Date() 
    } else {
      xstart <- d$`xaxis.range[0]`
      xend <- d$`xaxis.range[1]`

      if (is.null(xstart)) { 
        startdate <- Sys.Date() - 600
        enddate <- Sys.Date()
      } else {
        # Take our X time and convert it out of milliseconds
        startdate <- as.POSIXlt(xstart/1000, origin="1970-01-01", tz="America/New_York")  
        enddate <- as.POSIXlt(xend/1000, origin="1970-01-01", tz="America/New_York")
      }
    }

    absmindate <- Sys.Date() - 1200
    absmaxdate <- Sys.Date()
    # reactive list instead of update
    list(dateRange=dateRange(),start=startdate, end=enddate-1, min=absmindate, max=absmaxdate)    
  })

  observe({
    print("date range changed!")
    d <- regionRedraw()
  })

  output$timeseries <- renderPlotly({
    rangestart <- dateRange()[1]
    rangeend <- dateRange()[2]
    diff_in_days = as.numeric(difftime(rangeend, rangestart, units = "days"))
    tm <- seq(0, diff_in_days, by = 10)
    x <- rangeend - tm
    y <- rnorm(length(x))

    p <- plot_ly(x = ~x
                 , y = ~y
                 , type = "scatter"
                 , mode = "markers"
                 , text = paste(tm, "days from today")
                 , source = "timeseries")
  })
  # return list to update date input later
  return(reactive(regionRedraw()))
}

Example App:

library(shiny)
library(plotly)
source("mod.R", local = TRUE)
ui <- shinyUI(fluidPage(
  chartTimeseriesUI("myseries")
  , dateRangeInput("dateRange", "Select Date Range:"
                   , start = Sys.Date() - 600
                   , end = Sys.Date()-1
                   , min = Sys.Date() - 1200
                   , max = Sys.Date()
  )
))

server <- shinyServer(function(input, output, session) {
  # receive return
  z <- callModule(chartTimeseries, id = "myseries", 
                  reactive(input$dateRange))

  observe({
    vals <- z()
    # update date
    updateDateRangeInput(session, "dateRange",start=vals$start,end=vals$end)
  })


})

shinyApp(ui = ui, server = server)
Comments