Search code examples
shinyplotlyrangesliderbs4dash

Connect rangeslider R Shiny to plotly plot


So a plotly plot has an embedded rangeslider however I do not like the looks of it. The rangeslider in R Shiny looks much better and professional, however how do i connect the two?

Lets say you have a dataframe with some values and a daterange like:

library(lubridate)

    df <- data.frame(
  "Date" = c(seq(ymd('2015-09-15'), ymd('2015-09-24'), by = "1 days")),
  "values" = c(3,6,5,3,5,6,7,7,4,2)
    )

Code for the plotly plot

library(plotly)

    plot_df <- plot_ly(df) 

    plot_df  <- plot_df  %>%  add_lines(type = 'scatter', mode = "lines",
                                      x = ~Date, y = ~values)

Code Shiny

library(shiny)
library(shinydashboard)

  ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(plotlyOutput("plotdf", height = 250)),
      
      box(
        title = "Controls",
        sliderInput("Date", "", min = df$Date[1], tail(df$Date, 1), value = tail(df$Date, 1)
        )
      )
    )
  )
)

server <- function(input, output) {
  output$plotdf<-renderPlotly({
    plot_df
  })
}

shinyApp(ui, server)

enter image description here


Solution

  • We can use dplyr::filter and pipe it to plot_ly().

        output$plotdf<-renderPlotly({
            filter(df, Date <= input$Date) %>% 
            plot_ly() %>%  
             add_lines(type = 'scatter', mode = "lines",
                                                x = ~Date, y = ~values)
        })
    

    Edit: Below is the plot code separated from the app with a sliderInput to select a range of dates.

    library(shiny)
    library(dplyr)
    library(lubridate)
    library(plotly)
    
    source(file = 'my_functions_script.R', local = TRUE)
    
    
    df <- data.frame(
        "Date" = c(seq(ymd('2015-09-15'), ymd('2015-09-24'), by = "1 days")),
        "values" = c(3,6,5,3,5,6,7,7,4,2)
    )
    
    
    library(shiny)
    library(shinydashboard)
    
    ui <- dashboardPage(
        dashboardHeader(title = "Basic dashboard"),
        dashboardSidebar(),
        dashboardBody(
            # Boxes need to be put in a row (or column)
            fluidRow(
                box(plotlyOutput("plotdf", height = 250)),
                
                box(
                    title = "Controls",
                    shiny::sliderInput("Date", "", min = df$Date[1], tail(df$Date, 1), value = c(df$Date[1],tail(df$Date, 1))
                    )
                )
            )
        )
    )
    
    server <- function(input, output) {
        output$plotdf<-renderPlotly({
            filter(df,Date >= input$Date[[1]], Date <= input$Date[[2]]) %>% 
                plt()
            
        })
    }
    
    shinyApp(ui, server)
    

    enter image description here