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

Question

У меня есть функциональное блестящее приложение, которое использует пакет 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)

РЕДАКТИРОВАТЬ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

Не уверен, что вы ищете именно такое решение, но вот моя попытка использовать 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)

Если вы хотите вернуться на страницу входа, вы всегда можете добавить кнопку входа, которая показывает страницу входа и скрывает соответствующие элементы (боковая панель / заголовок / текущая страница).

Answer 2

Он также работает с 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)