闪亮应用的登陆页面

Question

我正在尝试在 shinydashboard 中创建一个启动页面或登录页面（或在必要时进行闪亮）。我的主要闪亮应用将有标签导航等。但着陆页不应该。其实应该是完全不一样的，或许类似这样：http://www.dataseries.org

我知道我可以将 html 页面添加到与 ui.r 和 server.r 脚本相同的文件夹中，但我还没有找到在应用程序启动时引用该文件的方法。锚标记可以在那里提供一个链接，但我希望登录页面在页面被调用时自动打开。

我的可重现代码毫无价值，因为没有任何效果，但我还是将其包含在内，以防万一它使事情变得更容易。这是来自 shinydashboard 网站的样板。

ui.r

    library(shinydashboard)


    ui <- dashboardPage(

      dashboardHeader(title = "Basic dashboard"),
      ## ui.R ##

      dashboardSidebar(
        sidebarMenu(
          menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
          menuItem("Widgets", tabName = "widgets", icon = icon("th"))
        )
      ),

      dashboardBody(
        tabItems(
          # First tab content
          tabItem(tabName = "dashboard",
                  fluidRow(
                    box(plotOutput("plot1", height = 250)),

                    box(
                      title = "Controls",
                      sliderInput("slider", "Number of observations:", 1, 100, 50)
                    )
                  )
          ),

          # Second tab content
          tabItem(tabName = "widgets",
                  h2("Widgets tab content")
          )
        )
      )
    )

server.r

    library(shiny)
    library(shinydashboard)

    server <- function(input, output) {
      set.seed(122)
      histdata <- rnorm(500)



      output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
      })
    }

Answer 1

这有点混搭，但您可以使用模式对话框来复制登录页面。

基本上，使用 Shiny 的原生 showModal(modalDialog()) 命令在应用程序上方弹出一个面板。该模式是在server.R 中的observeEvent() 语句中创建的，该语句在应用程序启动时只运行一次。自定义 CSS 包含在 ui.R 脚本中，它使模式占据整个页面。这是应用程序：

ui.R

library(shinydashboard)


ui <- dashboardPage(

  dashboardHeader(title = "Basic dashboard"),
  ## ui.R ##

  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", tabName = "widgets", icon = icon("th"))
    )
  ),

  dashboardBody(

    tags$head(tags$style(HTML('
      .modal.in .modal-dialog{
        width:100%;
        height:100%;
        margin:0px;
      }

      .modal-content{
        width:100%;
        height:100%;
      }
    '))),

    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",
        fluidRow(
          box(plotOutput("plot1", height = 250)),

          box(
            title = "Controls",
            sliderInput("slider", "Number of observations:", 1, 100, 50)
          )
        )
      ),

      # Second tab content
      tabItem(tabName = "widgets",
        h2("Widgets tab content")
      )
    )
  )
)

server.R

library(shiny)
library(shinydashboard)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)

  observeEvent(once = TRUE,ignoreNULL = FALSE, ignoreInit = FALSE, eventExpr = histdata, { 
    # event will be called when histdata changes, which only happens once, when it is initially calculated
    showModal(modalDialog(
      title = "Landing Page", 
      h1('Landing Page'),
      p('Theoretically you can put whatever content you want in here')
    ))
  })

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
}

一些注意事项：

• CSS 会改变应用程序中的每个 模态对话框，因此您需要向第一个模态对话框添加特定的类，以防止所有模态对话框全屏显示。
  • 从技术上讲，模式在 UI 加载之后加载，因此用户可以在短时间内看到后台应用程序。

我相信您可以通过查找与加载应用程序的服务器相对应的事件来修复后者，但不幸的是我不熟悉任何此类事件。

Answer 2

在此示例中，我使用隐藏的tabsetPanel() 创建了一个登录页面。它包含 2 个选项卡

• 登陆页面
• 内容

在应用加载时默认加载着陆页。然后可以使用updateTabsetPanel() 从登录页面切换到内容。

ui.R

ui <- dashboardPage(
  
  dashboardHeader(title = "Basic dashboard"),
  
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", tabName = "widgets", icon = icon("th"))
    )
  ),
  
  dashboardBody(
    tabsetPanel(
      id = "page",
      type = "hidden",

      #Your landing page
      tabPanelBody("landing-page",
        div(
          style = "position: absolute;
                   left: 0;
                   top: 0;
                   z-index: 10000;
                   width: 100%;
                   height: 100%;
                   background: lightblue;",
          div(
            style = "position: relative;
                     top: 30%;
                     left: 30%;",
            h1("Landing Page"),
            textInput("search", NULL),
            #Button to close landing page
            actionButton("close-landing-page", "Close") 
          )
        )
      ),

      #Your content
      tabPanelBody("content", 
        tabItems(
          # First tab content
          tabItem(tabName = "dashboard",
            fluidRow(
              box(plotOutput("plot1", height = 250)),
              
              box(
                title = "Controls",
                sliderInput("slider", "Number of observations:", 1, 100, 50)
              )
            )
          ),

          # Second tab content
          tabItem(tabName = "widgets",
            h2("Widgets tab content")
          )
        )
      )
    )
  )
)

server.R

library(shiny)
library(shinydashboard)

server <- function(input, output, session) {
  set.seed(122)
  histdata <- rnorm(500)
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
  
  #Observe event to close landing page and open content
  observeEvent(input$`close-landing-page`, {
    updateTabsetPanel(session, "page", "content")
  })
}