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()

################################################################################ # # 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()