Question

我有一个功能强大的应用程序，它使用shinydashboard包。

新功能需要特定于用户的行为（例如，为不同的用户名使用不同的数据集）。所以我打算

显示登录表单
如果成功

LoggedIn

true

dashboardPage设置为LoggedIn后立即显示实际TRUE

我的方法基于this app，它根据无效值决定在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这个相当无用的应用程序在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 Baron

这是你的意思吗？

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中插入并显示新的正文标记，但对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)

Answer 2

不确定这是您所使用的解决方案，但我尝试使用shinyjs和一些CSS。似乎很难从fixedPage切换到dashboardPage，所以如果你真的想使用shinydashboard，我会坚持使用shinydashboard并禁用登录时的仪表板外观页。

library(shiny)
library(shinyjs)
library(shinydashboard)

ui1 <- div(
  id = "login-page",
  actionButton("btn_login", "Login")
)

ui2 <- hidden(    
  div(
    id = "main-page",
    sliderInput("slider", "slider", 3, 2, 2)
  )
)

ui <- dashboardPage(dashboardHeader(), 
                    dashboardSidebar(collapsed = TRUE), 
                    dashboardBody(useShinyjs(),
                                  tags$head(
                                    tags$style(
                                      HTML('.main-header {
                                              display: none;
                                            }

                                            .header-visible {
                                              display: inherit;
                                            }')
                                    )
                                  ),
                                  fluidPage(ui1, ui2)
                    )
)

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

  state <- reactiveValues(LoggedIn = FALSE)

  observeEvent(input$btn_login, {
    state$LoggedIn = TRUE
    shinyjs::addClass(selector = "header", class = "header-visible")
    shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
    shinyjs::hide(id = "login-page")
    shinyjs::show(id = "main-page")
  })

}

shinyApp(ui, server)

如果您希望能够返回登录页面，您可以随时添加一个显示登录页面的登录按钮，并隐藏相应的元素（侧栏/标题/当前页面）。

动态显示仪表板页面

2 个答案: