Динамически отображать панель мониторинга

У меня есть функциональное блестящее приложение, которое использует пакет shinydashboard.

Новая функция требует пользовательского поведения (например, использовать разные наборы данных для разных имен пользователей). Поэтому я намерен

1. Показать форму входа
2. Подтвердите учетные данные и установите для реактивного значения LoggedIn значение true если оно выполнено успешно.
3. Отобразите фактическую dashboardPage как только LoggedIn будет установлено значение TRUE

Мой подход основан на этом приложении, которое решает, какой элемент отображать в renderUI на основе реактивной ценности.

Следующие упрощенные примеры предполагают изменить отображаемый элемент пользовательского интерфейса после нажатия кнопки actionButton. Единственное различие между источником заключается в том, что пример 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? У кого-нибудь была аналогичная проблема (помимо этого пользователя) и нашли решение?

Заранее благодарю за любую помощь!

РЕДАКТИРОВАТЬ

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

EDIT 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 и заменить ее фактическим содержимым после успешного входа в систему - этого я и хотел избежать.

Ответы

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)

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)