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

...和服务器。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/

希望这会有所帮助。

用R Shiny创建问卷

1 个答案:

简单的解决方案

复杂的解决方案