Dynamically display a dashboardPage

问题

I have a functional shiny app that uses the shinydashboard package.

A new feature requires user-specific behavior (e.g. use different data sets for different usernames). Therefore I intend to

Display a login form
Validate credentials and set a reactive value LoggedIn to true if successful
Display the actual dashboardPage as soon as LoggedIn is set to TRUE

My approach is based on this app, which decides which element to display in renderUI based on the reactive value.

The following simplified examples are supposed to change the displayed UI element after clicking an actionButton. The only difference between the source is that example 1 (working as intended) uses a fixedPage, whereas example 2 (not working - clicking the button does not switch to ui2) uses a dashboardPage.

Working example

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)

Malfunctioning example

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)

Is this due to peculiarities of the shinydashboard package? Has anybody had a similar problem (besides this user) and found a solution?

Thanks in advance for any help!

EDIT

@SeGa This rather useless app renders the dashboardPage after the reactiveTimer has triggered twice - Maybe there is a possibility to get it working without the timer?

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)

EDIT May 29

@Bertil Baron

Is it something like that you mean?

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)

Now this works if mainUI is one of basicPage, bootstrapPage, fillPage, fixedPage, fluidPage, navbarPage - a new body tag is inserted and visible in the DOM, but there is no effect for a bootstrapPage.

In case you meant to initially display the login form in the dashboardBody and replacing it with the actual content after a successful login - that is what I wanted to avoid.

回答1:

It also works with invalidateLater(), but also only temporary.

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)

回答2:

Not sure this is the kind of solution you are after, but here's my attempt using shinyjs and some CSS. It seems hard to switch from a fixedPage to a dashboardPage, so if you really want to use shinydashboard, I would stick with shinydashboard and disable the dashboard look on the login page.

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)

If you want to be able to come back to the login page, you can always add a login button that shows the login page, and hides the appropriate elements (sidebar/header/current page).

来源：https://stackoverflow.com/questions/50511522/dynamically-display-a-dashboardpage

标签

Shiny

shinydashboard