R 闪亮必填字段调查表

Question

我在 R Shiny 中创建了一个简单的调查表（见下面的代码）。现在我想添加一些功能，需要在 'Next' 按钮工作之前输入特定页面上的所有问题。因此，如果您在第一页上按 'next'，但没有回答前三个问题，则一定会出现 alert/error 消息。第二页、第三页、第四页等也是如此。这个例子有几个问题，但我的最终问卷大约有 15-20 个问题。

如果有人能帮帮我就好了！

library(shiny)
library(shinyjs)

NUM_PAGES = 3

categories_1 <- c('a', 'b', 'c', 'd') 
categories_2 <- c('e', 'f', 'g', 'h')


ui <- fluidPage(
  useShinyjs(),
  hidden(
    div(
      class = "page",
      id = "page1",
      uiOutput("ui1"),
      uiOutput("ui2"),
      uiOutput("ui3")
    ),
    div(
      class = "page",
      id = "page2",
      uiOutput("ui4")
    ),
    div(
      class = "page",
      id = "page3",
      actionButton("submit", "Submit")
    )
  ),
  br(),
  actionButton("prevBtn", "< Previous"),
  actionButton("nextBtn", "Next >")
)

server <- function(input, output, session) {
  rv <- reactiveValues(page = 1)
  
  output$ui1 <- renderUI({
    selectizeInput("select1", label = h5("Question #1"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui2 <- renderUI({
    selectizeInput("select2", label = h5("Question #2"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui3 <- renderUI({
    selectizeInput("select3", label = h5("Question #3"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui4 <- renderUI({
    selectizeInput("select4", label = h5("Question #4"),
                   choices = sort(categories_2),
                   multiple = TRUE,
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  observe({
    toggleState(id = "prevBtn", condition = rv$page > 1)
    toggleState(id = "nextBtn", condition = rv$page < NUM_PAGES)
    hide(selector = ".page")
    show(
      paste0("page", rv$page)
    )
    
  })
  
  navPage <- function(direction) {
    rv$page <- rv$page + direction
  }
  
  observeEvent(input$prevBtn, navPage(-1))
  observeEvent(input$nextBtn, navPage(1))
  
  # Automatically stop a Shiny app when closing the browser tab
  session$onSessionEnded(stopApp)
}

shinyApp(ui, server)

Answer 1

工作代码的最终结果：

library(shiny)
library(shinyjs)
library(shinyFeedback)

NUM_PAGES = 3

categories_1 <- c('a', 'b', 'c', 'd') 
categories_2 <- c('e', 'f', 'g', 'h')


ui <- fluidPage(
  useShinyjs(),
  shinyFeedback::useShinyFeedback(),
  hidden(
    div(
      class = "page",
      id = "page1",
      uiOutput("ui1"),
      uiOutput("ui2"),
      uiOutput("ui3")
    ),
    div(
      class = "page",
      id = "page2",
      uiOutput("ui4")
    ),
    div(
      class = "page",
      id = "page3",
      actionButton("submit", "Submit")
    )
  ),
  br(),
  actionButton("prevBtn", "< Previous"),
  actionButton("nextBtn", "Next >")
)

server <- function(input, output, session) {
  rv <- reactiveValues(page = 1)
  
  output$ui1 <- renderUI({
    selectizeInput("select1", label = h5("Question #1"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui2 <- renderUI({
    selectizeInput("select2", label = h5("Question #2"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui3 <- renderUI({
    selectizeInput("select3", label = h5("Question #3"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui4 <- renderUI({
    selectizeInput("select4", label = h5("Question #4"),
                   choices = sort(categories_2),
                   multiple = TRUE,
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  observe({
    toggleState(id = "prevBtn", condition = rv$page > 1)
    toggleState(id = "nextBtn", condition = rv$page < NUM_PAGES)
    hide(selector = ".page")
    show(
      paste0("page", rv$page)
    )
    
  })
  
  navPage <- function(direction) {
    rv$page <- rv$page + direction
  }
  
  observeEvent(input$prevBtn, navPage(-1))
  observeEvent(input$nextBtn, 
               if(rv$page==1 & "" %in% list(input$select1, input$select2, input$select3)){
                 feedbackDanger("select1", input$select1 == "", "Please make decision")
                 feedbackDanger("select2", input$select2 == "", "Please make decision")
                 feedbackDanger("select3", input$select3 == "", "Please make decision")
               } else {navPage(1)})
  
  # Automatically stop a Shiny app when closing the browser tab
  session$onSessionEnded(stopApp)
}

shinyApp(ui, server)

R 闪亮必填字段调查表

R Shiny Mandatory Fields Survey Form

r

shiny

shinyjs

rshiny