Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
ShinyAssessmentTest
From San Francisco to New York to Paris, city governments, high-class restaurants,
schools, and religious groups are ditching bottled water in favor of what comes out of the
faucet. With people no longer content to pay 1,000 times as much for bottled water, a
product no better than water from the tap, a backlash against bottled water is growing.
(5) The U.S. Conference of Mayors, which represents some 1,100 American cities,
discussed at its June 2007 meeting the irony of purchasing bottled water for city employees
and for city functions while at the same time touting1 the quality of municipal water. The
group passed a resolution sponsored by Mayors Gavin Newsom of San Francisco, Rocky
Anderson of Salt Lake City, and R. T. Rybak of Minneapolis that called for the examination
(10) of bottled water’s environmental impact. The resolution noted that with $43 billion a year
going to provide clean drinking water in cities across the country, the United States
municipal water systems are among the finest in the world.
Tap water promotional campaigns would have seemed quaint a few decades ago, when
water in bottles was a rarity. Now such endeavors are needed to counteract the pervasive2
(15) marketing that has caused consumers to lose faith in the faucet. In fact, more than a quarter
of bottled water is just processed tap water, including top-selling Aquafina and Coca-Cola’s
Dasani. When Pepsi announced in July [2007] that it would clearly label its Aquafina water
as from a “public water source,” it no doubt shocked everyone who believed that
bottles with labels depicting pristine mountains or glaciers delivered a superior product. ...
(20) With sales growing by 10 percent each year, far faster than any other beverage, bottled
water now appears to be the drink of choice for many Americans they swallow more of it
than milk, juice, beer, coffee, or tea. While some industry analysts are counting on bottled
water to beat out carbonated soft drinks to top the charts in the near future, the
burgeoning3 back-to-the-tap movement may reverse the trend.
(25) In contrast to tap water, which is delivered through an energy-efficient infrastructure,
bottled water is an incredibly wasteful product. It is usually packaged in single-serving
plastic bottles made with fossil fuels. Just manufacturing the 29 billion plastic bottles used
for water in the United States each year requires the equivalent of more than 17 million
barrels of crude oil.
(30) After being filled, the bottles may travel far. Nearly one quarter of bottled water
crosses national borders before reaching consumers, and part of the cachet4 of certain
bottled water brands is their remote origin. Adding in the Pacific Institute’s estimates for
the energy used for pumping and processing, transportation, and refrigeration, brings the
annual fossil fuel footprint of bottled water consumption in the United States to over 50
(35) million barrels of oil equivalent enough to run 3 million cars for one year. If everyone
drank as much bottled water as Americans do, the world would need the equivalent of more
than 1 billion barrels of oil to produce close to 650 billion individual bottles. ...
Slowing sales may be the wave of the future as the bottle boycott movement picks up
speed. With more than 1 billion people around the globe still lacking access to a safe and
(40) reliable source of water, the $100 billion the world spends on bottled water every year could
certainly be put to better use creating and maintaining safe public water infrastructure
everywhere.
Janet Larsen
excerpted from “Bottled Water Boycotts: Back-to-the-Tap
Movement Gains Momentum”
www.earthpolicy.org, December 7, 2007
1 touting - praising or publicizing loudly or extravagantly
2 pervasive - tends to become diffused throughout every part
3 burgeoning - growing rapidly
4 cachet - influential status
library(shiny)
library(ggplot2)
source('ShinyAssessment.R')
# Math items from: http://stattrek.com/ap-statistics/practice-test.aspx
math.items <- read.csv('items.csv', stringsAsFactors=FALSE)
mass.items <- read.csv('mass.csv', stringsAsFactors=FALSE)
read.items <- read.csv('ReadingItems.csv', stringsAsFactors=FALSE)
read.stems <- list()
read.stems[[1]] <- div(
div(includeText('2013-08-B.txt'), style="white-space: pre; word-wrap: normal;
overflow-x: auto; font-size: 11pt; padding: 10px; background: #fffff8;
border-style: solid; border-size:1px; border-color: #111111"),
p(read.items[1,]$Stem))
for(i in 2:nrow(read.items)) {
read.stems[[i]] <- p(read.items[i,]$Stem)
}
##### User Interface ###########################################################
ui <- shinyUI(fluidPage(
uiOutput('ui')
))
##### Server ###################################################################
server <- shinyServer(function(input, output, session) {
# Save the most recent assessment results to display
assmt.results <- reactiveValues(
math = logical(),
mass = integer(),
reading = logical()
)
# This function will be called when the assessment is completed.
saveResults <- function(results) {
assmt.results$math <- results == math.items$Answer
}
saveMASSResults <- function(results) {
assmt.results$mass <- factor(results,
levels = names(mass.items)[2:6],
ordered = TRUE)
}
saveReadingResults <- function(results) {
assmt.results$reading <- results == read.items$Answer
}
# Provide some basic feedback to students
output$math.results <- renderText({
txt <- ''
if(length(assmt.results$math) > 0) {
txt <- paste0('You got ', sum(assmt.results$math, na.rm=TRUE),
' of ', length(assmt.results$math), ' items correct.')
} else {
txt <- 'No results found. Please complete the statistics assessment.'
}
return(txt)
})
output$mass.results <- renderText({
txt <- ''
if(length(assmt.results$mass) == 0) {
txt <- 'No results found. Please complete the statistics assessment.'
}
return(txt)
})
output$reading.results <- renderText({
txt <- ''
if(length(assmt.results$reading) > 0) {
txt <- paste0('You got ', sum(assmt.results$reading, na.rm=TRUE),
' of ', length(assmt.results$reading), ' items correct.')
} else {
txt <- 'No results found. Please complete the reading assessment.'
}
return(txt)
})
output$mass.plot <- renderPlot({
if(length(assmt.results$mass) > 0) {
df <- data.frame(Item = mass.items$stem,
Response = assmt.results$mass)
p <- ggplot(df, aes(x=Response, y=Item)) + geom_point()
return(p)
} else {
return(NULL)
}
})
# Multiple choice test example
test <- ShinyAssessment(input, output, session,
name = 'Statistcs',
item.stems = math.items$Stem,
item.choices = math.items[,c(4:8)],
callback = saveResults,
start.label = 'Start the Statistics Assessment',
itemsPerPage = 1,
inline = FALSE)
# Likert scale example
mass <- ShinyAssessment(input, output, session,
name = 'MASS',
item.stems = mass.items$stem,
item.choices = mass.items[,2:6],
callback = saveMASSResults,
start.label = 'Take the Math Anxiety Survey',
itemsPerPage = 7,
inline = TRUE)
reading <- ShinyAssessment(input, output, session,
name = 'Reading',
item.stems = read.stems,
item.choices = read.items[,6:9],
callback = saveReadingResults,
start.label = 'Take the Reading Assessment',
itemsPerPage = 6,
inline = FALSE)
output$ui <- renderUI({
if(SHOW_ASSESSMENT$show) { # The assessment will take over the entire page.
fluidPage(width = 12, uiOutput(SHOW_ASSESSMENT$assessment))
} else { # Put other ui components here
fluidPage(
titlePanel("Shiny Assessment Example"),
sidebarLayout(
sidebarPanel(
# Show the start assessment link
h4('Example multiple choice assessment'),
p('You can use a link'),
uiOutput(test$link.name),
p('Or a button to start the assessment'),
uiOutput(test$button.name),
hr(),
h4('Reading assessment with custom stems'),
uiOutput(reading$button.name),
hr(),
h4('Example of a likert survey'),
uiOutput(mass$button.name)
),
mainPanel(
h3('Statistics Assessment Results'),
textOutput('math.results'),
hr(),
h3('Reading Assessment Results'),
textOutput('reading.results'),
hr(),
h3('Math Anxiety Survey Results'),
textOutput('mass.results'),
plotOutput('mass.plot')
)
)
)
}
})
})
##### Run the application ######################################################
shinyApp(ui = ui, server = server)
Item Stem Answer A B C D E
1 A coin is tossed three times. What is the probability that it lands on heads exactly one time? D 0.125 0.25 0.333 0.375 0.5
2 An auto analyst is conducting a satisfaction survey, sampling from a list of 10,000 new car buyers. The list includes 2,500 Ford buyers, 2,500 GM buyers, 2,500 Honda buyers, and 2,500 Toyota buyers. The analyst selects a sample of 400 car buyers, by randomly sampling 100 buyers of each brand. <br/><br/> Is this an example of a simple random sample? D Yes, because each buyer in the sample was randomly sampled. Yes, because each buyer in the sample had an equal chance of being sampled. Yes, because car buyers of every brand were equally represented in the sample. No, because every possible 400-buyer sample did not have an equal chance of being chosen. No, because the population consisted of purchasers of four different brands of car.
3 Which of the following statements is true? <br/> <br/>I. The center of a confidence interval is a population parameter. <br/>II. The bigger the margin of error, the smaller the confidence interval. <br/>III. The confidence interval is a type of point estimate. <br/>IV. A population mean is an example of a point estimate. E I only II only III only IV only None of the above.
4 A sample consists of four observations: {1, 3, 5, 7}. What is the standard deviation? B 2 2.58 6 6.67 None of the above.
5 A card is drawn randomly from a deck of ordinary playing cards. You win $10 if the card is a spade or an ace. What is the probability that you will win the game? C 1/13 13/52 4/13 17/52 None of the above.
stem Strongly Disagree Disagree Neutral Agree Strongly Agree
1. I find math interesting. Strongly Disagree Disagree Neutral Agree Strongly Agree
2. I get uptight during math tests. Strongly Disagree Disagree Neutral Agree Strongly Agree
3. I think that I will use math in the future. Strongly Disagree Disagree Neutral Agree Strongly Agree
4. Mind goes blank and I am unable to think clearly when doing my math test. Strongly Disagree Disagree Neutral Agree Strongly Agree
5. Math relates to my life. Strongly Disagree Disagree Neutral Agree Strongly Agree
6. I worry about my ability to solve math problems. Strongly Disagree Disagree Neutral Agree Strongly Agree
7. I get a sinking feeling when I try to do math problems. Strongly Disagree Disagree Neutral Agree Strongly Agree
8. I find math challenging. Strongly Disagree Disagree Neutral Agree Strongly Agree
9. Mathematics makes me feel nervous. Strongly Disagree Disagree Neutral Agree Strongly Agree
10. I would like to take more math classes. Strongly Disagree Disagree Neutral Agree Strongly Agree
11. Mathematics makes me feel uneasy. Strongly Disagree Disagree Neutral Agree Strongly Agree
12. Math is one of my favorite subjects. Strongly Disagree Disagree Neutral Agree Strongly Agree
13. I enjoy learning with mathematics. Strongly Disagree Disagree Neutral Agree Strongly Agree
14. Mathematics makes me feel confused. Strongly Disagree Disagree Neutral Agree Strongly Agree
Year Month ItemNum Answer Stem A B C D Passage
2013 August 15 D What quality of bottled water is represented in line 3 of the passage? convenience purity flavor cost 2013-08-B.txt
2013 August 16 B The resolution passed by the United States Conference of Mayors in 2007 emphasized the health benefits from imported water high quality of public water tax money gained from bottled water outstanding taste of spring water 2013-08-B.txt
2013 August 17 A The author includes the phrase "pristine mountains or glaciers delivered a superior product" (line 19) to illustrate a common misconception shared goal lasting impression basic condition 2013-08-B.txt
2013 August 18 B What is the primary focus of lines 32 through 35? consumer cost foreign influence national debt environmental impact 2013-08-B.txt
2013 August 19 C The author?s comparison of tap water to bottled water illustrates that bottled water is "clean drinking water" (line 11) "'the finest in the world'" (line 12) "incredibly wasteful" (line 26) "the wave of the future" (line 38) 2013-08-B.txt
2013 August 20 A The author develops the passage primarily through the use of factual evidence cause and effect descriptive narrative question and answer 2013-08-B.txt
#' Create Shiny UI for multiple choice assessment.
#'
#'
#' NOTE: This function will create an object \code{SHOW_ASSESSMENT} in the
#' calling environment. This object is used to determine whether the assessment
#' should be shown or not. This object will be shared across multiple
#' \code{ShinyAssessment} instances.
#'
#' @param input from \code{shinyServer}.
#' @param output from \code{shinyServer}.
#' @param session from \code{shinyServer}.
#' @param name the name of the assessment. This should be a name that follows
#' R's naming rules (i.e. does not start with a number, no spaces, etc).
#' @param callback function called when the user submits the assessment. Used
#' for saving the results.
#' @param item.stems a character vector or list with the item stems. If a list,
#' any valid Shiny output is allowed (e.g. \code{p}, \code{div},
#' \code{fluidRow}, etc.). For character vectors HTML is allowd.
#' @param item.choices a data frame with the item answers. For items that have
#' fewer choices than the total number of
#' columns, place \code{NA} in that column's value. The results will be
#' passed to the \code{callback} function as named list where the value
#' is the name of the column selected.
#' @param start.label The label used for the link and button created to start
#' the assessment.
#' @param itemsPerPage the number of items to display per page.
#' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally).
#' @param width The width of the radio button input.
#' @param cancelButton should a cancel button be displayed on the assessment.
#' @return Returns a list with the following values:
#' \itemize{
#' \item{ui.name}{the name of the UI put on the output object for the items.}
#' \item{link.name}{the name of the UI element for the start assessment link.}
#' \item{button.name}{the name of the UI element for the start assessment button.}
#' }
#' @export
ShinyAssessment <- function(input, output, session,
name, callback,
item.stems, item.choices,
start.label = 'Start the Assessment',
itemsPerPage = 1,
inline = FALSE,
width = '100%',
cancelButton = TRUE
) {
stopifnot(length(item.stems) == nrow(item.choices))
if(!exists('SHOW_ASSESSMENT', envir = parent.env(environment()))) {
# A bit of a hack and knowingly bad form. This will put an object in
# the calling environment. This will allow for multiple asssessments
# to be run in the same Shiny app.
assign('SHOW_ASSESSMENT',
value = reactiveValues(show = FALSE, assessment = NULL,
unique = format(Sys.time(), '%Y%m%d%H%M%S')),
envir = parent.env(environment())
)
}
ASSESSMENT <- reactiveValues(
currentPage = 1,
responses = rep(as.integer(NA), length(item.stems))
)
# Names of various UI elements. Note that for radio, next, cancel, and done
# buttons the name has SHOW_ASSESSMENT$unique concatenated, which is the
# current time in seconds when the assessment was started. This ensures that
# a unique set of buttons are created for each assessment. Otherwise, answers
# would be carried over from prior assessments. This is especially problematic
# since the buttons remain in the session but previous responses not shown
# to the user.
link.name <- paste0('Start', name, 'Link')
button.name <- paste0('Start', name, 'Button')
cancel.name <- paste0('Cancel', name, 'Button')
ui.name <- paste0(name, 'Items')
save.name <- paste0(name, 'Save')
page.name <- paste0(name, 'Page')
totalPages <- ceiling(length(item.stems) / itemsPerPage)
output[[link.name]] <- renderUI({
observe({
if(!is.null(input[[paste0(link.name, SHOW_ASSESSMENT$unique)]])) {
if(input[[paste0(link.name, SHOW_ASSESSMENT$unique)]] == 1) {
SHOW_ASSESSMENT$show <- TRUE
SHOW_ASSESSMENT$assessment <- ui.name
}
}
})
actionLink(paste0(link.name, SHOW_ASSESSMENT$unique), start.label)
})
output[[button.name]] <- renderUI({
observe({
if(!is.null(input[[paste0(button.name, SHOW_ASSESSMENT$unique)]])) {
if(input[[paste0(button.name, SHOW_ASSESSMENT$unique)]] == 1) {
SHOW_ASSESSMENT$show <- TRUE
SHOW_ASSESSMENT$assessment <- ui.name
}
}
})
actionButton(paste0(button.name, SHOW_ASSESSMENT$unique), start.label)
})
output[[cancel.name]] <- renderUI({
observe({
if(!is.null(input[[paste0(cancel.name, SHOW_ASSESSMENT$unique)]])) {
if(input[[paste0(cancel.name, SHOW_ASSESSMENT$unique)]] == 1) {
# TODO: Should the callback function be called with the
# incomplete results?
SHOW_ASSESSMENT$show <- FALSE
SHOW_ASSESSMENT$assessment <- NULL
SHOW_ASSESSMENT$unique <- format(Sys.time(), '%Y%m%d%H%M%S')
ASSESSMENT$currentPage <- 1
ASSESSMENT$responses <- rep(as.integer(NA), length(item.stems))
}
}
})
actionButton(paste0(cancel.name, SHOW_ASSESSMENT$unique), 'Cancel')
})
output[[ui.name]] <- renderUI({
# Build a list of radioButtons for each item.
buttons <- list()
for(i in seq_len(length(item.stems))) {
choices <- character()
for(j in 1:ncol(item.choices)) {
if(!is.na(item.choices[i,j])) {
choices[(j)] <- names(item.choices)[j]
names(choices)[(j)] <- HTML(item.choices[i,j])
}
}
button.label <- ''
if(is.character(item.stems)) {
button.label <- HTML(item.stems[i])
} else {
button.label <- item.stems[[i]]
}
buttons[[i]] <- radioButtons(inputId = paste0(name, i, SHOW_ASSESSMENT$unique),
label = button.label,
choices = choices,
inline = inline,
selected = character(),
width = width)
}
startPos <- ((ASSESSMENT$currentPage - 1) * itemsPerPage) + 1
pos <- seq(startPos, min( (startPos + itemsPerPage - 1), length(buttons)))
observe({
# Save the results
if(SHOW_ASSESSMENT$show &
!is.null(input[[paste0(save.name, SHOW_ASSESSMENT$unique)]])
) {
if(input[[paste0(save.name, SHOW_ASSESSMENT$unique)]] == 1) {
results <- character(length(item.stems))
for(i in seq_len(length(buttons))) {
ans <- input[[paste0(name, i, SHOW_ASSESSMENT$unique)]]
results[i] <- ifelse(is.null(ans), NA, ans)
}
# Do callback
callback(results)
# Reset for another assessment
SHOW_ASSESSMENT$show <- FALSE
SHOW_ASSESSMENT$assessment <- NULL
SHOW_ASSESSMENT$unique <- format(Sys.time(), '%Y%m%d%H%M%S')
ASSESSMENT$currentPage <- 1
ASSESSMENT$responses <- rep(as.integer(NA), length(item.stems))
}
}
})
# Increment the page
nextButtonName <- paste(page.name, ASSESSMENT$currentPage, SHOW_ASSESSMENT$unique)
if(!is.null(input[[nextButtonName]])) {
if(input[[nextButtonName]] == 1) {
for(i in seq( ((ASSESSMENT$currentPage - 1) * itemsPerPage) + 1,
ASSESSMENT$currentPage * itemsPerPage, by=1) ) {
ans <- input[[paste0(name, i, SHOW_ASSESSMENT$unique)]]
ASSESSMENT$responses[i] <- ifelse(is.null(ans), NA, ans)
}
ASSESSMENT$currentPage <- ASSESSMENT$currentPage + 1
nextButtonName <- paste0(page.name, ASSESSMENT$currentPage)
}
}
# Next or Done button
if(ASSESSMENT$currentPage == totalPages) {
nextButton <- actionButton(paste0(save.name, SHOW_ASSESSMENT$unique), 'Done')
} else {
nextButton <- actionButton(nextButtonName, 'Next')
}
mainPanel(width=12,
br(),
buttons[pos],
br(),
fluidRow(
column(width=2, uiOutput(cancel.name)),
column(width=8, p(paste0('Page ', ASSESSMENT$currentPage, ' of ', totalPages)),
align='center'),
column(width=2, nextButton)
)
)
})
return(list(ui.name = ui.name,
link.name = link.name,
button.name = button.name
))
}

Nice idea 👍. You may also find the mirtCAT package useful, which is something very similar with shiny that is for IRT-based computerized adaptive tests (https://github.com/philchalmers/mirtCAT). There's some exposure to internal functions, so if you feel like using some of the low-level functions (like findNextItem()) feel free. Cheers.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment