从 shiny 中的单选按钮选项中获取值 - 服务器端内置的单选按钮

Question

我正在尝试实现一个用于进行测试的应用程序。 该应用程序将依赖随机生成的数据来制定问题，在这种特殊情况下，将实施单项选择多项选择问题。 有一个触发新问题生成的动作按钮，还有一个评估所选答案的动作按钮。

这是应用程序：

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)

我面临的问题是我无法从 radioButtons (id someb ) 访问整个可用选项集，以便在最后一个 textOutput ( output$sol1 ) 中提供正确答案。 我检查了这个但是我认为这在这里没有用，因为每次激活 actionButton 时可用选项都必须更改。

任何建议一如既往地受到赞赏。

Answer 1

实现所需结果的一种选择是使用reactiveVal来存储问题数据。 为此我先添加了一个 function generate_question 。 这个 function 可以首先用于在应用程序启动时初始化reactiveVal 。 其次，我添加了一个observeEvent以在用户请求时生成一个新问题并相应地更新reactiveVal 。

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)