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

希望这可以帮助。