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

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

ОТВЕТЫ

Ответ 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)

Ответ 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)

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