Create a gist now

Instantly share code, notes, and snippets.

@ikkyle /server.R
Last active Aug 29, 2015

What would you like to do?
merge-and-download-xls
#########################
### Download Data App ###
#########################
library(shiny)
library(WriteXLS)
measures <- c('Measure 1'='m1',
'Measure 2'='m2',
'Measure 3'='m3')
dem <- read.csv('tbl_dem.csv')
################
### Function ###
################
shinyServer(function(input, output){
output$select_measures <- renderUI({
checkboxGroupInput('measure', "select desired measures",
measures)})
##################
### Merge data ###
##################
dataset <- reactive({
if(length(input$measure)>0){
data <- read.csv(paste0('tbl_',
input$measure[1], '.csv'),
stringsAsFactors=FALSE)
}
if(length(input$measure) > 1){
for(i in 2:((length(input$measure)))){
data <- merge(data,
read.csv(paste('tbl_',
input$measure[i], '.csv', sep=''),
stringsAsFactors=FALSE),
by=c('id', 'time'), all=TRUE)}}
data <- merge(data, dem, by='id', all.x=TRUE)
return(data)})
#######################################
### create dataset (or not, bypass) ###
#######################################
subsetted_data <- reactive({
if(is.null(input$measure)){
return(NULL)}
dat <- dataset()
return(dat)})
datf <- reactive({
if(is.null(input$measure)){
return(NULL)
}
dat <- subsetted_data()
dat <- dat[order(dat$time),]
datf <- reshape(dat,
timevar='time',
idvar=c('id', 'gender', 'risk'),
direction='wide')
return(datf)
})
####################
### Dataset info ###
####################
# number of observations and variables
output$text1 <- renderPrint({
if(is.null(input$measure))
return('No data')
nrows <- nrow(subsetted_data())
ncols <- ncol(subsetted_data())
nroww <- nrow(datf())
ncolw <- ncol(datf())
cat(paste0(nrows, ' observations in long dataset'),
paste0('\n',ncols,' variables in long dataset'),
paste0('\n\n',nroww ,' observations in wide dataset'),
paste0('\n', ncolw, ' variables in wide dataset'))
})
# frequency of visits
output$text2 <- renderTable({
if(is.null(input$measure))
return(NULL)
table("time frequencies" = subsetted_data()[,'time'])
})
# gender frequency
output$text3 <- renderTable({
if(is.null(input$measure))
return(NULL)
table("gender frequencies" = subsetted_data()[,'gender'])
})
# frequency of risk groups
output$text4 <- renderTable({
if(is.null(input$measure))
return(NULL)
else{
return(table("risk group frequencies" = as.character(subsetted_data()[,'risk'])))
}
})
###########################
### show the data table ###
###########################
output$table <- renderDataTable({subsetted_data()},
options = list(aLengthMenu = c(10, 25, 50),
iDisplayLength = 25,
bSortClasses = TRUE,
bStateSave = FALSE,
bProcessing=TRUE,
`$.fn.dataTableExt.sErrMode`='throw',
bRegex=FALSE))
output$widetable <- renderDataTable({
if(is.null(input$measure)){
return(NULL)
}
datf()},
options = list(aLengthMenu = c(10, 25, 50),
iDisplayLength = 25,
bSortClasses = TRUE,
bStateSave = FALSE,
bProcessing=TRUE,
`$.fn.dataTableExt.sErrMode`='throw',
bRegex=FALSE))
#################################################
### lists measures used for title & help text ###
#################################################
output$title <- renderUI({
if(is.null(input$measure))
return(NULL)
h4(paste(input$measure, collapse=', '))
})
# Indicates "no data selected"
output$info_title <- renderUI({
if(!is.null(input$measure))
return(NULL)
h4('No data selected')
})
output$info_summary <- renderUI({
if(!is.null(input$measure))
return(NULL)
h5('Once data are selected, you can search through the data, sort by variables in ascending
and descending order, and limit the number of rows visible. Select all the measures you
want in your dataset and click "Download dataset" to download a .csv file of that data.
Clicking "Download codebook" will download a codebook with variable definitions for the
variables in your dataset. The "Dataset info" tab shows basic dataset descriptives.')
})
########################
### Download buttons ###
########################
output$debug <- renderPrint({
file <- paste0("longdataset_", Sys.time(), input$format)
return(file)
})
# download long data
output$download_data <- downloadHandler(
filename = function(){paste0("longdataset_", Sys.time(), input$format)},
content = function(file){
if(input$format=='.csv'){
write.csv(subsetted_data(), file, row.names=FALSE,
na='')}
if(input$format=='.xls'){
sdat <- subsetted_data()
WriteXLS('sdat',
file)
}
}
)
# download wide data
output$download_wide <- downloadHandler(
filename=function(){paste0("widedataset_", Sys.time(), input$format)},
content=function(file){
if(input$format=='.csv'){
write.csv(datf(), file, row.names=FALSE, na='')}
if(input$format=='.xls'){
fdat <- datf()
WriteXLS('fdat',
file)
}
})
})
#########################
### Download Data App ###
#########################
library(shiny)
shinyUI(pageWithSidebar(
headerPanel('Generate Dataset Shiny App'),
sidebarPanel(
tabsetPanel(
tabPanel("select measures",
uiOutput('select_measures'),
uiOutput('select_multiplex')),
tabPanel("dataset info",
verbatimTextOutput("text1"),
br(),
tableOutput('text2'),
br(),
tableOutput('text3'),
br(),
tableOutput('text4'))),
br(),
conditionalPanel(
condition = '(input.measure != null)',
radioButtons('format', 'File type:',
choices=c('.xls',
'.csv'),
selected='.xls'),
downloadButton('download_data', 'Download long dataset'),
downloadButton('download_wide', 'Download wide dataset'))),
mainPanel(
# verbatimTextOutput('debug'),
uiOutput('info_title'),
uiOutput('info_summary'),
uiOutput('title'),
tabsetPanel(
tabPanel('Long dataset',
dataTableOutput('table')),
tabPanel('Wide dataset',
dataTableOutput('widetable'))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment