farmkid
farmkid

Reputation: 420

R shiny reactive default date range

My question is concerning a dataset with highly variable date ranges. I want to allow the user to select a person/or event and then have the default appearing daterange in the dateRangeInput as the min and max of those dates. I want the initial graphs I create from these date ranges to be bounded by the minimum and maximum of the values within that row of the dataset which is easy enough. However I also need the user to have the ability to change these at will to expand on a broader range or zoom into a closer range. For the purpose of example I have created a basic code/data example showing my difficulty. I have looked for other answers, but my searches have proved unsuccessful. I have drawn from the r help files and http://shiny.rstudio.com/tutorial/lesson4/ as well as numerous other questions on this site, but all to no avail.

ui.R

shinyUI(fluidPage(
  titlePanel("Default Date Range"),

  sidebarLayout(
    sidebarPanel(
      helpText("Problem initiating a date range default based on selected input"),

  selectInput("var", 
              label = "Choose a variable to display",
              choices = c("White", "Red", "Blue"),
              selected = "White"),


  dateRangeInput('dateRange2',
                 label = paste('Date range selection'),
                 start = textOutput("text1"),
                 end = Sys.Date(), 
                 separator = " - ", 
                 weekstart = 1
  )
),

mainPanel(
  textOutput("text1"),
  textOutput("text2")
 ) #end of main panel
 )#end of SidebarLayout
))#end of fluid page and UI

And for the server.r file

server.R

my.data <- t(data.frame(White = c(as.Date("2010-01-01"), as.Date(Sys.Date())),
                  Red = c(as.Date("1943-01-01"), as.Date("1960-05-19")),
                  Blue = c(as.Date("1975-01-01"), as.Date("2010-03-09"))))


shinyServer(function(input, output){

output$text1 <- renderText({ 
  paste("You have selected", input$var)
})



output$text2 <- renderText({ 
  my.row = match(input$var, rownames(my.data))
 paste("You need the default date range",
       my.data[my.row,1], "to", my.data[my.row,2])
    })

})

Upvotes: 2

Views: 2165

Answers (1)

MLavoie
MLavoie

Reputation: 9836

what about this. Change your selectInput and you will see that the date range will accordingly to the colour.

server.R
library(shiny)

my.data <- as.data.frame(t(data.frame(White = c(as.Date("2010-01-01"), as.Date(Sys.Date())),
                        Red = c(as.Date("1943-01-01"), as.Date("1960-05-19")),
                        Blue = c(as.Date("1975-01-01"), as.Date("2010-03-09")))))

my.data$V1 <- as.Date(my.data$V1)
my.data$V2 <- as.Date(my.data$V2)

shinyServer(function(input, output){


  output$inVar2 <- renderUI({

    my.row = match(input$var, rownames(my.data))

    dateRangeInput("inVar2", 
                   label = paste('Date range selection'),
                   start = my.data[my.row,1],
                   end = my.data[my.row,2], 
                   separator = " - ", 
                   weekstart = 1

                   )

  })


  output$text1 <- renderText({ 
    paste("You have selected", input$var)
  })



  output$text2 <- renderText({ 
    my.row = match(input$var, rownames(my.data))
    paste("You need the default date range",
          my.data[my.row,1], "to", my.data[my.row,2])
  })

})

and for ui.R

ui.R
library(shiny)

shinyUI(fluidPage(
  titlePanel("Default Date Range"),

  sidebarLayout(
    sidebarPanel(
      helpText("Problem initiating a date range default based on selected input"),

      selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("White", "Red", "Blue"),
                  selected = "White"),


      uiOutput("inVar2")

    ),

    mainPanel(
      textOutput("text1"),
      textOutput("text2")
    ) #end of main panel
  )#end of SidebarLayout
))#end of fluid page and UI

Upvotes: 1

Related Questions