getting values from radioButtons choices in shiny - radioButton built in server side

Question

I am trying to implement an app for making a test. The app will relay on a random generation of data on which the questions are formulated and, in this particular case a single choice multiple selection question is implemented. There is an actionButton that triggers the generation of new questions and also an actionButton which evaluates the selected answer.

Here is the app:

library(pacman)
p_load(here)
p_load(tidyverse)
p_load(shiny)
p_load(plotly)
p_load(stringi)

##########################################################
### generate the questions with its evaluations
### a random sample of these will be used in the app

lore<-stri_rand_lipsum(1, start_lipsum = TRUE)

questions<-substring(lore, seq(1, nchar(lore), 25), seq(25, nchar(lore), 25)) %>% {.[1:10]}

dic<-data.frame(id=letters[1:10],quest=questions,out=sample(c(T,F),10,replace = T))
##########################################################

ui <- fluidPage(
  titlePanel("exam test"),
  sidebarLayout(
    sidebarPanel(
      actionButton("sim",label ="generate questions"),
      uiOutput('resetable_input'),
      actionButton("run",label ="evaluate")
    ),
    mainPanel(
      h3("you selected"),
      textOutput("ans1"),
      h3("correct?"),
      textOutput("eval1"),
      h3("the answer is"),
      textOutput("sol1")
    )
  )
)


server <- function(input, output, session){

### build radioButtons based on a sample from dic df.
  output$resetable_input <- renderUI({
    times <- input$sim
    temp_ind<- c( sample(which(dic$out),1),sample(which(!dic$out),3) )
    temp_ind<-sample(temp_ind)
    div(id=letters[(times %% length(letters)) + 1],
        radioButtons("someb","Lorem ipsum dolor sit amet?",choiceNames=dic[temp_ind,"quest"],choiceValues=dic[temp_ind,"id"])
    )
  })
  
  res_react<-eventReactive(
    input$run,{
      list(sel=dic[which(dic[,"id"]==input$someb),"quest"],
           eval1=dic[which(dic[,"id"]==input$someb),"out"],
### here I don't know how to get the correct answer to display
           sol="?")
    }
  )
  
  output$ans1 <- renderText({ res_react()[["sel"]] })
  output$eval1 <- renderText({ res_react()[["eval1"]] })
  output$sol1 <- renderText({ res_react()[["sol"]] })
}
shinyApp(ui = ui, server = server)

The problem that I am facing is that I cannot get access to the whole set of available options from the radioButtons (id someb) in order to provide the correct answer in the last textOutput (output$sol1). I checked this out however I don't think this could be useful here since the available options must change each time the actionButton is activated.

Any advice is appreciated as always.

Answer 1

One option to achieve your desired result would be to use a reactiveVal to store the question data. To this end I first added a function generate_question. This function could first be used to init the reactiveVal when the app starts. Second, I added an observeEvent to generate a new question if the user requests so and updates the reactiveVal accordingly.

library(stringi)
library(shiny)

set.seed(123)

lore <- stri_rand_lipsum(1, start_lipsum = TRUE)

questions <- substring(lore, seq(1, nchar(lore), 25), seq(25, nchar(lore), 25))[1:10]

dic <- data.frame(id = letters[1:10], quest = questions, out = sample(c(T, F), 10, replace = T))

ui <- fluidPage(
  titlePanel("exam test"),
  sidebarLayout(
    sidebarPanel(
      actionButton("sim", label = "generate questions"),
      uiOutput("resetable_input"),
      actionButton("run", label = "evaluate")
    ),
    mainPanel(
      h3("you selected"),
      textOutput("ans1"),
      h3("correct?"),
      textOutput("eval1"),
      h3("the answer is"),
      textOutput("sol1")
    )
  )
)

generate_question <- function() {
  answers <- sample(c(sample(which(dic$out), 1), sample(which(!dic$out), 3)))
  dic[answers, ]
}

server <- function(input, output, session) {
  question <- reactiveVal(generate_question())

  observeEvent(input$sim, {
    question(generate_question())
  })

  output$resetable_input <- renderUI({
    req(question())
    
    div(
      id = "quest",
      radioButtons("someb", "Lorem ipsum dolor sit amet?",
        choiceNames = question()[["quest"]],
        choiceValues = question()[["id"]]
      )
    )
  })

  res_react <- eventReactive(
    input$run,
    {
      list(
        sel = question()[question()$id == input$someb, "quest"],
        eval1 = question()[question()$id == input$someb, "out"],
        sol = question()[question()$out, "quest"]
      )
    }
  )

  output$ans1 <- renderText({
    res_react()[["sel"]]
  })
  output$eval1 <- renderText({
    res_react()[["eval1"]]
  })
  output$sol1 <- renderText({
    res_react()[["sol"]]
  })
}
shinyApp(ui = ui, server = server)