闪亮的应用程序（使用shinydashboard）：登录后页面变得奇怪

Question

I create a shiny application but I want users to login to access the application. Then I find a way to create the login page by this: Starting Shiny app after password input . But I have a problem that my APP using the package "shinydashboard", and after login the page goes weird. I'm not familiar with HTML things. Does any one knows how to fix this problem? Codes are below:

library(shiny)
library(shinydashboard)
Logged = FALSE;
my_username <- "test"
my_password <- "test"

ui1 <- function(){
tagList(
div(id = "login",
    wellPanel(textInput("userName", "Username"),
              passwordInput("passwd", "Password"),
              br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)}

ui2 <- function(){
tagList(
dashboardPage(
  dashboardHeader(title = "MY Web APP"),
  dashboardSidebar(    
    sidebarMenu(
      menuItem("menu1", tabName = "menu1", icon = icon("bank"),
               badgeColor = "blue"),
      menuItem("menu2", tabName = "menu2", icon = icon("bar-chart"))
    )),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "menu1",
              fluidRow(
                sidebarLayout(
                  sidebarPanel(
                    selectInput("pet1","PET:",c("dog","cat","pig"),selected = "dog"),
                    fileInput(inputId = "iFile", label = "Upload Excel:", 
                              accept="application/vnd.ms-excel"),
                    actionButton("go","Go!"),
                    downloadButton('downloadData', 'Download')
                  ),

                  # Show a plot of the generated distribution
                  mainPanel(
                    tabsetPanel(
                      tabPanel("summary", tableOutput("summary1")), 
                      tabPanel("Curve", plotlyOutput("curve1"))
                    )
                  )
                )
              )
      ),

      # Second tab content
      tabItem(tabName = "menu2",
              fluidRow(
                sidebarLayout(
                  sidebarPanel(
                    selectInput("pet1","PET:",c("dog","cat","pig"),selected = "dog"),
                    fileInput(inputId = "iFile", label = "Upload Excel:", 
                              accept="application/vnd.ms-excel"),
                    actionButton("go","Go!"),
                    downloadButton('downloadData', 'Download')
                  ),

                  # Show a plot of the generated distribution
                  mainPanel(
                    tabsetPanel(
                      tabPanel("summary", tableOutput("summary1")), 
                      tabPanel("Curve", plotlyOutput("curve1"))
                    )
                  )
                )
              )
      )
    )
  ),
  skin = "purple"
  )
 )  
}

ui = (htmlOutput("page"))
server = (function(input, output,session) {

USER <- reactiveValues(Logged = Logged)

observe({ 
if (USER$Logged == FALSE) {
  if (!is.null(input$Login)) {
    if (input$Login > 0) {
      Username <- isolate(input$userName)
      Password <- isolate(input$passwd)
      Id.username <- which(my_username == Username)
      Id.password <- which(my_password == Password)
      if (length(Id.username) > 0 & length(Id.password) > 0) {
        if (Id.username == Id.password) {
          USER$Logged <- TRUE
        } 
      }
    } 
  }
}    
})
observe({
if (USER$Logged == FALSE) {

  output$page <- renderUI({
    div(class="outer",do.call(bootstrapPage,c("",ui1())))
  })
}
if (USER$Logged == TRUE) 
{
  output$page <- renderUI({
    div(class="outer",do.call(navbarPage,c(inverse=TRUE,ui2())))
  })
}
})
})

runApp(list(ui = ui, server = server))

After login the page should be like this: enter image description here

Not like this: enter image description here

Answer 1

The navbarPage function expect the title as the first argument, since you have only two arguments and one argument is already identified, the navbarPage takes the ui2() function as the title.

Just change

div(class="outer",do.call(navbarPage,c(inverse=TRUE,ui2())))

with

div(class="outer",do.call(navbarPage,c(title = "MY Web APP", inverse=TRUE,ui2())))