library(shiny)
library(shinyAce)
library(psych)
library(ltm)
library(CTT)
library(beeswarm)
shinyServer(function(input, output) {
options(warn=-1)
check <- reactive({
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
}
})
bs <- reactive({
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
total <- rowSums(dat, na.rm=T)
result <- describe(total)[2:13]
row.names(result) <- "Total "
#result
relv <- as.numeric(score(x, ans, output.scored=TRUE, rel=TRUE)$reliability[3])
stdv <- as.numeric(describe(total)[4])
sem <- round(stdv * sqrt(1 - relv), 2)
print(result)
cat("\n","Standard error of measurement (SEM):", sem, "\n")
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
total <- rowSums(dat, na.rm=T)
result <- describe(total)[2:13]
row.names(result) <- "Total "
#result
relv <- as.numeric(score(x, ans, output.scored=TRUE, rel=TRUE)$reliability[3])
stdv <- as.numeric(describe(total)[4])
sem <- round(stdv * sqrt(1 - relv), 2)
print(result)
cat("\n","Standard error of measurement (SEM):", sem, "\n")
}
})
alpha.result <- reactive({
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
result1 <- cronbach.alpha(dat)
result2 <- alpha(dat, check.keys=F)
result2 <- round(result2$alpha.drop,3)
colnames(result2) <- ""
print(result1)
cat("\n", "Reliability if the item is dropped/deleted", "\n")
print(result2[1])
#list(result1, "Reliability if the item is dropped/deleted"=result2)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
result1 <- cronbach.alpha(dat)
result2 <- alpha(dat, check.keys=F)
result2 <- round(result2$alpha.drop,3)
colnames(result2) <- ""
print(result1)
cat("\n", "Reliability if the item is dropped/deleted", "\n")
print(result2[1])
#list(result1, "Reliability if the item is dropped/deleted"=result2)
}
})
item.analysis <- reactive({
if (input$colname == 0) {
# Item disctimination
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
dat <- as.data.frame(dat)
itemd <- function(data) {
#alphaRes <- alpha(data, cumulative=T, check.keys=F, delete=F)
#item.mean <- round(alphaRes$item.stats$mean,3)
item.mean <- round(colMeans(data), 3)
m <- mean(rowSums(data))
sd <- sd(rowSums(data))
totalDat <- cbind(data,rowSums(data))
#r.drop <- round(ifelse(is.na(alphaRes$item.stats$r.drop), 0, alphaRes$item.stats$r.drop),3)
r.dropped <- function(data) {
r.dropped <- c()
for (i in 1:ncol(data)) {
r.dropped[i] <- round(cor(data[,i], rowSums(data)-data[,i]), 3)
}
return(r.dropped)
}
r.drop <- r.dropped(data)
sortDat <- totalDat[order(-totalDat[,length(totalDat)]),]
pbi <- c()
itemD <- c()
rownames(sortDat) <- c(1:nrow(sortDat))
highDat <- head(sortDat,nrow(sortDat) %/% 3)
lowDat <- tail(sortDat,nrow(sortDat) %/% 3)
for (i in 1:length(data)) {
mhigh <- mean(subset(totalDat[,length(totalDat)],(data[,i] == 1)))
mlow <- mean(subset(totalDat[,length(totalDat)],(data[,i] == 0)))
imean <- mean(data[,i])
itemD[i] <- round((mean(highDat[,i]) - mean(lowDat[,i])),3)
if (imean == 1 || imean == 0) {
pbi[i] <- 0
} else {
pbi[i] <- round(((mhigh - mlow) / sd) * sqrt(imean * (1 - imean)),3)
}
}
colid <- data.frame(colnames(dat), item.mean, r.drop, pbi, itemD)
#colid <- data.frame(colnames(dat), item.mean, r.drop, itemD)
colnames(colid) <- c("Item","Item_Mean","I-R_Correl","r_pbi","U-L_DISC")
#colnames(colid) <- c("Item","Item_Mean","I-R_Correl","U-L_DISC")
return(colid)
}
result1 <- itemd(dat)
# AENO
x <- read.table(text=input$text1, sep="\t")
dat <- as.data.frame(x)
aeno.ind <- function(data) {
aeno.ind <- c()
for (i in 1:ncol(data)) {
x <- table(data[,i])/nrow(data)
ctgr <- c()
for (j in 1:length(x)) {
ctgr[j] <- x[j]*(log10(x[j])/log10(2))
}
aeno.ind[i] <- round(2^(abs((sum(ctgr[1:length(x)])))),3)
}
aenos <- data.frame(colnames(dat), aeno.ind)
colnames(aenos) <- c("Item","AENO")
return(aenos)
}
result2 <- aeno.ind(dat)
merge(result1, result2)
} else {
# Item disctimination
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
dat <- as.data.frame(dat)
itemd <- function(data) {
#alphaRes <- alpha(data, cumulative=T, check.keys=F, delete=F)
#item.mean <- round(alphaRes$item.stats$mean,3)
item.mean <- round(colMeans(data), 3)
m <- mean(rowSums(data))
sd <- sd(rowSums(data))
totalDat <- cbind(data,rowSums(data))
#r.drop <- round(ifelse(is.na(alphaRes$item.stats$r.drop), 0, alphaRes$item.stats$r.drop),3)
r.dropped <- function(data) {
r.dropped <- c()
for (i in 1:ncol(data)) {
r.dropped[i] <- round(cor(data[,i], rowSums(data)-data[,i]), 3)
}
return(r.dropped)
}
r.drop <- r.dropped(data)
sortDat <- totalDat[order(-totalDat[,length(totalDat)]),]
pbi <- c()
itemD <- c()
rownames(sortDat) <- c(1:nrow(sortDat))
highDat <- head(sortDat,nrow(sortDat) %/% 3)
lowDat <- tail(sortDat,nrow(sortDat) %/% 3)
for (i in 1:length(data)) {
mhigh <- mean(subset(totalDat[,length(totalDat)],(data[,i] == 1)))
mlow <- mean(subset(totalDat[,length(totalDat)],(data[,i] == 0)))
imean <- mean(data[,i])
itemD[i] <- round((mean(highDat[,i]) - mean(lowDat[,i])),3)
if (imean == 1 || imean == 0) {
pbi[i] <- 0
} else {
pbi[i] <- round(((mhigh - mlow) / sd) * sqrt(imean * (1 - imean)),3)
}
}
colid <- data.frame(colnames(dat), item.mean, r.drop, pbi, itemD)
#colid <- data.frame(colnames(dat), item.mean, r.drop, itemD)
colnames(colid) <- c("Item","Item_Mean","I-R_Correl","r_pbi","U-L_DISC")
#colnames(colid) <- c("Item","Item_Mean","I-R_Correl","U-L_DISC")
return(colid)
}
result1 <- itemd(dat)
# AENO
x <- read.csv(text=input$text1, sep="\t")
dat <- as.data.frame(x)
aeno.ind <- function(data) {
aeno.ind <- c()
for (i in 1:ncol(data)) {
x <- table(data[,i])/nrow(data)
ctgr <- c()
for (j in 1:length(x)) {
ctgr[j] <- x[j]*(log10(x[j])/log10(2))
}
aeno.ind[i] <- round(2^(abs((sum(ctgr[1:length(x)])))),3)
}
aenos <- data.frame(colnames(dat), aeno.ind)
colnames(aenos) <- c("Item","AENO")
return(aenos)
}
result2 <- aeno.ind(dat)
merge(result1, result2)
}
})
distractor <- reactive({
if (input$type == "frequency") {
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
distractor.analysis(x, ans)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
distractor.analysis(x, ans)
}
} else {
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
distractor.analysis(x, ans, p.table = T)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
dat <- score(x, ans, output.scored=TRUE)$scored
distractor.analysis(x, ans, p.table = T)
}
}
})
makedistPlot <- function(){
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
x <- rowSums(x, na.rm=T)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
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.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
x <- rowSums(x, na.rm=T)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
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.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
x <- rowSums(x, na.rm=T)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
x <- rowSums(x, na.rm=T)
}
list(ks.test(scale(x), "pnorm"), shapiro.test(x))
})
makeqqPlot <- function(){
if (input$colname == 0) {
x <- read.table(text=input$text1, sep="\t")
x <- as.matrix(x)
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
x <- rowSums(x, na.rm=T)
} else {
x <- read.csv(text=input$text1, sep="\t")
ans <- read.delim(text=input$text2, sep="\t", fill=TRUE, header=FALSE, stringsAsFactors=FALSE)
ans <- as.character(ans)
x <- score(x, ans, output.scored=TRUE)$scored
x <- rowSums(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$info.out <- renderPrint({
info()
})
output$check <- renderTable({
head(check(), n = 10)
}, digits = 0)
output$textarea.out <- renderPrint({
bs()
})
output$alpha.result.out <- renderPrint({
alpha.result()
})
output$item.analysis.out <- renderPrint({
item.analysis()
})
output$distractor.out <- renderPrint({
distractor()
})
output$testnorm.out <- renderPrint({
testnorm()
})
})
library(shiny)
library(shinyAce)
shinyUI(bootstrapPage(
headerPanel("Classical Test Theory (Item Analysis)"),
mainPanel(
tabsetPanel(
tabPanel("Main",
#h3("Executing the analysis"),
#p('If you input a new dataset, click on this button to execute the analysis.'),
#submitButton("Compute"),
#br(),
#br(),
strong('Option:'),
checkboxInput("colname", label = "The input data includes variable names (the header) in the first row.", TRUE),
br(),
p('Note: Input values (either numeric or character) must be separated by tabs. Copy and paste from Excel/Numbers.'),
aceEditor("text1", value="i01\ti02\ti03\ti04\ti05\ti06\ti07\ti08\ti09\ti10\ti11\ti12\ti13\ti14\ti15\ti16\ti17\ti18\ti19\ti20\nA\tB\tB\tB\tB\tC\tB\tC\tB\tD\tD\tC\tA\tB\tA\tD\tB\tD\tA\tC\nC\tD\tA\tD\tC\tB\tD\tB\tD\tA\tD\tD\tA\tB\tC\tC\tC\tA\tD\tC\nB\tD\tC\tD\tA\tB\tA\tC\tB\tD\tB\tA\tA\tD\tD\tA\tB\tC\tB\tB\nC\tC\tD\tD\tD\tA\tA\tD\tD\tD\tA\tB\tC\tB\tD\tB\tC\tB\tC\tA\nA\tA\tA\tD\tA\tA\tD\tB\tA\tC\tA\tD\tC\tC\tC\tC\tA\tA\tA\tB\nA\tA\tB\tC\tC\tA\tA\tA\tA\tA\tB\tC\tC\tC\tC\tB\tD\tC\tD\tD\nA\tA\tB\tA\tA\tA\tD\tB\tC\tC\tB\tC\tD\tA\tB\tD\tB\tB\tB\tD\nA\tC\tA\tD\tC\tA\tD\tA\tA\tA\tD\tD\tC\tC\tB\tA\tD\tC\tA\tD\nD\tB\tA\tD\tD\tA\tD\tB\tB\tA\tB\tB\tB\tC\tA\tA\tD\tA\tC\tB\nC\tC\tA\tC\tB\tC\tD\tC\tA\tA\tD\tD\tA\tA\tB\tC\tB\tB\tC\tC\nD\tA\tC\tB\tD\tA\tD\tB\tD\tA\tA\tD\tD\tC\tA\tC\tD\tC\tA\tD\nA\tD\tA\tD\tC\tA\tA\tA\tC\tD\tB\tB\tB\tA\tA\tC\tC\tD\tC\tC\nD\tC\tB\tA\tD\tA\tD\tB\tB\tA\tB\tD\tC\tC\tC\tC\tD\tA\tB\tC\nD\tC\tC\tD\tA\tA\tD\tB\tD\tB\tD\tD\tC\tB\tB\tB\tD\tB\tC\tB\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tC\tC\tC\tB\tC\tB\tA\tA\tB\nB\tC\tB\tC\tB\tB\tD\tD\tA\tA\tB\tA\tC\tD\tD\tB\tA\tA\tB\tC\nD\tA\tA\tA\tD\tD\tB\tC\tB\tA\tB\tA\tD\tB\tD\tC\tC\tD\tD\tC\nC\tD\tB\tC\tC\tA\tD\tC\tC\tB\tC\tA\tC\tA\tA\tC\tC\tB\tA\tC\nD\tB\tA\tC\tD\tB\tD\tB\tD\tC\tD\tD\tA\tC\tA\tD\tC\tD\tD\tD\nA\tC\tA\tD\tB\tC\tC\tD\tD\tC\tA\tB\tC\tC\tA\tD\tB\tC\tA\tB\nD\tC\tA\tD\tB\tA\tD\tA\tA\tA\tA\tD\tC\tC\tC\tC\tB\tB\tD\tD\nB\tA\tB\tB\tB\tA\tD\tD\tD\tD\tD\tD\tB\tB\tB\tD\tB\tD\tC\tC\nB\tC\tC\tA\tC\tC\tD\tB\tD\tA\tC\tD\tD\tA\tA\tA\tC\tB\tD\tC\nA\tC\tA\tA\tA\tB\tD\tB\tA\tA\tC\tC\tC\tC\tA\tB\tA\tB\tB\tB\nD\tD\tD\tB\tC\tA\tD\tB\tC\tA\tD\tD\tB\tD\tB\tC\tB\tA\tB\tA\nA\tD\tA\tB\tA\tA\tB\tC\tB\tB\tA\tA\tB\tA\tC\tA\tD\tB\tD\tB\nB\tD\tD\tA\tC\tB\tD\tD\tA\tA\tB\tD\tC\tA\tA\tD\tD\tA\tD\tD\nD\tC\tD\tB\tA\tA\tB\tC\tC\tB\tC\tD\tC\tC\tB\tD\tA\tB\tC\tB\nD\tB\tD\tB\tD\tA\tD\tC\tD\tD\tC\tD\tC\tD\tD\tB\tC\tC\tB\tD\nB\tB\tD\tC\tD\tA\tB\tB\tB\tB\tB\tC\tA\tC\tC\tA\tB\tA\tB\tA\nD\tC\tC\tC\tC\tA\tD\tA\tB\tA\tC\tD\tC\tC\tB\tA\tA\tC\tB\tB\nB\tA\tA\tB\tD\tA\tA\tD\tD\tA\tA\tC\tD\tA\tD\tA\tA\tC\tB\tA\nB\tA\tA\tB\tB\tC\tB\tA\tC\tA\tA\tC\tD\tD\tB\tD\tA\tB\tB\tB\nD\tA\tC\tB\tB\tA\tC\tB\tB\tD\tB\tD\tC\tA\tA\tA\tC\tD\tD\tD\nB\tC\tB\tA\tD\tA\tD\tB\tA\tA\tD\tB\tC\tA\tC\tB\tA\tB\tC\tC\nA\tA\tC\tB\tA\tA\tC\tB\tB\tC\tD\tA\tB\tC\tA\tD\tA\tB\tB\tD\nD\tC\tA\tC\tA\tA\tD\tB\tC\tB\tA\tD\tC\tB\tD\tC\tD\tD\tC\tA\nD\tC\tC\tB\tA\tA\tD\tB\tC\tB\tD\tD\tB\tA\tD\tA\tD\tC\tD\tD\nB\tC\tB\tC\tA\tA\tD\tB\tA\tA\tA\tC\tD\tB\tD\tC\tB\tD\tC\tC\nD\tC\tA\tB\tD\tA\tD\tA\tB\tB\tC\tC\tC\tA\tA\tA\tC\tC\tA\tC\nC\tC\tD\tC\tB\tD\tA\tC\tD\tA\tC\tB\tA\tD\tD\tA\tB\tD\tA\tC\nC\tD\tB\tD\tA\tA\tC\tB\tC\tA\tB\tD\tC\tD\tC\tA\tD\tC\tB\tA\nC\tD\tC\tB\tB\tA\tD\tB\tD\tA\tD\tD\tC\tB\tD\tB\tB\tA\tA\tB\nB\tB\tA\tB\tB\tA\tD\tB\tC\tC\tD\tB\tC\tC\tD\tA\tD\tC\tD\tC\nD\tB\tD\tC\tC\tA\tD\tD\tB\tA\tC\tA\tC\tC\tA\tB\tC\tC\tA\tA\nD\tA\tD\tA\tA\tA\tD\tB\tD\tB\tB\tB\tA\tB\tB\tC\tC\tB\tB\tA\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tB\tD\tC\tC\tB\tA\tD\tA\tB\tB\nD\tC\tA\tD\tB\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tB\tD\tA\tC\tB\nD\tC\tD\tA\tB\tA\tD\tB\tD\tD\tA\tD\tC\tD\tB\tC\tD\tA\tA\tB\nA\tB\tA\tB\tA\tA\tD\tB\tA\tC\tC\tB\tC\tD\tB\tD\tC\tA\tD\tA\nB\tB\tA\tB\tC\tA\tD\tA\tB\tA\tC\tD\tC\tC\tC\tB\tB\tA\tD\tD\nD\tC\tC\tD\tD\tA\tD\tB\tD\tA\tC\tD\tC\tD\tD\tA\tB\tB\tA\tC\nD\tC\tD\tD\tD\tA\tD\tC\tB\tA\tA\tD\tC\tD\tB\tD\tD\tC\tB\tA\nA\tB\tA\tD\tC\tA\tB\tB\tC\tC\tC\tB\tD\tA\tA\tA\tB\tB\tC\tD\nB\tC\tA\tC\tA\tA\tD\tA\tB\tC\tD\tA\tC\tB\tC\tB\tC\tC\tB\tC\nC\tA\tB\tD\tC\tA\tD\tA\tA\tD\tC\tB\tA\tA\tB\tB\tB\tA\tC\tD\nA\tD\tA\tB\tC\tB\tD\tB\tB\tC\tB\tA\tC\tC\tA\tA\tA\tC\tC\tD\nB\tA\tA\tB\tD\tA\tD\tC\tD\tA\tA\tD\tC\tC\tD\tA\tD\tA\tA\tB\nD\tC\tA\tB\tC\tA\tD\tD\tA\tA\tD\tA\tC\tB\tC\tB\tA\tA\tA\tC\nA\tB\tD\tC\tC\tA\tD\tA\tD\tA\tD\tD\tC\tC\tA\tB\tC\tB\tB\tD\nD\tC\tA\tD\tD\tA\tD\tB\tC\tA\tA\tD\tA\tC\tB\tC\tD\tA\tD\tB\nB\tA\tA\tC\tC\tC\tD\tB\tB\tC\tA\tA\tA\tD\tB\tB\tD\tD\tD\tC\nD\tC\tA\tB\tB\tA\tD\tA\tB\tB\tA\tD\tC\tC\tA\tC\tD\tB\tA\tB\nD\tC\tA\tB\tC\tA\tD\tB\tA\tA\tA\tD\tC\tC\tB\tC\tC\tA\tD\tB\nC\tB\tA\tC\tC\tA\tB\tA\tA\tD\tB\tA\tC\tA\tA\tA\tA\tB\tC\tB\nC\tC\tD\tA\tD\tC\tB\tB\tA\tB\tC\tD\tC\tB\tC\tC\tD\tA\tA\tA\nB\tA\tB\tA\tB\tA\tA\tA\tC\tC\tC\tB\tD\tD\tB\tB\tB\tB\tA\tA\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tB\tD\tB\tA\tB\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tC\tD\tA\tA\tB\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tB\tD\tA\tA\tB\nA\tC\tB\tA\tD\tA\tA\tB\tB\tB\tA\tD\tC\tB\tB\tA\tD\tD\tA\tD\nA\tC\tA\tB\tC\tB\tD\tB\tC\tD\tA\tD\tC\tC\tA\tD\tD\tD\tB\tA\nD\tA\tA\tA\tA\tA\tD\tB\tB\tB\tA\tA\tA\tC\tB\tC\tD\tD\tA\tB\nA\tC\tC\tD\tB\tA\tC\tD\tA\tA\tA\tA\tC\tC\tB\tA\tD\tC\tB\tB\nD\tC\tA\tD\tD\tA\tD\tA\tA\tD\tD\tD\tC\tC\tC\tD\tA\tA\tA\tB\nD\tC\tD\tB\tD\tA\tC\tA\tC\tA\tA\tD\tC\tC\tD\tD\tC\tC\tB\tD\nD\tC\tA\tD\tA\tA\tD\tB\tA\tB\tA\tD\tD\tC\tB\tB\tD\tD\tD\tC\nB\tC\tA\tB\tC\tA\tD\tB\tA\tD\tA\tD\tC\tC\tA\tC\tB\tB\tA\tB\nD\tC\tB\tD\tB\tA\tD\tC\tD\tA\tB\tD\tC\tC\tB\tC\tD\tD\tA\tB\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tC\tD\tC\tC\tD\tA\tD\tA\tB\tD\nD\tC\tA\tB\tD\tA\tD\tB\tD\tB\tA\tD\tC\tC\tB\tD\tA\tB\tA\tD\nC\tC\tA\tC\tD\tA\tD\tB\tD\tB\tA\tD\tA\tC\tD\tC\tC\tD\tA\tB\nB\tC\tA\tD\tC\tB\tB\tD\tB\tA\tB\tA\tD\tC\tD\tC\tA\tD\tD\tB\nC\tA\tD\tA\tA\tA\tB\tC\tA\tC\tB\tC\tC\tD\tB\tB\tC\tC\tD\tB\nB\tB\tA\tC\tA\tA\tD\tB\tC\tC\tD\tA\tB\tA\tC\tD\tD\tB\tC\tA\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tD\tD\tA\tA\tC\nC\tC\tA\tB\tC\tA\tD\tB\tD\tD\tA\tD\tA\tC\tD\tA\tC\tC\tB\tB\nA\tC\tB\tD\tD\tA\tD\tB\tA\tA\tA\tD\tC\tC\tD\tC\tA\tB\tA\tD\nD\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tA\tD\tA\tA\tB\nD\tC\tA\tD\tD\tA\tD\tB\tB\tD\tA\tD\tA\tC\tC\tC\tD\tA\tC\tB\nD\tB\tA\tB\tD\tA\tA\tC\tC\tD\tC\tC\tB\tD\tC\tC\tB\tB\tD\tB\nD\tA\tD\tB\tA\tA\tA\tC\tB\tA\tC\tA\tC\tD\tB\tC\tB\tC\tD\tD\nB\tD\tA\tB\tB\tA\tC\tD\tC\tB\tB\tD\tD\tA\tB\tA\tB\tD\tC\tC\nD\tA\tB\tB\tC\tA\tD\tB\tC\tA\tA\tD\tC\tC\tB\tC\tD\tC\tD\tB\nA\tA\tB\tB\tD\tA\tA\tD\tB\tA\tB\tD\tC\tC\tD\tB\tB\tA\tB\tD\nD\tC\tA\tD\tD\tA\tD\tB\tB\tC\tB\tD\tA\tA\tC\tB\tD\tA\tD\tB\nD\tC\tC\tD\tD\tA\tD\tB\tC\tA\tA\tD\tC\tC\tB\tB\tD\tD\tB\tB\nD\tC\tA\tD\tB\tA\tD\tB\tA\tA\tA\tD\tC\tC\tB\tB\tD\tA\tA\tB\nB\tB\tA\tC\tD\tA\tD\tB\tC\tA\tD\tB\tC\tC\tD\tC\tD\tC\tB\tD\nD\tA\tA\tD\tD\tA\tD\tB\tB\tA\tA\tD\tB\tC\tC\tC\tD\tA\tA\tB",
mode="r", theme="cobalt", height="400px"),
p("Input answer keys (Either numeric or character, separated by tabs.):"),
aceEditor("text2", value="D\tC\tA\tD\tD\tA\tD\tB\tD\tA\tA\tD\tC\tC\tB\tC\tD\tA\tA\tB", mode="r", theme="chrome", height="50px"),
br(),
h3("Checking the 1-0 converted data"),
p('Only the first 10 observations are displayed.'),
p('If you want to download the converted data, use',
a('Binary (1-0) Data Converter', href='https://langtest4.shinyapps.io/biconv/', target="_blank"), '.'),
tableOutput("check"),
br(),
h3("Basic statistics"),
verbatimTextOutput("textarea.out"),
br(),
h3("Cronbach's coefficient alpha"),
verbatimTextOutput("alpha.result.out"),
br(),
h3("Item analysis"),
verbatimTextOutput("item.analysis.out"),
p('Item_Mean: item facility (IF)', br(),
'I-R_Correl: Item-Remainder score correlation or "corrected item-total correlation"', br(),
'r_pbi: Point-biserial correlation or "item-total correlation"', br(),
'U-L_DISC: item discrimination (upper 1/3 - lower 1/3)', br(),
'AENO: actual equivalant number of options (out of the total number of options)'),
br(),
h3("Distractor analysis"),
radioButtons("type", "",
list("Frequency" = "frequency", "Proportion" = "proportion"), selected = "frequency"),
verbatimTextOutput("distractor.out"),
br(),
h3("Histogram of the total score"),
plotOutput("distPlot"),
br(),
h3("Box plot with individual data points"),
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://www.rstudio.com/shiny/", target="_blank"),
''),
br(),
strong('List of Packages Used'), br(),
code('library(shiny)'),br(),
code('library(shinyAce)'),br(),
code('library(psych)'),br(),
code('library(ltm)'),br(),
code('library(CTT)'),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"),'I also referred to the code used in', a("MacR.", href="https://sites.google.com/site/casualmacr/", target="_blank")),
p('The code for this web application is available at',
a('GitHub.', href='https://github.com/mizumot/ctt', 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("ctt","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())
)
))
))
