使用 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()
    )
)

简单的解决方案

您可以在shiny 中使用observeEvent 和renderUI。这将允许您从单独的.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/

希望这会有所帮助。