R Shiny 必填字段调查表

如何解决R Shiny 必填字段调查表

我在 R Shiny 中创建了一个简单的调查表（请参阅下面的代码）。现在我想添加一些功能，在“下一步”按钮起作用之前，需要输入特定页面上的所有问题。因此，如果您在第一页按“下一步”，但没有回答前三个问题，则必须出现警告/错误消息。第二页、第三页、第四页等也是如此。这个例子有几个问题，但我的最终问卷大约有 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")
    ),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"),onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui3 <- renderUI({
    selectizeInput("select3",label = h5("Question #3"),onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui4 <- renderUI({
    selectizeInput("select4",label = h5("Question #4"),choices = sort(categories_2),multiple = TRUE,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)

解决方法

工作代码的最终结果：

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")
    ),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"),onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui3 <- renderUI({
    selectizeInput("select3",label = h5("Question #3"),onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui4 <- renderUI({
    selectizeInput("select4",label = h5("Question #4"),choices = sort(categories_2),multiple = TRUE,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)