library(shiny)
library(shinyAce)
library(psych)
library(beeswarm)
shinyServer(function(input, output) {
bs <- reactive({
if (input$colname == 0) {
x <- read.csv(text=input$text, header=FALSE, sep="", na.strings=c("","NA","."))
x <- as.matrix(x)
describe(x)[2:13]
} else {
x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
describe(x)[2:13]
}
})
output$textarea.out <- renderPrint({
bs()
})
testnorm <- reactive({
if (input$colname == 0) {
dat <- read.csv(text=input$text, header=FALSE, sep="", na.strings=c("","NA","."))
datframe <- data.frame(Var=character(length(dat)), KS=numeric(length(dat)), Shapiro=numeric(length(dat)), stringsAsFactors=F)
for(i in 1:length(dat)){
suppressWarnings({
datframe$Var[i] <- colnames(dat)[i]
k <- ks.test(scale(dat[,i]), "pnorm")
datframe$KS[i] <- round(k$p.value, 3)
s <- shapiro.test(dat[,i])
datframe$Shapiro[i] <- round(s$p.value, 3)
})
}
datframe
} else {
dat <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
datframe <- data.frame(Var=character(length(dat)), KS=numeric(length(dat)), Shapiro=numeric(length(dat)), stringsAsFactors=F)
for(i in 1:length(dat)){
suppressWarnings({
datframe$Var[i] <- colnames(dat)[i]
k <- ks.test(scale(dat[,i]), "pnorm")
datframe$KS[i] <- round(k$p.value, 3)
s <- shapiro.test(dat[,i])
datframe$Shapiro[i] <- round(s$p.value, 3)
})
}
datframe
}
})
output$testnorm.out <- renderPrint({
testnorm()
})
makeboxPlot <- function(){
if (input$colname == 0) {
dat <- read.csv(text=input$text, header=FALSE, sep="", na.strings=c("","NA","."))
} else {
dat <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
}
boxplot(dat, las=1, xlab= "Means and +/-1 SDs are displayed in red.")
beeswarm(dat, col = 4, pch = 16, vert = TRUE, add = TRUE)
for (i in 1:ncol(dat)) {
pts <- 0.2 + i
mns <- mean(dat[,i], na.rm=TRUE)
sds <- sd(dat[,i], na.rm=TRUE)
points(pts, mns, pch = 18, col = "red", cex = 2)
arrows(pts, mns, pts, mns + sds, length = 0.1, angle = 45, col = "red")
arrows(pts, mns, pts, mns - sds, length = 0.1, angle = 45, col = "red")
}
}
output$boxPlot <- renderPlot({
print(makeboxPlot())
})
correl <- reactive({
if (input$colname == 0) {
# x <- read.table(text=input$text, sep="", na.strings=c("","NA","."))
x <- read.table(text=input$text, sep="\t")
x <- as.matrix(x)
type <- switch(input$method,
Pearson = "pearson",
Spearman = "spearman",
Kendall = "kendall")
round(cor(cbind(x), method = type, use = "pairwise.complete.obs"),3)
} else {
# x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
x <- read.csv(text=input$text, sep="\t")
type <- switch(input$method,
Pearson = "pearson",
Spearman = "spearman",
Kendall = "kendall")
round(cor(cbind(x), method = type, use = "pairwise.complete.obs"),3)
}
})
output$correl.out <- renderPrint({
correl()
})
ci <- reactive({
if (input$colname == 0) {
#x <- read.csv(text=input$text, header=FALSE, sep="", na.strings=c("","NA","."))
x <- read.csv(text=input$text, header=FALSE, sep="\t")
} else {
# x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
x <- read.csv(text=input$text, sep="\t")
}
type <- switch(input$method,
Pearson = "pearson",
Spearman = "spearman",
Kendall = "kendall")
ci.all <- function(x) {
for (i in 1:length(x)) {
for (j in 1:length(x)) {
if (i >= j) {
next
} else {
r <- cor(x[,i], x[,j], method = type, use = "complete")
n <- length(x[,1])
pvl <- cor.test(x[,i], x[,j], method = type)
if (input$method == "Kendall") {
# [Kendall CI] http://www.stat.umn.edu/geyer/5601/examp/corr.html
conf.level <- 0.95
signs <- sign(outer(x[,i], x[,i], "-") * outer(x[,j], x[,j], "-"))
tau <- mean(signs[lower.tri(signs)])
cvec <- apply(signs, 1, sum)
nn <- length(cvec)
sigsq <- (2 / (nn * (nn - 1))) *
(((2 * (nn - 2)) / (nn * (nn - 1))) * var(cvec)
+ 1 - tau^2)
zcrit <- qnorm((1 + conf.level) / 2)
ci <- tau + c(-1, 1) * zcrit * sqrt(sigsq)
} else {
ci <- round(r.con(r, n), 3)
# [Spearman CI] http://www.statsdirect.com/help/default.htm#nonparametric_methods/spearman.htm
}
if (input$method == "Pearson") {
cortype <- c("Pearson's r =")
} else if (input$method == "Spearman") {
cortype <- c("Spearman's ρ =")
} else {
cortype <- c("Kendall's τ =")
}
cat("----------", "\n",
"Correlation between", colnames(x)[i], "&", colnames(x)[j], ":", "\n",
cortype, round(r, 3), "\n",
"95% CI [lower, upper] =", round(ci, 3), "\n",
"p-value =", round(pvl$p.value, 3), "\n",
"\n")
}
}
}
}
ci.all(x)
})
output$ci.out <- renderPrint({
ci()
})
makecorPlot <- function(){
if (input$colname == 0) {
#x <- read.table(text=input$text, sep="", na.strings=c("","NA","."))
x <- read.table(text=input$text, sep="\t")
x <- as.matrix(x)
type <- switch(input$method,
Pearson = "pearson",
Spearman = "spearman",
Kendall = "kendall")
pairs.panels(x, method = type)
} else {
# x <- read.csv(text=input$text, sep="", na.strings=c("","NA","."))
x <- read.csv(text=input$text, sep="\t")
type <- switch(input$method,
Pearson = "pearson",
Spearman = "spearman",
Kendall = "kendall")
pairs.panels(x, method = type)
}
}
output$corPlot <- renderPlot({
print(makecorPlot())
})
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()
})
})
library(shiny)
library(shinyAce)
shinyUI(bootstrapPage(
headerPanel("Correlation"),
########## Adding 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")),
########## Added up untill here ##########
mainPanel(
tabsetPanel(
tabPanel("Main",
strong('Option:'),
checkboxInput("colname", label = strong("The data includes variable names in the first row."), value = T),
# br(),
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;'>Missing values should be indicated by a period (.) or NA.</div></b>")),
aceEditor("text", value="Test.A\tTest.B\n67\t70\n56\t68\n55\t66\n89\t77\n90\t100\n92\t60\n44\t55\n36\t44\n88\t76\n47\t55\n44\t45\n46\t88\n90\t88\n88\t78\n77\t89\n21\t33\n78\t87\n80\t67\n66\t87\n44\t57",
mode="r", theme="terminal"),
br(),
h3("Basic statistics"),
verbatimTextOutput("textarea.out"),
br(),
h3("Test of normality"),
verbatimTextOutput("testnorm.out"),
p('KS: Kolmogorov-Smirnov test (N > 30)', br(),
'Shapiro: Shapiro-Wilk normality test (N < 50).',br(),
'The numbers in the table represent p-values.',br(),
'The normality assumption is met if p > .05.',br()),
br(),
h3("Box plots with individual data points"),
plotOutput("boxPlot", width="80%"),
br(),
h3("Correlation"),
radioButtons("method", "Check the type of correlation coefficients:",
list("Pearson product-moment correlation coefficient" = "Pearson",
"Spearman's rank correlation coefficient (Spearman's rho)" = "Spearman",
"Kendall tau rank correlation coefficient (Kendall's tau)" = "Kendall")),
verbatimTextOutput("correl.out"),
br(),
h4("95% confidence interval (CI)"),
verbatimTextOutput("ci.out"),
br(),
h3("Scatter plot matrices"),
plotOutput("corPlot"),
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(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/cor', 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("cor","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/"),
p(br())
)
))
))