Блог

Я создаю блестящее приложение, и я хочу, чтобы одна из моих вкладок была викториной/игрой на 13 вопросов. Однако я не хочу, чтобы все 13 вопросов отображались сразу. Я хочу включить кнопку действия, при нажатии которой отображается следующий вопрос. В настоящее время отображаются оба вопроса. Кроме того, нужно ли мне создавать отдельные кнопки действий для каждого вопроса?

Проблема 2: В вопросах 1-5 используется один и тот же сюжет. В вопросах 6-13 будет использоваться другой сюжет, и я хочу, чтобы и вопрос, и сюжет были изменены после вопроса 5. Я привел 2 вопроса в качестве примера.

В моем сценарии пользовательского интерфейса у меня есть:

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

Возможно, пакет «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)