我是Shiny和R的新手，但有一些编程经验。我的最终目标是制定在线多项选择问卷并进行一些统计分析。
我目前正在尝试创建一个MCQ，为了更好地理解和学习如何使用R和Shiny我使用J Bryers代码（link to code）作为基础同时创建ui.R和server.R脚本（而不是app.R）。我最初在r-bloggers.com遇到了这个框架。我已经包含了我正在处理的代码，它给我一个错误。如果有人有时间回复，我会感谢任何帮助/建议让它运行起来。
错误是
警告：.getReactiveEnvironment（）中的错误$ currentContext：没有活动的响应上下文时不允许操作。 （你试图做一些只能在反应式表达式或观察者内部完成的事情。）堆栈跟踪（最里面的第一个）：45：。getReactiveEnvironment（）$ currentContext 44：.subset2（x，＆＃34; impl＆＃34; ）$ get 43：$ .reactivevalues 42：$ 41：粘贴40：服务器[D：\ MyShinyApps \ MCQ 2 / server.R＃150] 1：runApp
items.csv文件可以在上面的第一个链接找到。
由于
ui.R
################################################################################
#
# Create user interface
#
################################################################################
library(shiny) # load the shiny package
library(ggplot2)
# define the UI for the shiny application
shinyUI(
## if(!exists("SHOW_MCQ")) {
## fluidPage(width = 12)
## } else {
fluidPage(
# application title
titlePanel("Maths Multiple Choice Questions"),
sidebarLayout(
sidebarPanel(
h4("Multiple Choice Quiz"),
h5("Created by: Edmund Nevin"),
h5("Developed Using: Shiny R"),
p('Use the button below to start the assessment'),
uiOutput("ui"),
hr()
), # end of sidebarPanel()
mainPanel(
h3("MCQ Results"),
textOutput("maths.results")
) # end of mainPanel()
) # end of sidebarlayout()
) # end of fluidPage()
##}
) # end of shinyUI()
server.R
################################################################################
#
# Instructiuons that uses input provided by the user
#
################################################################################
library(shiny) # load the shiny package
library(ggplot2)
# read the maths questions (i.e. item stems) from file
maths.items <- read.csv("items.csv", stringsAsFactors = FALSE) # create data frame
# create a vector with the item stems
maths.stems <- list() # build a list of questions
shinyServer(
function(input, output) {
# assign variables
item.stems = maths.items$Stem # create a character vector with item stems
item.choices = maths.items[,c(4:8)] # create a data frame with item answers
itemsPerPage = 1 # set number of items per page
totalPages <- ceiling(length(item.stems) / itemsPerPage) # calculate total pages
# define reactive values
ASSESSMENT <- reactiveValues(
currentPage = 1,
responses = rep(as.integer(NA), length(item.stems))
)
# UI elements
start.label = "Start the Test" # button label
start.name = "Start Button" # start button
cancel.name = "Cancel Button" # cancel button
page.name = "Page"
# error check
stopifnot(length(item.stems) == nrow(item.choices))
# allow multiple assessments to be run by putting an object in the
# calling environment by putting "SHOW_MCQ" object in the calling
# environment
if(!exists("SHOW_MCQ", envir = parent.env(environment()))) {
assign("SHOW_MCQ", value = reactiveValues(show = FALSE, assessment = NULL,
unique = format(Sys.time(), '%Y%m%d%H%M%S')),
envir = parent.env(environment())
) # end of assign()
} # end of if statement
# start button
output$start <- renderUI({
observe({
if(!is.null(input[[paste0(start.name, SHOW_MCQ$unique)]])) {
if(input[[paste0(start.name, SHOW_MCQ$unique) == 1]]) {
SHOW_MCQ$show <- TRUE
SHOW_MCQ$assessment <- ui.name
} # end inner if statement
} # end outer if statement
}) # end observe()
actionButton(paste0(start.name, SHOW_MCQ$unique), start.label)
}) # end renderUI()
# cancel button
output$cancel <- renderUI({
observe({
if(!is.null(input[[paste0(cancel.name, SHOW_MCQ$unique)]])) {
if(input[[paste0(cancel.name, SHOW_MCQ$unique)]] == 1) {
SHOW_MCQ$show <- FALSE
SHOW_MCQ$assessment <- NULL
SHOW_MCQ$unique <- format(Sys.time(), "%Y%m%d%H%M%S")
ASSESSMENT$currentPage <- 1
ASSESSMENT$responses <- rep(as.integer(NA), length(item.stems))
} #end of inner if statement
} # end of outer if statement
}) # end observe()
actionButton(paste0(cancel.name, SHOW_MCQ$unique, "Cancel" ))
}) # end renderUI
# radio buttons
output$ui <- renderUI({
buttons <- list() # build a list of buttons
for(i in seq_len(length(item.stems))) {
choices <- character() # build a character vector of choices
for(j in 1:ncol(item.choices)) { # loop through columns
if(!is.na(item.choices[i,j])) {
choices[(j)] <- names(item.choices)[j] # populate choices vector
names(choices)[j] <- HTML(item.choices[i,j]) # mark the given text as HTML
} # end of if statement
} # end of inner for statement
button.label <- "" # clear the button label
if(is.character(item.stems)) {
button.label <- HTML(item.stems[i])
} else {
button.label <- item.stems[[i]]
}
buttons[[i]] <- radioButtons(inputId = paste0(i, SHOW_MCQ$unique),
label = button.label,
choices = choices,
inline = FALSE,
selected = character(),
width = "100%")
} # end of outer for statement
startPos <- ((ASSESSMENT$currentPage - 1) * itemsPerPage) + 1
pos <- seq(startPos, min((startPos + itemsPerPage - 1), length(buttons)))
observe({
if(SHOW_MCQ$show &
!is.null(input[[paste0(save.name, SHOW_MCQ$unique)]])
) {
if(input[[paste0(save.name, SHOW_MCQ$unique)]] == 1) {
results <- character(length(item.stems)) # build a character vector for results
for(i in seq_len(length(buttons))) {
ans <- input[[paste0(name, i, SHOW_MCQ$unique)]]
results[i] <- ifelse(is.null(ans, NA, ans))
} #end of for statement
#callback(results) # do callback
# reset for another assessment
SHOW_MCQ$show <- FALSE
SHOW_MCQ$assessment <- NULL
SHOW_MCQ$unique <- format(Sys.time(), "%Y%m%d%H%M%S")
ASSESSMENT$currentPage <- 1
ASSESSMENT$responses <- rep(as.integer(NA), length(item.stems))
} # end of inner if statement
} # end of inner if statement
}) # end of observe()
}) # end of renderUI()
# increment the page
nextButtonName <- paste("Page", ASSESSMENT$current$Page, SHOW_MCQ$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(i, SHOW_MCQ$unique)]]
ASSESSMENT$currentPage <- ASSESSMENT$currentPage + 1
nextButtonName <- paste0(page.name, ASSESSMENT$currentPage)
} # end of for statement
} # end of inner if statement
} # end of outer if statement
# Next or Done button
if(ASSESSMENT$currentPage == totalPages) {
nextButton <- ActionButton(paste0("Save", SHOW_MCQ$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)
)
)
# save the most recent assessment results to display
mcq.results <- reactiveValues(maths = logical())
# function called when assessment is completed
saveResults <- function(results) {
mcq.results$maths <- results == maths.items$Answer
} # end of function 'saveResults'
# provide some feedback to test taker
output$maths.results <- renderText({
txt <- ""
if(length(mcq.results$maths) > 0) {
txtmsg <- paste0("You got ", sum(mcq.results$math, na.rm = True,
" of ", length(mcq.results$math), " items correct."))
} else {
txtmsg <- "No results found. Please complete the MCQ."
}
return(txtmsg)
}) # end of feedback message
} # end of function
) # end of shinyServer()