r - 动态显示仪表板页面

Question

我有一个实用的 Shiny 应用程序，它使用 shinydashboard 包。

新功能需要特定于用户的行为(例如，针对不同的用户名使用不同的数据集)。因此我打算

1. 显示登录表单
2. 验证凭据，如果成功，则将响应值 LoggedIn 设置为 true
3. 一旦 LoggedIn 设置为 TRUE，就会显示实际的 dashboardPage

我的方法基于 this app ，它根据 react 值决定在 renderUI 中显示哪个元素。

以下简化示例应该在单击 actionButton 后更改显示的 UI 元素。源代码之间的唯一区别是示例 1(按预期工作)使用 fixedPage，而示例 2(不工作 - 单击按钮不会切换到 ui2)使用一个dashboardPage。

工作示例

library(shiny)

ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- fixedPage(sliderInput("slider", "slider", 3, 2, 2))
ui <- uiOutput("ui")

server <- function(input, output, session) {
  state <- reactiveValues(LoggedIn = FALSE)
  output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})

  observeEvent(input$btn_login, {
    state$LoggedIn = TRUE
  })
}

shinyApp(ui, server)

故障示例

library(shiny)
library(shinydashboard)

ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody())
ui <- uiOutput("ui")

server <- function(input, output, session) {
  state <- reactiveValues(LoggedIn = FALSE)
  output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})

  observeEvent(input$btn_login, {
    state$LoggedIn = TRUE
  })
}

shinyApp(ui, server)

这是由于 shinydashboard 包的特殊性造成的吗？有没有人遇到过类似的问题(除了 this user )并找到解决方案？

预先感谢您的帮助!

编辑

@SeGa 这个相当无用的应用程序在 reactiveTimer 触发两次后渲染 dashboardPage - 也许有可能在没有计时器的情况下让它工作？

library(shiny)
library(shinydashboard)

ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody())
ui <- uiOutput("ui")

server <- function(input, output, session) {
  state <- reactiveValues(LoggedIn = FALSE)
  timer <- reactiveTimer(1000, session)

  output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})

  observeEvent(timer(), {
    state$LoggedIn = !state$LoggedIn
  })
}

shinyApp(ui, server)

编辑 5 月 29 日

@贝蒂尔·巴伦

你的意思是这样的吗？

loginUI <- fixedPage(actionButton("btn_login", "Login"))
mainUI <- # See below
ui <- loginUI

server <- function(input, output, session) {
  observeEvent(input$btn_login, {
    removeUI(selector = "body")
    insertUI(selector = "head", where = "afterEnd", mainUI)
  })
}    
shinyApp(ui, server)

现在，如果 mainUI 是 basicPage、bootstrapPage、fillPage、fixedPage、fluidPage、navbarPage 之一，则此方法有效 - 新的 body 标记已插入并在 DOM 中可见，但是bootstrapPage 没有任何效果。

如果您打算最初在 dashboardBody 中显示登录表单，并在成功登录后将其替换为实际内容 - 这就是我想要避免的情况。

Answer 1

它也适用于 invalidateLater()，但也只是暂时的。

library(shiny)
library(shinydashboard)

ui <- uiOutput("ui")

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

  state <- reactiveValues(LoggedIn = FALSE)

  observeEvent(input$btn_login, {
    state$LoggedIn = !state$LoggedIn
  })

  ui1 <- reactive({
    fixedPage(actionButton("btn_login", "Login"))
  })

  ui2 <- reactive({
    ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody(
       sliderInput("slider", "slider", min = 1, max = 10, value = 2)
     ))
    invalidateLater(100, session)
    ui2
  })

  output$ui <- renderUI({if (!state$LoggedIn) ui1() else ui2()})

}

shinyApp(ui, server)