从shiny中的radioButton选项获取值- radioButton内置于服务器端

sycxhyv7  于 2023-02-01  发布在  其他
关注(0)|答案(1)|浏览(134)

我正在尝试实现一个测试应用程序。该应用程序将依赖于随机生成的数据来制定问题,在这个特定的例子中,实现了一个单选多选题。有一个actionButton触发新问题的生成,也有一个actionButton评估所选答案。
下面是应用程序:

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)

我面临的问题是,我无法从单选按钮(id someb)访问整个可用选项集,以便在最后一个textOutput(output$sol1)中提供正确答案。我选中了this out,但我认为这在此处没有用,因为每次激活actionButton时,可用选项都必须更改。
任何建议都将一如既往地受到欢迎。

but5z9lq

but5z9lq1#

一种实现预期结果的方法是使用reactiveVal来存储问题数据。为此,我首先添加了一个函数generate_question。该函数可以首先用于在应用程序启动时初始化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)

相关问题