操作按钮输入闪亮后更新单选按钮

时间:2021-04-16 03:44:05

标签: r shiny radio-button reactive action-button

我正在创建一个闪亮的应用程序,我希望我的一个标签是 13 个问题的测验/游戏。但是,我不希望一次显示所有 13 个问题。我想包含一个操作按钮,当用户按下时,会显示下一个问题。目前,这两个问题都会显示。另外,我是否需要为每个问题创建单独的操作按钮?

问题 2:问题 1-5 使用相同的情节。问题 6-13 将使用不同的情节,我希望在问题 5 之后更改问题和情节。我提供了 2 个问题作为示例。

在我的 UI 脚本中,我有:

navbarPage(
  "NEO Guess Who", position = "fixed-top",
 tabPanel("Quiz",
          fluidPage(
            titlePanel(h1("Do you even know us?")),
            sidebarLayout(
              sidebarPanel(
                radioButtons("q1", "Whose personality is plotted as the purple line?",
                         choices = list("Amy" = "Amy",
                                          "Claire" = "Claire",
                                          "Olivia" = "Olivia",
                                          "Shae" = "Shae",
                                          "Sharon" = "Sharon"),
                           selected = character(0)),
                           textOutput("q1text"),
                           actionButton("q1action", "Next", class = "btn-success"),
                radioButtons("q2", "Whose personality is plotted as the blue line?",
                             choices = list("Amy" = "Amy",
                                            "Claire" = "Claire",
                                            "Olivia" = "Olivia",
                                            "Shae" = "Shae",
                                            "Sharon" = "Sharon"),
                             selected = character(0))),
              mainPanel(
                plotOutput("plot7"))
             )))
         )

在服务器脚本中,我有:

  output$q1text <- renderText({
    q1 <- switch (input$q1,
      Amy = paste("Oops, the correct answer is Sharon"),
      Claire = paste("Oops, the correct answer is Sharon"),
      Olivia = paste("Oops, the correct answer is Sharon"),
      Shae = paste("Oops, the correct answer is Sharon"),
      Sharon = paste("Correct!"),
    )
  })

 observeEvent(input$q1action, {
   updateRadioButtons(session, "q1", choices = c("Amy", "Claire", "Olivia", "Shae", "Sharon"), selected = 0)
   updateRadioButtons(session, "q2", choices = c("Amy", "Claire", "Olivia", "Shae", "Sharon"), selected = 0)
 })
  # both questions are still displayed

  # no legend
  output$plot7 <-  renderPlot({
    {neo_simple <- read.csv("neo_simple.csv", header = T, sep = ",")}
    {neo_simple$domain <- factor(neo_simple$domain, levels = c("neuroticism", "extraversion", "openness", "agree", "conscient"))}
    
    {neoColors <-
        setNames( c('#a6cee3', '#b2df8a', '#fb9a99', '#fdbf6f', '#cab2d6'), 
                  levels(neo_simple$id)  )}
    
    neo_simple %>%
      ggplot(aes(x = domain, y=tscore, group = id, color = id)) +
      geom_point(size = 1.75) +
      scale_color_manual(values = neoColors) +
      geom_line(size = 1.25) +
      theme_bw() +
      ggtitle("NEO Domain Scores") +
      theme(plot.title = element_text(hjust = 0.5, size = 15))  +
      theme(text = element_text(size=rel(4.5))) +
      theme(legend.position = "none") +
      theme(plot.caption = element_text(hjust = 0, size = 14))
    
  }) 

1 个答案:

答案 0 :(得分:0)

也许 'slickR' 包是一种可能的方式:

library(shiny)
library(slickR)

ui <- fluidPage(
  slickROutput("questions", width = "50%")
)

server <- function(input, output, session){
  
  output[["questions"]] <- renderSlickR({
    slickR(
      slick_list(
        radioButtons(
          "q1",
          "First question",
          choices = c("Yes", "No")
        ),
        radioButtons(
          "q2",
          "Second question",
          choices = c("True", "False")
        )
      )
    )
  })
  
}

shinyApp(ui, server)