Interactive date range selection using dygraphs

dyselect.R

library(shiny)
library(dygraphs)

# Helper function to present Shiny controls in a dialog-like layout
dialogPage <- function(outputControl) {
  bootstrapPage(
    tags$style("
      html, body { width: 100%; height: 100%; overflow: none; }
      #dialogMainOutput { position: absolute; top: 10px; left: 10px; right: 10px; bottom: 40px; }
      #dialogControls {
      position: absolute; bottom: 0px; left: 0px; right: 0px; height: 40px;
      padding: 10px 10px 0 10px;
      background-color: #444; color: white;
}"),
    tags$div(id = "dialogMainOutput", outputControl),
    tags$div(id = "dialogControls",
      textOutput("msg", inline = TRUE),
      actionButton("done", "Done", class = "btn btn-primary btn-xs pull-right")
    )
  )
}

dyselect <- function(dygraphExpr) {
  # See below for definition of dialogPage function
  ui <- dialogPage(
    dygraphOutput("plot", width = "100%", height = "100%")
  )
  
  server <- function(input, output, session) {
    # Show the plot... that's important.
    output$plot <- renderDygraph(dygraphExpr)
    
    # Show a message giving instructions, or showing how many
    # rows are selected
    output$msg <- renderText({
      validate(need(input$plot_date_window, message = FALSE))
      paste(
        format(as.POSIXct(input$plot_date_window)),
        collapse = " to "
      )
    })
    
    # When the Done button is clicked, return the brushed
    # rows to the caller.
    observeEvent(input$done, {
      stopApp(as.POSIXct(input$plot_date_window))
    })
  }
  
  shiny::runApp(shinyApp(ui, server), launch.browser = getOption("viewer", TRUE))
}

dygraph(cbind(mdeaths, fdeaths)) %>% dyselect()