使用 R Shiny 创建问卷

Question

我正在尝试学习如何使用 Shiny 创建问卷。我需要每个问题都在一个新页面上。例如，当用户回答一个问题时，按下“下一步”按钮，一个新页面会加载另一个问题。关于如何做到这一点的任何想法？因为我想简化我的代码，所以我为每个问题创建了一个模块。该ui是这样的：

library(shiny)

fluidPage(
  div(class = 'container',
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Welcome!"),
          p("Lorem ipsum dolor sit amet, consectetur adipiscing elit. "),
          br(),
          actionButton("page1", "Start")
          )),
  source("questions/question1.R", local = TRUE)$value,
  source("questions/question2.R", local = TRUE)$value   
)

模块问题 1：

div(class = 'container',
    div(class = 'col-sm-2'),
    div(class = 'col-sm-8',
        radioButtons("question1", "Please select a number: ", choices = c(10,20,30)),
        actionButton("page3", "Next"),
        br()
    )
)

模块问题 2：

div(class = 'container',
    div(class = 'col-sm-2'),
    div(class = 'col-sm-8',
        radioButtons("question2", "Please select a color: ", choices = c("Blue", "Orange", "Red")),
        actionButton("page3", "Next"),
        br()
    )
)

...和server.R：

server <- function(input, output, session) {

}

因此，当用户按“开始”时，应该转到第 1 页，依此类推……谢谢！

Answer 1

我认为有几种方法可以做到这一点shiny。我将从最简单的开始，它不能完全解决问题，然后添加替代方案。

.R我按如下方式设置问题文件：

• 我的代码中的文件路径是针对windows操作系统的，根据需要更改。

模块问题 1：

div(class = 'container',
    div(class = 'col-sm-2'),
    div(class = 'col-sm-8',
        radioButtons("question1", "Please select a number: ", choices = c(10,20,30)),
        actionButton("block_two", "Next"),
        br()
    )
)

模块问题 2：

div(class = 'container',
    div(class = 'col-sm-2'),
    div(class = 'col-sm-8',
        radioButtons("question2", "Please select a color: ", choices = c("Blue", "Orange", "Red")),
        actionButton("block_three", "Next"),
        br()
    )
)

简单的解决方案

您可以在 中使用observeEvent和。这将允许您从单独的文件中提取整齐的代码块，并在用户单击“下一步”时按顺序呈现它们。renderUIshiny.R

注意：但这不会在新页面上呈现 UI 元素。

library(shiny)

ui <-  fluidPage(
  uiOutput("home"),
  uiOutput("block_one"),
  uiOutput("block_two")
)

server <- function(input, output, session) {

  output$home <- renderUI({
    div(class = 'container', id = "home",
        div(class = 'col-sm-2'),
        div(class = 'col-sm-8',
            h1("Welcome!"),
            p("Lorem ipsum dolor sit amet, consectetur adipiscing elit. "),
            br(),
            actionButton("block_one", "Start")
        ))
  })

   observeEvent(input$block_one, {
     output$block_one <- renderUI({ source("questions\\question1.R", local = TRUE)$value })
   })

  observeEvent(input$block_two, {
    output$block_two <- renderUI({ source("questions\\question2.R", local = TRUE)$value })
  })

}

shinyApp(ui, server)

复杂的解决方案

这需要您创建一个render_page函数，然后可以使用该函数在新页面上呈现这些新的 UI 组件。然后，您只需为每个组件创建一个函数并调用renderUI.

我不太喜欢这个，因为您需要创建导航按钮，然后不妨使用shinydashboard.

但是，如果您计划创建一份非常长的调查问卷，那么可以执行以下操作：

我保留了function(...)原样，以防您在渲染 UI 组件时想要传递其他参数。

library(shiny)

ui <- (htmlOutput("page"))

home <- function(...) {
  args <- list(...)
      div(class = 'container', id = "home",
          div(class = 'col-sm-2'),
          div(class = 'col-sm-8',
              h1("Welcome!"),
              p("Lorem ipsum dolor sit amet, consectetur adipiscing elit. "),
              br(),
              actionButton("block_one", "Start")
          ))

}

question_one <- function(...) {
  renderUI({ source("questions\\question1.R", local = TRUE)$value })
}

question_two <- function(...) {
  renderUI({ source("questions\\question2.R", local = TRUE)$value })
}

render_page <- function(...,f, title = "test_app") {
  page <- f(...)
  renderUI({
    fluidPage(page, title = title)
  })
}

server <- function(input, output, session) {

  ## render default page
  output$page <- render_page(f = home)

     observeEvent(input$block_one, {
       output$page <- render_page(f = question_one)
     })

     observeEvent(input$block_two, {
       output$page <- render_page(f = question_two)
     })
}

shinyApp(ui, server)

有一篇关于创建此架构的不错的 r-blogger 帖子： https://www.r-bloggers.com/some-thoughts-on-shiny-open-source-render-multiple-pages/

希望这可以帮助。