library(shiny)
library(shinyAce)
library(ggplot2)
library(tidyr)
library(dplyr)
library(beeswarm)
library(gridExtra)
library(rpivotTable)
shinyServer(function(input, output) {
getData <- reactive({
read.csv(text=input$text, header = TRUE, sep="\t", na.strings=c("","NA","."))
})
vartype <- reactive({
dat <- getData()
sapply(dat, class)
})
output$vartype.out <- renderPrint({
vartype()
})
missing <- reactive({
dat <- getData()
fin <- function(obj){
sapply(obj, FUN = function(x) all(is.finite(x)))
}
num <- function(obj){
sapply(obj, FUN = function(x) all(is.numeric(x)))
}
res <- data.frame(fin(dat), num(dat))
colnames(res) <- c("Finite (FALSE=Missing Value)", "Numeric (FALSE=Non-numeric)")
res
})
output$textarea.out <- renderPrint({
missing()
})
min.max <- reactive({
dat <- getData()
summary(dat, digits = 1)
})
output$min.max.out <- renderPrint({
min.max()
})
tabPlot <- function(){
dat <- getData()
plot_list <- list()
for(col_name in names(dat)) {
col_data <- dat[[col_name]]
if(is.numeric(col_data)) {
p <- ggplot(data.frame(x = col_data), aes(x = x)) +
geom_histogram(fill = "steelblue", color = "white", bins = 15, na.rm = TRUE) +
labs(title = col_name, x = "", y = "Count") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
} else {
freq_table <- as.data.frame(table(col_data, useNA = "ifany"))
colnames(freq_table) <- c("Category", "Count")
p <- ggplot(freq_table, aes(x = reorder(Category, -Count), y = Count)) +
geom_bar(stat = "identity", fill = "coral", color = "white") +
geom_text(aes(label = Count), vjust = -0.3, size = 3) +
labs(title = col_name, x = "", y = "Count") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))
}
plot_list[[col_name]] <- p
}
n_plots <- length(plot_list)
n_cols <- min(3, n_plots)
do.call(gridExtra::grid.arrange, c(plot_list, ncol = n_cols))
}
output$tabPlot <- renderPlot({
tabPlot()
}, height = function() {
dat <- getData()
n_vars <- ncol(dat)
n_rows <- ceiling(n_vars / 3)
max(400, n_rows * 250)
})
# Pivot Table
output$pivotTable <- renderRpivotTable({
dat <- getData()
rpivotTable(dat, rows = names(dat)[1], cols = names(dat)[2],
aggregatorName = "Count", vals = "")
})
output$varselect <- renderUI({
dat <- getData()
num_cols <- sapply(dat, is.numeric)
cols <- names(dat)[num_cols]
selectInput("vars", "Click the box below and select variables:", choices=cols, multiple=T)
})
makeboxPlot <- function(){
if (is.null(input$vars)){
NULL
} else {
dat <- getData()
dat <- data.frame(dat[,input$vars])
colnames(dat) <- input$vars
boxplot(dat, las=1, xlab= "Means and +/-1 SDs are displayed in red.")
if (input$beeswarm != 0) {
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())
})
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)
library(rpivotTable)
shinyUI(bootstrapPage(
headerPanel("Screening Data"),
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(
tabPanel("Main",
p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>The editor below only accepts tab-separated values copied and pasted from Excel/Numbers. </div></b>")),
aceEditor("text", value="Group\tGender\tAbility\tPre\tPost\nA\tMale\t130\t29\t36\nA\tMale\t152\t37\t35\nA\tMale\t148\t29\t41\nA\tMale\t\t47\t52\nA\tMale\t122\t29\t41\nA\tMale\t126\t17\t35\nA\tMale\t122\t33\t35\nA\tMale\t150\t32\t48\nA\tMale\t148\t34\t39\nA\tMale\t124\t35\t34\nA\tMale\t136\t11\t18\nA\tMale\t128\t29\t48\nA\tMale\t132\t44\t45\nA\tMale\t\t39\t43\nA\tMale\t144\t30\t38\nA\tMale\t130\t36\t27\nA\tMale\t128\t30\t24\nA\tMale\t132\t28\t37\nA\tMale\t124\t38\t38\nA\tMale\t130\t28\t28\nA\tMale\t130\t46\t46\nA\tFemale\t136\t43\t38\nA\tFemale\t\t28\t33\nA\tFemale\t120\t45\t46\nA\tFemale\t138\t28\t24\nA\tFemale\t120\t14\t27\nA\tFemale\t152\t50\t49\nA\tFemale\t136\t30\t30\nA\tFemale\t140\t27\t46\nA\tFemale\t134\t47\t54\nA\tFemale\t122\t32\t38\nA\tFemale\t134\t37\t34\nA\tFemale\t152\t34\t47\nA\tFemale\t90\t26\t32\nA\tFemale\t144\t36\t34\nA\tFemale\t\t27\t38\nA\tFemale\t130\t26\t32\nA\tFemale\t128\t38\t38\nA\tFemale\t140\t38\t37\nA\tFemale\t148\t27\t32\nA\tFemale\t146\t38\t38\nA\tFemale\t134\t29\t32\nB\tMale\t148\t37\t49\nB\tMale\t134\t29\t35\nB\tMale\t102\t22\t31\nB\tMale\t118\t19\t43\nB\tMale\t136\t36\t41\nB\tMale\t152\t35\t53\nB\tMale\t126\t17\t22\nB\tMale\t126\t26\t21\nB\tMale\t136\t41\t51\nB\tMale\t148\t25\t37\nB\tMale\t114\t37\t51\nB\tMale\t128\t38\t47\nB\tMale\t128\t33\t50\nB\tMale\t110\t29\t40\nB\tMale\t128\t30\t37\nB\tMale\t\t23\t40\nB\tMale\t140\t33\t44\nB\tMale\t132\t15\t29\nB\tMale\t124\t32\t40\nB\tMale\t146\t25\t43\nB\tMale\t150\t32\t44\nB\tFemale\t148\t35\t42\nB\tFemale\t138\t27\t40\nB\tFemale\t128\t36\t42\nB\tFemale\t126\t31\t35\nB\tFemale\t138\t24\t37\nB\tFemale\t134\t31\t41\nB\tFemale\t136\t21\t34\nB\tFemale\t134\t28\t40\nB\tFemale\t122\t31\t41\nB\tFemale\t130\t35\t44\nB\tFemale\t142\t31\t34\nB\tFemale\t122\t35\t41\nB\tFemale\t138\t35\t41\nB\tFemale\t140\t36\t45\nB\tFemale\t128\t23\t47\nB\tFemale\t142\t34\t45\nB\tFemale\t140\t44\t50\nB\tFemale\t112\t40\t36\nB\tFemale\t128\t26\t38\nC\tMale\t126\t16\t35\nC\tMale\t\t27\t34\nC\tMale\t96\t20\t23\nC\tMale\t122\t27\t23\nC\tMale\t118\t14\t14\nC\tMale\t134\t26\t41\nC\tMale\t94\t20\t20\nC\tMale\t144\t31\t30\nC\tMale\t112\t30\t43\nC\tMale\t126\t22\t24\nC\tMale\t146\t37\t43\nC\tMale\t128\t36\t34\nC\tMale\t134\t26\t39\nC\tMale\t128\t30\t34\nC\tMale\t116\t15\t20\nC\tMale\t116\t28\t33\nC\tMale\t140\t24\t29\nC\tMale\t152\t39\t41\nC\tMale\t134\t29\t36\nC\tMale\t\t19\t23\nC\tMale\t130\t34\t27\nC\tFemale\t132\t21\t35\nC\tFemale\t104\t12\t15\nC\tFemale\t110\t30\t39\nC\tFemale\t130\t18\t31\nC\tFemale\t126\t25\t38\nC\tFemale\t118\t21\t36\nC\tFemale\t98\t16\t26\nC\tFemale\t126\t33\t43\nC\tFemale\t100\t28\t36\nC\tFemale\t134\t32\t32\nC\tFemale\t122\t35\t29\nC\tFemale\t134\t20\t20\nC\tFemale\t144\t36\t38\nC\tFemale\t\t16\t24\nC\tFemale\t126\t37\t39\nC\tFemale\t120\t29\t21\nC\tFemale\t142\t20\t21\nC\tFemale\t132\t24\t22\nC\tFemale\t122\t26\t32\nC\tFemale\t138\t37\t27",
mode="r", theme="cobalt"),
br(),
h3("Type of variables"),
verbatimTextOutput("vartype.out"),
br(),
h3("Checking missing/non-numeric values"),
verbatimTextOutput("textarea.out"),
br(),
h3("Summary of the data"),
verbatimTextOutput("min.max.out"),
br(),
h3("Visualisation of multivariate datasets"),
plotOutput("tabPlot", width="100%"),
br(),
br(),
h3("Boxplot (applicable for numeric values only)"),
uiOutput("varselect"),
checkboxInput("beeswarm", label = strong("Plot individual data points."), value = T),
plotOutput("boxPlot"),
br(),
br(),
strong('R session info'),
verbatimTextOutput("info.out")
),
tabPanel("Pivot Table",
h2("Interactive Pivot Table"),
p("Drag and drop variables to rows/columns to create cross-tabulations."),
rpivotTableOutput("pivotTable", width = "100%", height = "600px")
),
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(rpivotTable)'),br(),
code('library(ggplot2)'),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/screenData', target="_blank")),
br(),
strong('Citation in Publications'),
p('Mizumoto, A. (2015). Langtest (Version 1.0) [Web application]. Retrieved from http://langtest.jp'),
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())
)
))
))
