Create a gist now

Instantly share code, notes, and snippets.

@ChrisBeeley /app.R
Last active Sep 17, 2015

Single file app which takes various GET parameters and returns the appropriate date boxes (see below for link to blog post)
library(shiny)
library(lubridate)
server = function(input, output, session){
# type = date rolling n months, quarters
output$dateControls <- renderUI({
query <- parseQueryString(session$clientData$url_search)
### this is the type check for date
if(!is.null(query$type)){ # check that type exists at all
if(query$type == "date"){
if(!is.null(query$begin)){
if(!is.na(dmy(query$begin))){
begin = dmy(query$begin)
} else {
begin = Sys.Date() - 365
}
} else {
begin = Sys.Date() - 365
}
if(!is.null(query$ending)){
if(!is.na(dmy(query$ending))){
ending = dmy(query$ending)
} else {
ending = Sys.Date()
}
} else {
ending = Sys.Date()
}
return(dateRangeInput("dateRange", label = "Date range",
start = begin,
end = ending,
startview = "year"))
} # end check for type = "date"
### this is the type check for "rolling"
if(query$type == "rolling"){
if(!is.null(query$window)){
begin = floor_date(now() - months(as.numeric(query$window)), "month")
ending = floor_date(now(), "month") - 1
} else {
begin = Sys.Date() - 365
ending = Sys.Date()
}
return(dateRangeInput("dateRange", label = "Date range",
start = begin,
end = ending,
startview = "year"))
} # end check type = "rolling"
if(query$type == "quarter"){
# use Q1/ 2 and Y1/ 2 as variables
if(!is.null(query$Q1) & !is.null(query$Y1)){
# produce vector of every date ever
Q1 = as.numeric(query$Q1)%% 4 + 1
Y1 = as.numeric(query$Y1)
if(Q1 == 1){
Y1 = Y1 + 1
}
whichDate1 = quarter(seq(as.Date("2009-04-01"), Sys.Date(), by = "day"),
with_year = TRUE) == as.numeric(paste0(Y1, ".", Q1))
theDates1 = seq(as.Date("2009-04-01"), Sys.Date(), by = "day")[whichDate1]
# pick the dates you want
begin = min(theDates1)
} else {
begin = Sys.Date() - 365
}
if(!is.null(query$Q2) & !is.null(query$Y2)){
# produce vector of every date ever
Q2 = as.numeric(query$Q2)%% 4 + 1
Y2 = as.numeric(query$Y2)
if(Q2 == 1){
Y2 = Y2 + 1
}
whichDate2 = quarter(seq(as.Date("2009-04-01"), Sys.Date(), by = "day"),
with_year = TRUE) == as.numeric(paste0(Y2, ".", Q2))
theDates2 = seq(as.Date("2009-04-01"), Sys.Date(), by = "day")[whichDate2]
# pick the dates you want
ending = max(theDates2)
} else {
ending = Sys.Date()
}
return(dateRangeInput("dateRange", label = "Date range",
start = begin,
end = ending,
startview = "year"))
} # end check for quarterly report
} else { # end check does query$type exist
# if query doesn't exist just draw the interface
return(dateRangeInput("dateRange", label = "Date range",
start = Sys.Date() - 365,
end = Sys.Date(),
startview = "year"))
}
})
# fetch the GET STRING
output$queryText <- renderText({
query <- parseQueryString(session$clientData$url_search)
paste(names(query), query, sep = "=", collapse=", ")
})
}
ui = shinyUI(pageWithSidebar(
# Application title
headerPanel("Survey results- custom search"),
# first set up All/ Division results
sidebarPanel(
# date range
uiOutput("dateControls")
),
# tabbed output, stacked plot, trend plot, and responses
mainPanel(
h3(textOutput("Results")),
textOutput("queryText")
)
))
shinyApp(ui = ui, server = server)
@ChrisBeeley
Owner

There's a blog post about this code here

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment