Analyzing Local Data with a Shiny Web App

R-bloggers 2013-03-20

(This article was first published on PremierSoccerStats » R, and kindly contributed to R-bloggers)

A great. recent enhancement for the Shiny App is the ability to upload local files. Now, in addition to users being able to interact with data provided on the host e.g. Soccer Tables or via the web, Wikipedia Search Rates they can use apps to view and analyse their own data

I have knocked up an app based on the 09_upload example provided in the Shiny package. It uploads a small .csv spreadsheet file of school pupil’s scores from a local directory, displays the data and does a couple of analyses.

The ui.R  enables a user to upload a csv file with various parameters, seperator etc.  The example file is downloadable. There are then three tabs showing

  1. The raw data in a gVis Table, which allows sorting and paging
  2. A density graph with the spread of results by term and year
  3. A statistical test to see if there is a difference in marks by gender
?View Code RSPLUS
#ui.R
shinyUI(pageWithSidebar(
  headerPanel("Uploaded File Analysis"),
 
  sidebarPanel(
    helpText("This app is shows how a user can update a csv file from their own hard drive for instant analysis.
In the default case, it uses standard format school marks that could be used by many teachers
Any file can be uploaded but analysis is only available
if the data is in same format as the sample file, downloadable below
"),
    a("Pupil Marks", href="http://dl.dropbox.com/u/25945599/scores.csv"),
    tags$hr(),
    fileInput('file1', 'Choose CSV File from local drive, adjusting parameters if necessary',
              accept=c('text/csv', 'text/comma-separated-values,text/plain')),
 
    checkboxInput('header', 'Header', TRUE),
    radioButtons('sep', 'Separator',
                 c(Comma=',',
                   Semicolon=';',
                   Tab='\t'),
                 'Comma'),
    radioButtons('quote', 'Quote',
                 c(None='',
                   'Double Quote'='"',
                   'Single Quote'="'"),
                 'Double Quote'),
    tags$head(tags$style(type="text/css",
                         "label.radio { display: inline-block; margin:0 10 0 0;  }",
                         ".radio input[type=\"radio\"] { float: none; }"))
 
  ),
  mainPanel(
    tabsetPanel(
      tabPanel("Pupil Marks",
               h4(textOutput("caption1")),
               checkboxInput(inputId = "pageable", label = "Pageable"),
               conditionalPanel("input.pageable==true",
                                numericInput(inputId = "pagesize",
                                             label = "Pupils per page",value=13,min=1,max=25)),
 
               htmlOutput("raw"),
                value = 1),
      tabPanel("Term Details",
               h4(textOutput("caption2")),
               plotOutput("density"),
               htmlOutput("notes2"),
               value = 2),
      tabPanel("Gender difference",
               h4(textOutput("caption3")),
               plotOutput("genderDensity", height="250px"),
               verbatimTextOutput("sexDiff"),
               htmlOutput("notes3"),
               value = 3),
      id="tabs1")
 
)
))

The server.R takes the file, does some processing and provides a list of data which can be rendered into plots and tables

?View Code RSPLUS
# server.R
shinyServer(function(input, output) {
 
  Data <- reactive({
 
 
          # input$file1 will be NULL initially. After the user selects and uploads a 
          # file, it will be a data frame with 'name', 'size', 'type', and 'datapath' 
          # columns. The 'datapath' column will contain the local filenames where the 
          # data can be found.
 
          inFile <- input$file1
 
          if (is.null(inFile))
            return(NULL)
 
         df.raw <- read.csv(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
        # calculate term and pupil averages
          t1Av <- colMeans(df.raw[3:5])[1]
          t2Av <- colMeans(df.raw[3:5])[2]
          t3Av <- colMeans(df.raw[3:5])[3]
          df.raw$Av <- round(rowMeans(df.raw[3:5]),1)
 
          # reshape th data.frame for further analysis
          df.melt <- melt(df.raw, id.vars=c("Name","Gender"))
          colnames(df.melt) <- c("Name","Gender","Term","Mark")
 
          # get average boy and girl marks
          girls <-round(tapply(X = df.melt$Mark, INDEX = list(df.melt$Gender), FUN = mean)["F"],1)
          boys <-round(tapply(X = df.melt$Mark, INDEX = list(df.melt$Gender), FUN = mean)["M"],1)
 
          # create a list of data for use in rendering
          info <- list(df.raw=df.raw,df.melt=df.melt,t1Av=t1Av,t2Av=t2Av,t3Av=t3Av,girls=girls,boys=boys)
          return(info)
  })
 
 
 
  # allows pageability and number of rows setting
  myOptions <- reactive({  
    list(
      page=ifelse(input$pageable==TRUE,'enable','disable'),
      pageSize=input$pagesize
    ) 
   } )
 
  output$raw <- renderGvis({
   if (is.null(input$file1)) { return() }
 
     gvisTable(Data()$df.raw,options=myOptions())         
   })
 
  output$density <- renderPlot({
    if (is.null(input$file1)) { return() }
  print(ggplot(Data()$df.melt, aes(x=Mark, fill=Term)) + geom_density(alpha=.3))
 
  })
 
  output$genderDensity <- renderPlot({
    if (is.null(input$file1)) { return() }
    df.gender<- subset(Data()$df.melt,Term!="Av")
    str(df.gender)
    print(ggplot(df.gender, aes(x=Mark, fill=Gender)) + geom_density(alpha=.3))
 
 
  })
 
  output$sexDiff <- renderPrint({
    if (is.null(input$file1)) { return() }
    df.gender<- subset(Data()$df.melt,Term!="Av")
    aov.by.gender <- aov(Mark ~ Gender, data=df.gender)
    summary(aov.by.gender) 
  })
 
  output$caption1 <- renderText( {
    if (is.null(input$file1)) { return() }
 
    "Ms Twizzle's Class - Science Results"
  })
 
  output$caption2 <- renderText( {
    if (is.null(input$file1)) { return() }
    paste0("Average Mark  Term 1:",Data()$t1Av," Term 2:",Data()$t2Av," Term 3:",Data()$t3Av)
  })
 
 
  output$caption3 <- renderText( {
    if (is.null(input$file1)) { return() }
    paste0("Analysis of Variance by Gender - Boys Average Mark:",Data()$boys, "  Girls Average Mark:",Data()$girls)
  })
 
  output$notes2 <- renderUI( {
    if (is.null(input$file1)) { return() }
    HTML("The above graph shows the variation in pupils' marks by term. The annual spread
         will normally be greater as the example data is random and normally some pupils will
         tend to be better than others over each term")
 
  })
 
  output$notes3 <- renderUI( {
    if (is.null(input$file1)) { return() }
    HTML("The Analysis of Variance indicates whether there is a statistically significant
         difference between boys and girls in the class. With this 'fixed' data, there is a
         significant difference at the 5% level")
 
  })
 
  })

Finally, global.R loads the requisite libraries and houses the script which generated the sample file

?View Code RSPLUS
#global.R
# load required libraries
library(shiny)
library(plyr)
library(ggplot2)
library(googleVis)
library(reshape2)
 
####creation of example data on local directory for uploading####
 
# #load a list of common first names
# faveNames

The app is viewable on glimmer and the code as a gist

To leave a comment for the author, please follow the link and comment on his blog: PremierSoccerStats » R.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series,ecdf, trading) and more...