Upload Example in Shiny App. Takes Pupil's term marks and does some analyses
| # 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<- read.csv("http://dl.dropbox.com/u/25945599/faveNames.csv",stringsAsFactors=FALSE) | |
| # | |
| # set.seed(4359) # change if want new set | |
| # # create a distribution of results | |
| # # marks improve and reduce in variance over school year | |
| # term1 <- floor(rnorm(25,mean=60,sd=10)) | |
| # term2 <- floor(rnorm(25,mean=65,sd=9)) | |
| # term3 <- floor(rnorm(25,mean=70,sd=8)) | |
| # # sample 25 names and combine with marks | |
| # pupils <- faveNames[sample(nrow(faveNames), size=25, replace=FALSE), ] | |
| # pupils <- arrange(pupils,Gender,Name) | |
| # | |
| # scores <- cbind(pupils,term1) | |
| # scores <- cbind(scores,term2) | |
| # scores <- cbind(scores,term3) | |
| # | |
| # # deleberately increase girls marks by 2 and reduce boys by 2 | |
| # scores[scores$Gender=="F",]$term1 <- scores[scores$Gender=="F",]$term1+2 | |
| # scores[scores$Gender=="F",]$term2 <- scores[scores$Gender=="F",]$term2+2 | |
| # scores[scores$Gender=="F",]$term3 <- scores[scores$Gender=="F",]$term3+2 | |
| # | |
| # scores[scores$Gender=="M",]$term1 <- scores[scores$Gender=="M",]$term1-2 | |
| # scores[scores$Gender=="M",]$term2 <- scores[scores$Gender=="M",]$term2-2 | |
| # scores[scores$Gender=="M",]$term3 <- scores[scores$Gender=="M",]$term3-2 | |
| # | |
| # | |
| # | |
| # write.csv(scores,"yourfilelocation/scores.csv", row.names=FALSE) | |
| # | |
| 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") | |
| }) | |
| }) |
| 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") | |
| ) | |
| )) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment