library(shiny)
library(shinyAce)
library(psych)
library(lattice)
library(ggplot2)
library(compute.es)
library(car)
library (effects)
library (multcomp)
shinyServer(function(input, output) {
#-----------------------------------------------------------------
# ANCOVA for Pre-Posttest Design
#-----------------------------------------------------------------
# Basic statistics
bs <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
describeBy(dat[,-1], dat[,1])
})
output$bs.out <- renderPrint({
bs()
})
# Histograms
hist <- function(){
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
histogram(~ post + pre | group, data=dat)
}
output$hist <- renderPlot({
print(hist())
})
# Interaction plot
int.plot <- function(){
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
labelnames <- colnames(dat)
groupnames <- unique(dat[,1])
dat <- reshape(dat, varying=2:length(dat), v.names="score", direction = "long")
res <- dat[,3]
names(dat) <- c("fac1", "fac2", "res")
df <- with(dat, aggregate(res, list(fac1=fac1, fac2=fac2), mean))
ci <- with(dat , aggregate(res, list(fac1=fac1, fac2=fac2), function(x) qt(0.975,length(x)-1)*sd(x)/sqrt(length(x))))
df$ci <- ci[,3]
df$fac1 <- factor(df[,1])
df$fac2 <- factor(df[,2])
opar <- theme_update(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_rect(colour = "black"))
xgap <- position_dodge(0.15)
gp <- ggplot(df, aes(x=fac2, y=x, colour=fac1, group=fac1))
gp + geom_line(aes(linetype=fac1), size=.6, position=xgap) +
geom_point(aes(shape=fac1), size=6, position=xgap) +
geom_errorbar(aes(ymax=x+ci, ymin=x-ci), width=.1, position=xgap) +
ylim(min(dat$res), max(dat$res)) +
labs(title = "Error bars: 95% CI", y = "Score" ) +
theme(plot.title=element_text(size=14), axis.title.x = element_text(size=14), axis.title.y = element_text(size=14),
axis.text.x = element_text(size=14), axis.text.y = element_text(size=14),
legend.position = c(1, 1), legend.justification = c(1, 1), legend.key = element_rect(fill = "white",colour = "white"),
legend.title = element_text(size=14), legend.text = element_text(size = 14)) +
scale_colour_discrete(name ="Condition", labels = c("1" = as.character(groupnames[1]), "2" = as.character(groupnames[2]))) +
scale_linetype_discrete(name ="Condition", labels = c("1" = as.character(groupnames[1]), "2" = as.character(groupnames[2]))) +
scale_shape_discrete(name ="Condition", labels = c("1" = as.character(groupnames[1]), "2" = as.character(groupnames[2]))) +
scale_x_discrete("", labels = c("1" = labelnames[2], "2"=labelnames[3]))
}
output$int.plot <- renderPlot({
print(int.plot())
})
# Scatterplot
scatterplot <- function(){
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
allscore <- c(dat[,2], dat[,3])
minval <- round(min(allscore)*0.95,0)
maxval <- round(max(allscore)*1.05,0)
groupnames <- unique(dat[,1])
labelnames <- colnames(dat)
dat2 <- split(dat, dat[,1])
group1 <- dat2[[1]]
group2 <- dat2[[2]]
par(mar = c(5, 5, 2, 2))
par(xaxs = "i", yaxs = "i")
plot(group1[,2], group1[,3], pch = 16, cex = 1.5, col = 2,
xlim = c(minval,maxval), ylim = c(minval,maxval), las = 1,
xlab = labelnames[2], ylab = labelnames[3],
cex.lab = 1.2)
points(group2[,2], group2[,3], pch = 17, cex = 1.5, col = 1)
lines(par()$usr[1:2], par()$usr[3:4], lty = 1, lwd = 0.5)
legend("bottomright", legend = c(as.character(unique(group1[,1])),as.character(unique(group2[,1]))), col = c(2, 1), pch = c(16, 17), cex = 1.2)
}
output$scatterplot <- renderPlot({
print(scatterplot())
})
# t-test with pretest scores
t_test <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
t.test(pre ~ group, data=dat)
})
output$t_test.out <- renderPrint({
t_test()
})
t_effect <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat2 <- split(dat, dat[,1])
group1 <- dat2[[1]]
group2 <- dat2[[2]]
m1 <- mean(group1[,2])
sd1 <- sd(group1[,2])
n1 <- length(group1[,2])
m2 <- mean(group2[,2])
sd2 <- sd(group2[,2])
n2 <- length(group2[,2])
esd <- mes(m1, m2, sd1, sd2, n1, n2, verbose=FALSE)
cat("d [95 %CI] = ", esd[4]$d, "[", esd[6]$l.d, ",", esd[7]$u.d, "]", "\n",
"var(d) = ", esd[5]$var.d, "\n",
"p-value(d) = ", esd[11]$pval.d, "\n"
)
})
output$t_effect.out <- renderPrint({
t_effect()
})
# Checking ANCOVA assumptions
levene <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
leveneTest(dat$post, dat$group, center = median)
})
output$levene.out <- renderPrint({
levene()
})
slope <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
summary(aov(post ~ pre * group, data = dat))
})
output$slope.out <- renderPrint({
slope()
})
# ANCOVA result
ancova.res <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
summary(lm(post ~ pre + group, data=dat))
})
output$ancova.res.out <- renderPrint({
ancova.res()
})
# Adjusted means of posttest scores
adj.m <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
model <- aov(post ~ pre + group, data = dat)
adjustedMeans <- effect("group", model, se=TRUE)
summary(adjustedMeans)
})
output$adj.m.out <- renderPrint({
adj.m()
})
adjustedplot <- function(){
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
model <- aov(post ~ pre + group, data = dat)
adjustedMeans <- effect("group", model, se=TRUE)
plot(adjustedMeans)
}
output$adjustedplot <- renderPlot({
print(adjustedplot())
})
# Statistical test of adjusted means
adj.m.test <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
model <- aov(post ~ pre + group, data = dat)
postHocs <- glht(model, linfct = mcp(group = "Tukey"))
print(summary(postHocs))
cat("\n", "[95% CI]", "\n")
print(head(confint(postHocs)$confint))
})
output$adj.m.test.out <- renderPrint({
adj.m.test()
})
# Effect size of adjusted means
adj.m.effect <- reactive({
dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
dat[,1] <- as.factor(dat[,1])
colnames(dat) <- c("group","pre","post")
model <- aov(post ~ pre + group, data = dat)
adjustedMeans <- effect("group", model, se=TRUE)
dat2 <- split(dat, dat[,1])
group1 <- dat2[[1]]
group2 <- dat2[[2]]
n1 <- length(group1[,2])
n2 <- length(group2[,2])
n <- c(n1, n2)
sdadj <- adjustedMeans$se*sqrt(n)
adjustedMeans
esd <- mes(adjustedMeans$fit[1], adjustedMeans$fit[2], sdadj[1], sdadj[2], n1, n2, verbose=FALSE)
cat("d [95 %CI] = ", esd[4]$d, "[", esd[6]$l.d, ",", esd[7]$u.d, "]", "\n",
"var(d) = ", esd[5]$var.d, "\n",
"p-value(d) = ", esd[11]$pval.d, "\n"
)
})
output$adj.m.effect.out <- renderPrint({
adj.m.effect()
})
# Info
ancova.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$ancova.info.out <- renderPrint({
ancova.info()
})
})
library(shiny)
library(shinyAce)
shinyUI(bootstrapPage(
headerPanel("ANCOVA for Pre-Posttest Design"),
########## loading message #######################################
tags$head(tags$style(type="text/css", "
#loadmessage {
position: fixed;
top: 0px;
left: 0px;
width: 100%;
padding: 10px 0px 10px 0px;
text-align: center;
font-weight: bold;
font-size: 100%;
color: #000000;
background-color: #CCFF66;
z-index: 105;
}
")),
conditionalPanel(condition="$('html').hasClass('shiny-busy')",
tags$div("Loading...",id="loadmessage")),
###################################################################
mainPanel(
tabsetPanel( # position = "left", Rのバージョンが古いlangtest.jpのみ必要？
tabPanel("Pre-Posttest",
h4("Comparing two independent conditions"),
p('Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.'),
p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>Your data needs to have the header (variable names) in the first row. <br>
The covariate must be placed in the second column of the dataframe. </div></b>")),
aceEditor("text1", value="Group\tPre\tPost\ntreatment\t31\t48\ntreatment\t39\t51\ntreatment\t56\t67\ntreatment\t47\t44\ntreatment\t29\t33\ntreatment\t37\t41\ntreatment\t46\t43\ntreatment\t44\t53\ntreatment\t52\t64\ntreatment\t41\t52\ntreatment\t40\t53\ntreatment\t38\t44\ntreatment\t31\t39\ntreatment\t25\t32\ntreatment\t51\t62\ntreatment\t31\t43\ntreatment\t56\t59\ntreatment\t18\t19\ntreatment\t35\t46\ntreatment\t30\t50\ntreatment\t55\t62\ntreatment\t35\t45\ntreatment\t48\t58\ntreatment\t40\t49\ntreatment\t46\t58\ntreatment\t50\t66\ntreatment\t39\t44\ntreatment\t52\t64\ntreatment\t35\t45\ntreatment\t36\t53\ncontrol\t32\t40\ncontrol\t35\t39\ncontrol\t35\t42\ncontrol\t38\t28\ncontrol\t13\t11\ncontrol\t34\t30\ncontrol\t35\t25\ncontrol\t31\t39\ncontrol\t35\t53\ncontrol\t25\t40\ncontrol\t28\t41\ncontrol\t49\t47\ncontrol\t40\t37\ncontrol\t41\t36\ncontrol\t36\t41\ncontrol\t29\t33\ncontrol\t20\t22\ncontrol\t38\t26\ncontrol\t31\t34\ncontrol\t41\t49\ncontrol\t32\t43\ncontrol\t36\t37\ncontrol\t11\t24\ncontrol\t33\t35\ncontrol\t17\t27\ncontrol\t48\t56\ncontrol\t31\t29\ncontrol\t51\t60\ncontrol\t51\t58\ncontrol\t55\t62", mode="r", theme="cobalt"),
br(),
h3("Basic statistics"),
verbatimTextOutput("bs.out"),
br(),
h3("Histograms"),
plotOutput("hist"),
br(),
h3("Interaction plot"),
plotOutput("int.plot"),
br(),
h3("Scatterplot"),
plotOutput("scatterplot"),
p('The data above the diagonal of the plot show increase in the posttest.',
a("Wright (2003, p. 130)", href="https://doi.org/10.1348/000709903762869950", target="_blank"),
'suggests that this is the only procedure that is always correct in the pre-posttest design.', br()),
br(),
h3("t-test with the pretest data"),
verbatimTextOutput("t_test.out"),
verbatimTextOutput("t_effect.out"),
br(),
h3("Checking ANCOVA assumptions"),
verbatimTextOutput("levene.out"),
verbatimTextOutput("slope.out"),
p('If "Pr(>F)" is over .05 (p > .05) for both tests (pre:group for homogeneity of regression slopes), assumptions are met.',br()),
br(),
h3("ANCOVA result"),
verbatimTextOutput("ancova.res.out"),
p('If "Pr(>F) of group[name]" is below .05 (p < .05), the posttest scores for the two groups are statistically different after controling for the pretest score difference.',br()),
br(),
h3("Adjusted means of posttest scores"),
verbatimTextOutput("adj.m.out"),
plotOutput("adjustedplot"),
br(),
h3("Statistical test of adjusted means"),
verbatimTextOutput("adj.m.test.out"),
br(),
h3("Effect size of adjusted means"),
verbatimTextOutput("adj.m.effect.out"),
br(),
br(),
strong('R session info'),
verbatimTextOutput("ancova.info.out")
),
# About
tabPanel("About",
strong('Note'),
p('This web application is developed with',
a("Shiny.", href="https://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(lattice)'),br(),
code('library(ggplot2)'),br(),
code('library(compute.es)'),br(),
code('library(car)'),br(),
code('library(effects)'),br(),
code('library(multcomp)'),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, 2014).', href='http://mizumot.com/handbook/', target="_blank")),
br(),
strong('Citation in Publications'),
p('Mizumoto, A. (2015). Langtest (Version 1.0) [Web application]. Retrieved from', a("https://langtest.jp", href="https://langtest.jp", target="_blank")),
br(),
strong('Article'),
p('Mizumoto, A., & Plonsky, L. (2015). R as a lingua franca: Advantages of using R for quantitative research in applied linguistics.', em('Applied Linguistics,'),'37(2), 284–291.', a("https://academic.oup.com/applij/article-abstract/37/2/284/1742739", href="https://academic.oup.com/applij/article-abstract/37/2/284/1742739", target="_blank")),
br(),
strong('Author'),
p(a("Atsushi MIZUMOTO,", href="https://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(),
strong('License'),
br(),
a(img(src="https://mizumot.com/images/by-sa.png"), target="_blank", href="https://creativecommons.org/licenses/by-sa/4.0/deed"),
p(br())
)
)
)
))
