R Shiny强制性现场调查表

Question

我在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")
),
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)