library(shiny)
library(shinyAce)
library(psych)
library(beeswarm)
shinyServer(function(input, output) {
options(warn=-1)
bs <- reactive({
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
total <- rowSums(x, na.rm=T)
result1 <- describe(total)[2:13]
y <- rowMeans(x, na.rm=T)
result2 <- describe(y)[2:13]
row.names(result1) <- "Total "
row.names(result2) <- "Average "
return(list(result2, result1))
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
total <- rowSums(x, na.rm=T)
result1 <- describe(total)[2:13]
y <- rowMeans(x, na.rm=T)
result2 <- describe(y)[2:13]
row.names(result1) <- "Total "
row.names(result2) <- "Average "
return(list(result2, result1))
}
})
alpha.result <- reactive({
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
print(alpha(x, check.keys=F, na.rm=T),3)
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
print(alpha(x, check.keys=F, na.rm=T),3)
}
})
kr.result <- reactive({
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
bicheck <- apply(x,2,function(x) { all(na.omit(x) %in% 0:1) })
k <- ncol(x)
varp <- function(x) {
v <- var(x) * (length(x)-1) / length(x)
v
}
SX <- varp(rowSums(x))
IM <- colMeans(x)
KR20 <- ((k/(k - 1))*((SX - sum(IM*(1 - IM)))/SX))
KR21 <- (k/(k-1))*((varp(rowSums(x)) - k*(sum(colMeans(x))/k) *
(1-(sum(colMeans(x))/k))))/varp(rowSums(x))
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
bicheck <- apply(x,2,function(x) { all(na.omit(x) %in% 0:1) })
k <- ncol(x)
varp <- function(x) {
v <- var(x) * (length(x)-1) / length(x)
v
}
SX <- varp(rowSums(x))
IM <- colMeans(x)
KR20 <- ((k/(k - 1))*((SX - sum(IM*(1 - IM)))/SX))
KR21 <- (k/(k-1))*((varp(rowSums(x)) - k*(sum(colMeans(x))/k) *
(1-(sum(colMeans(x))/k))))/varp(rowSums(x))
}
if (all(bicheck) == TRUE){
cat(" KR20 =", round(KR20, 3), "\n", "KR21 =", round(KR21, 3), "\n")
} else {
cat("Kuder–Richardson Formula 20 (KR-20) and 21 (KR-21) will be displayed","\n", "if the input data is binary (0/1).")
}
})
kr21.result <- reactive({
iNo <- input$k
M <- input$M
SD <- input$SD
KR21 <- round(iNo/(iNo-1)*(1-(M*(iNo-M)/(iNo*SD^2))),3)
cat("KR21 =", round(KR21, 3), "\n")
})
makedistPlot <- function(){
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
if (input$meantotal1 == "mean1") {
x <- rowMeans(x, na.rm=T)
} else {
x <- rowSums(x, na.rm=T)
}
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
if (input$meantotal1 == "mean1") {
x <- rowMeans(x, na.rm=T)
} else {
x <- rowSums(x, na.rm=T)
}
}
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, na.rm= T, 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(){
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
if (input$meantotal2 == "mean2") {
x <- rowMeans(x, na.rm=T)
} else {
x <- rowSums(x, na.rm=T)
}
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
if (input$meantotal2 == "mean2") {
x <- rowMeans(x, na.rm=T)
} else {
x <- rowSums(x, na.rm=T)
}
}
boxplot(x, horizontal=TRUE, xlab= "Mean and +/-1 SD are displayed in red.")
beeswarm(x, horizontal=TRUE, col = 4, pch = 16, add = TRUE)
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")
}
output$boxPlot <- renderPlot({
print(makeboxPlot())
})
testnorm <- reactive({
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
x <- rowMeans(x, na.rm=T)
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
x <- rowMeans(x, na.rm=T)
}
list(ks.test(scale(x), "pnorm"), shapiro.test(x))
})
makeqqPlot <- function(){
if (input$colname == 0) {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."), header=F)
x <- as.matrix(x)
x <- rowMeans(x, na.rm=T)
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
x <- rowMeans(x, na.rm=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$textarea.out <- renderPrint({
bs()
})
output$alpha.result.out <- renderPrint({
alpha.result()
})
output$kr.result.out <- renderPrint({
kr.result()
})
output$kr21.result.out <- renderPrint({
kr21.result()
})
output$testnorm.out <- renderPrint({
testnorm()
})
output$info.out <- renderPrint({
info()
})
})
library(shiny)
library(shinyAce)
shinyUI(bootstrapPage(
headerPanel("Cronbach's Coefficient Alpha"),
mainPanel(
tabsetPanel(
tabPanel("Main",
strong('Option:'),
checkboxInput("colname", label = strong("The input data includes variable names (header)."), value = T),
br(),
p('Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.'),
aceEditor("text", value="Item1\tItem2\tItem3\tItem4\n2\t3\t3\t3\n3\t3\t4\t4\n4\t4\t3\t4\n5\t4\t3\t4\n3\t4\t2\t4\n3\t3\t4\t3\n4\t3\t4\t4\n3\t3\t2\t2\n4\t5\t5\t5\n2\t2\t1\t2\n4\t3\t4\t3\n3\t4\t3\t3\n3\t4\t4\t3\n3\t4\t3\t4\n5\t5\t5\t4",
mode="r", theme="cobalt"),
br(),
h3("Basic statistics of the scale (test)"),
verbatimTextOutput("textarea.out"),
br(),
h3("Cronbach's coefficient alpha"),
verbatimTextOutput("alpha.result.out"),
br(),
h3("KR (Kuder–Richardson) 20 & 21"),
verbatimTextOutput("kr.result.out"),
checkboxInput("msdnKR21", label = ("Calculate KR21 from k, M, and SD."), value = F),
conditionalPanel(
condition = "input.msdnKR21==1",
p("k = the number of items, M = mean, and SD = standard deviation"),
fluidRow(
column(4, numericInput(inputId = "k",
label = "k",
value = 20,
width = '100%')),
column(4, numericInput(inputId = "M",
label = "M",
value = 9.48,
width = '100%')),
column(4, numericInput(inputId = "SD",
label = "SD",
value = 4.52,
width = '100%'))),
verbatimTextOutput("kr21.result.out")
),
br(),
h3("Histogram"),
radioButtons("meantotal1", "",
list("Average" = "mean1",
"Total" = "total1"), selected = "mean1"),
plotOutput("distPlot"),
br(),
h3("Box plot with individual data points"),
radioButtons("meantotal2", "",
list("Average" = "mean2",
"Total" = "total2"), selected = "mean2"),
plotOutput("boxPlot"),
br(),
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(shinyAce)'),br(),
code('library(psych)'),br(),
code('library(beeswarm)'),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/rel', 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("rel","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="https://sites.google.com/site/casualmacr/", 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/"),
p(br())
)
))
))
