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()