landing page for shiny app

Question

I am trying to create a splash or landing page in shinydashboard (or shiny if necessary). My main shiny app will have tab navigation etc. but the landing page should not. In fact, it should be completely different, maybe similar to this: http://www.dataseries.org

I know that I can add html pages into the same folder as the ui.r and server.r scripts but I have not found a way to reference that file when the app is starting up. An anchor tag could provide a link there but I want the landing page to automatically open when the page is called.

My reproducible code is pretty worthless because nothing has worked but I include it anyways, in case it make anything easier. This is boilerplate from the shinydashboard site.

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

It's a bit hacked-together, but you can use a modal dialog to replicate a landing page.

Basically, use Shiny's native showModal(modalDialog()) command to have a panel pop up over the app. The modal is created in an observeEvent() statement in server.R that runs exactly once when the app starts up. Custom CSS is included in the ui.R script that makes the modal take up the entire page. Here's the app:

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

A few caveats:

• The CSS alters every modal dialog in the app, so you will need to add specific classes to this first modal to prevent all modals from being full-screen.
  • The modal technically loads after the UI loads, so there is a short second where the user can see the app in the background.

I believe you may be able to fix the latter by looking for an event that corresponds to the server loading the app, but unfortunately I am not familiar with any such event.

Answer 2

I've used a hidden tabsetPanel() to create a landing page in this example. It contains 2 tabs

• Landing Page
• Content

It loads the landing page by default when the app loads. updateTabsetPanel() can then be used to switch from the landing page to the content.

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")
  })
}