-
-
Save talonsensei/9118568 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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) | |
# | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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") | |
}) | |
}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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