merge-and-download-xls

server.R

#########################
### 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)
      }
    })
  
  })

ui.R

#########################
### 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'))))))