R Shiny code -- Reactive slider for ggplot histogram - r

Question

I am trying to program a shiny dashboard with a histogram that allows you to subset the input data according to dates.
I have the date input bar functioning, but it only provides data for a single point in time, not a range. Can someone point out where I went wrong in the code?
I will provide my server.r and ui.r code, as well as reproducible data.
SERVER.R
library(reshape)
library(shiny)
library(ggplot2)
# GEN DATA -----------------------------------------------
dates = c("2014-01-01", "2014-02-01", "2014-03-01", "2014-04-01", "2014-01- 01", "2014-02-01", "2014-03-01", "2014-04-01", "2014-01-01", "2014-02-01")
value = c ("3.2", "4.1", "3.8", "5.6", "2.1", "2.0", "1.0" , "4.5", "1.6", "2.9")
dataset = cbind(dates, value)
dataframe = data.frame(dataset)
dataframe$dates <- as.Date(dataframe$dates, format = "20%y-%m-%d")
dataframe$value <- as.numeric(dataframe$value)
# SERVER -----------------------------------------------
shinyServer(function (input, output) {
# DATA
data.r = reactive({
a = subset(dataframe, dates %in% input$daterange)
return(a)
})
# GGPLOT
mycolorgenerator = colorRampPalette(c('sienna','light grey'))
output$myplot = renderPlot({
dd<-data.r()
# ggplot with proper reference to reactive function <<data.r()>>
s = ggplot(data=subset(dataframe, dates %in% input$daterange ), aes (x=value)) + geom_histogram(data=subset(dd, dates%in% input$daterange ) , aes(x=value))
print(s)
})
})
ui.R
# INPUT PART
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("My App"),
sidebarPanel(
dateRangeInput("daterange", "Date range:",
start = "2014-01-01",
end = "2014-03-31",
min = "2014-01-01",
max = "2014-03-31",
format = "yyyy/mm/dd",
separator = "-"),
submitButton(text="Update!")
),
# -----------------------------------------------
# OUTPUT PART
mainPanel(
tabsetPanel(
tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
)
)
))

Answer 1

You are doing string matching here not date interval checking. For what you have to work the daterange would need to contain the exact same values as your data and return more than two dates which that UI control isn't setup to do.
I think something like this might work for you.
# inside interval
start <- ymd("2014-01-01")
end <- ymd("2014-02-01")
my.interval <- interval(start, end)
ymd("2014-01-05") %within% my.interval
[1] TRUE
# outside interval
start <- ymd("2014-01-01")
end <- ymd("2014-02-01")
my.interval <- interval(start, end)
ymd("2014-03-21") %within% my.interval
[1] FALSE
You don't have to use lubridate you can manage this with the base Date packages but it would require some work.
Another work around would be to use a different control with all the date hardcoded and enable a multiselect on the input. Such as selectizeInput(...).

Answer 2

Modify your code like the following, your subsetting was not correct:
server <- shinyServer(function (input, output) {
# DATA
data.r = reactive({
a = subset(dataframe, dates >= input$daterange[1] &
dates <= input$daterange[2]) # add some validation code here
# to validate that input$daterange[2] >= input$daterange[1]
return(a)
})
# GGPLOT
mycolorgenerator = colorRampPalette(c('sienna','light grey'))
output$myplot = renderPlot({
dd<-data.r()
# ggplot with proper reference to reactive function <<data.r()>>
print(ggplot(dd, aes(x=value)) + geom_histogram())
})
})
# INPUT PART
library(shiny)
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("My App"),
sidebarPanel(
dateRangeInput("daterange", "Date range:",
start = "2014-01-01",
end = "2014-03-31",
min = "2014-01-01",
max = "2014-03-31",
format = "yyyy/mm/dd",
separator = "-"),
submitButton(text="Update!")
),
# OUTPUT PART
mainPanel(
tabsetPanel(
tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
)
)
))
shinyApp(ui = ui, server = server)