动态显示仪表板页面

Question

我有一个功能强大的应用程序,使用该shinydashboard包.

新功能需要特定于用户的行为(例如,为不同的用户名使用不同的数据集).所以我打算

1. 显示登录表单
2. 如果成功LoggedIn,true则验证凭据并设置无效值
3. 设置dashboardPage为尽快显示实际LoggedIn值TRUE

我的方法基于这个应用程序,它renderUI 根据无功值决定显示哪个元素.

以下简化示例应该在单击后更改显示的UI元素actionButton.源之间的唯一区别是示例1(按预期工作)使用a fixedPage,而示例2(不工作 - 单击按钮不切换ui2)使用a 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包装的特殊性？有没有人有类似的问题(除了这个用户)并找到了解决方案？

在此先感谢您的帮助!

编辑

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

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日

@Bertil男爵

这是你的意思吗？

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- 在DOM中插入并显示一个新的body标签,但对a没有效果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)