library(shiny)
library(psych)
library(beeswarm)
library(DescTools)
shinyServer(function(input, output) {
options(warn=-1)
bs <- reactive({
x <- input$textarea.in
x <- as.numeric(unlist(strsplit(x, "[\n, \t]")))
result <- describe(x)[2:13]
row.names(result) <- ""
ndigits <- input$numdigits # decimal points
ci <- round(MeanCI(x, conf.level=0.95), ndigits)
print(result, digits=ndigits) # rounding to the specified number of digits
cat("\n", "[95% confidence intervals of the mean]", "\n")
return(ci)
})
makedistPlot <- function(){
x <- input$textarea.in
x <- as.numeric(unlist(strsplit(x, "[\n, \t]")))
x <- x[!is.na(x)]
simple.bincount <- function(x, breaks) {
nx <- length(x)
nbreaks <- length(breaks)
counts <- integer(nbreaks - 1)
for (i in 1:nx) {
lo <- 1
hi <- nbreaks
if (breaks[lo] <= x[i] && x[i] <= breaks[hi]) {
while (hi - lo >= 2) {
new <- (hi + lo) %/% 2
if(x[i] > breaks[new])
lo <- new
else
hi <- new
}
counts[lo] <- counts[lo] + 1
}
}
return(counts)
}
nclass <- nclass.FD(x)
breaks <- pretty(x, nclass)
counts <- simple.bincount(x, breaks)
counts.max <- max(counts)
h <- hist(x, las=1, breaks="FD", xlab= "Red vertical line shows the mean.",
ylim=c(0, counts.max*1.2), main="", col = "cyan")
rug(x)
abline(v = mean(x, na.rm=T), col = "red", lwd = 2)
xfit <- seq(min(x, na.rm=T), max(x, na.rm=T))
yfit <- dnorm(xfit, mean = mean(x, na.rm=T), sd = sd(x, na.rm=T))
yfit <- yfit * diff(h$mids[1:2]) * length(x)
lines(xfit, yfit, col = "blue", lwd = 2)
}
output$distPlot <- renderPlot({
print(makedistPlot())
})
makeboxPlot <- function(){
x <- input$textarea.in
x <- as.numeric(unlist(strsplit(x, "[\n, \t]")))
boxplot(x, horizontal=TRUE, xlab= "Mean and +/-1 SD are displayed in red.")
points(mean(x, na.rm=T), 0.9, pch = 18, col = "red", cex = 2)
arrows(mean(x, na.rm=T), 0.9, mean(x, na.rm=T) + sd(x, na.rm=T), length = 0.1, angle = 45, col = "red")
arrows(mean(x, na.rm=T), 0.9, mean(x, na.rm=T) - sd(x, na.rm=T), length = 0.1, angle = 45, col = "red")
if (input$beeswarm == F) {
NULL
} else {
beeswarm(x, horizontal=TRUE, col = 4, pch = 16, add = TRUE)
}
}
output$boxPlot <- renderPlot({
print(makeboxPlot())
})
testnorm <- reactive({
x <- input$textarea.in
x <- as.numeric(unlist(strsplit(x, "[\n, \t]")))
list(ks.test(scale(x), "pnorm"), shapiro.test(x))
})
makeqqPlot <- function(){
x <- input$textarea.in
x <- as.numeric(unlist(strsplit(x, "[\n, \t]")))
qqnorm(x, las=1)
qqline(x, col=2)
}
output$qqPlot <- renderPlot({
print(makeqqPlot())
})
info <- reactive({
info1 <- paste("This analysis was conducted with ", strsplit(R.version$version.string, " \\(")[[1]][1], ".", sep = "")
info2 <- paste("It was executed on ", date(), ".", sep = "")
cat(sprintf(info1), "\n")
cat(sprintf(info2), "\n")
})
output$info.out <- renderPrint({
info()
})
output$textarea.out <- renderPrint({
bs()
})
output$testnorm.out <- renderPrint({
testnorm()
})
})
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Basic Statistics Calculator"),
sidebarPanel(
p("Data input:"),
tags$textarea(id="textarea.in", rows=30, cols=10, "44\n32\n37\n44\n40\n44\n45\n36\n37\n42\n38\n47\n26\n41\n27\n39\n47\n41\n36\n44\n39\n49\n40\n25\n33\n39\n36\n45\n32\n51\n47\n39\n43\n38\n42\n35\n29\n33\n40\n37\n38\n34\n36\n43\n38\n39\n26\n30\n41\n35\n30\n39\n46\n39\n43\n46\n33\n48\n44\n45\n42\n45\n46\n53\n47\n47\n51\n33\n40\n43\n48\n37\n31\n40\n40\n49\n43\n49\n46\n38\n40\n51\n40\n44\n45\n53\n46\n42\n44\n46\n29\n38"),
p('Input values can be separated by', br(),
'newlines, spaces, commas, or tabs.')
),
mainPanel(
tabsetPanel(
tabPanel("Main",
h3("Basic statistics"),
numericInput("numdigits", "Number of decimal points:", 3),
verbatimTextOutput("textarea.out"),
br(),
h3("Histogram"),
plotOutput("distPlot"),
h3("Box plot"),
checkboxInput("beeswarm", label = strong("Plot individual data points."), value = T),
plotOutput("boxPlot"),
h3("Test of normality"),
verbatimTextOutput("testnorm.out"),
br(),
h3("Q-Q plot"),
plotOutput("qqPlot", width="70%"),
br(),
br(),
strong('R session info'),
verbatimTextOutput("info.out")
),
tabPanel("About",
strong('Note'),
p('This web application is developed with',
a("Shiny.", href="http://shiny.rstudio.com/", target="_blank"),
''),
br(),
strong('List of Packages Used'), br(),
code('library(shiny)'),br(),
code('library(psych)'),br(),
code('library(beeswarm)'),br(),
code('library(DescTools)'),br(),
br(),
strong('Code'),
p('Source code for this application is based on',
a('"The handbook of Research in Foreign Language Learning and Teaching" (Takeuchi & Mizumoto, 2012).', href='http://mizumot.com/handbook/', target="_blank")),
p('The code for this web application is available at',
a('GitHub.', href='https://github.com/mizumot/bs', target="_blank")),
p('If you want to run this code on your computer (in a local R session), run the code below:',
br(),
code('library(shiny)'),br(),
code('runGitHub("bs","mizumot")')
),
br(),
strong('Citation in Publications'),
p('Mizumoto, A. (2015). Langtest (Version 1.0) [Web application]. Retrieved from http://langtest.jp'),
br(),
strong('Article'),
p('Mizumoto, A., & Plonsky, L. (2015).', a("R as a lingua franca: Advantages of using R for quantitative research in applied linguistics.", href='http://applij.oxfordjournals.org/content/early/2015/06/24/applin.amv025.abstract', target="_blank"), em('Applied Linguistics,'), 'Advance online publication. doi:10.1093/applin/amv025'),
br(),
strong('Recommended'),
p('To learn more about R, I suggest this excellent and free e-book (pdf),',
a("A Guide to Doing Statistics in Second Language Research Using R,", href="http://cw.routledge.com/textbooks/9780805861853/guide-to-R.asp", target="_blank"),
'written by Dr. Jenifer Larson-Hall.'),
p('Also, if you are a cool Mac user and want to use R with GUI,',
a("MacR", href="http://www.urano-ken.com/blog/2013/02/25/installing-and-using-macr/", target="_blank"),
'is defenitely the way to go!'),
br(),
strong('Author'),
p(a("Atsushi MIZUMOTO,", href="http://mizumot.com", target="_blank"),' Ph.D.',br(),
'Professor of Applied Linguistics',br(),
'Faculty of Foreign Language Studies /',br(),
'Graduate School of Foreign Language Education and Research,',br(),
'Kansai University, Osaka, Japan'),
br(),
a(img(src="http://i.creativecommons.org/p/mark/1.0/80x15.png"), target="_blank", href="http://creativecommons.org/publicdomain/mark/1.0/")
)
)
)
))