0

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

Community
  • 1
  • 1
ghoost2010
  • 3
  • 1
  • 3

1 Answers1

0

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

Geovany
  • 5,389
  • 21
  • 37
  • Thank you a lot. It works, but the colors of the page are still not like the first image I uploaded. Do you know why? – ghoost2010 Nov 17 '16 at 06:31
  • The problem is that using that method to load a dashboard page, the body doesn't have the `class="skin-purple"` attribute. You should consider to use a different login option. – Geovany Nov 17 '16 at 07:11
  • About using another login option,Do you have any suggestion? – ghoost2010 Nov 17 '16 at 07:17
  • Maybe this could be useful for you http://stackoverflow.com/questions/32644018/r-shiny-login-hack/32658248#32658248 – Geovany Nov 17 '16 at 07:21
  • Thanks, I will try it. – ghoost2010 Nov 17 '16 at 07:30
  • The codes work, but I have I question: where should I write the "dashboardBody()"? I changed the variable "mainpage" according to my code, but after login I can't see anything. – ghoost2010 Nov 18 '16 at 01:59