在密碼輸入後（使用Shinydashboard）啓動Shiny應用程序

Question

在此topic很好地解釋瞭如何在輸入一些密碼後啓動shinyapp。我正在嘗試做同樣的事情，但不是「navbarPage」，我想要一個「dashboardPage」。

我試圖將do.call函數窗體'navbarPage'中的參數更改爲'dashboardPage'，但應用程序崩潰。

rm(list = ls()) 
library(shiny) 

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(tabPanel("Test"))} 

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(dashboardPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2()))) 
     }) 
     print(ui) 
    } 
    }) 
}) 

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

Answer 1

我woder如果我的代碼，就足以讓你開始「正確」的道路上。如果不是這樣，請讓我知道。

下面的代碼，如果登錄名和密碼正確，將顯示一個shinydashboard。

但下面的問題需要解決：

• 沒有在CSS中的一個問題。我認爲你需要將更改爲登錄操作的css「重置」爲更加標準的shinydashboard（目前全白）
• 如果密碼錯誤，第一個observe將繼續在renderUI上「勝出」有或沒有第二個observe，嚴格地說是不必要的，因此消除了），並且相對於錯誤登錄的消息從不執行。

有很多事情可以嘗試解決上述問題。

• 對於CSS你可以重新設置它，或者優雅地在登錄模式。
• 對於第二個也許你可以把所有的邏輯到renderUI調用。這將確保所有案件都被執行。

但請讓我知道它是否足夠清楚。

這是代碼：

rm(list = ls()) 
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(dashboardHeader(), 
      dashboardSidebar(), 
      dashboardBody("Test")) 
} 


ui = (htmlOutput("page")) 

server = function(input, output, session) { 
    USER <- reactiveValues(Logged = Logged) 

    observe({ 
    if (USER$Logged == FALSE) { 
     if (!is.null(input$Login)) { 
     if (length(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 
      } 
      } 
     } 
     } 
    } 
    }) 

    output$page <- renderUI({ 
    if (USER$Logged == FALSE) { 
     do.call(bootstrapPage, c("", ui1())) 
    } else { 
     do.call(dashboardPage, #c(inverse=TRUE,title = "Contratulations you got in!", 
       ui2()) 
    } 
    }) 
} 

shinyApp(ui, server) 

2017年10月30日更新

看來，上面的代碼沒有了（@ 5249203指出這多虧了）工作。

我試過修復它，但我沒有設法使do.call函數與dashboardBody一起工作（如果有人知道某種方式，請告訴我！）。

因此，我用另一種方式解決了這個問題，這要歸功於最近的shiny函數。

看到你的想法（當然，像往常一樣，解決方案只是一個需要擴展的模板）。

library(shiny) 
library(shinydashboard) 

Logged = FALSE 
my_username <- "test" 
my_password <- "test" 

ui <- dashboardPage(skin='blue', 
    dashboardHeader(title = "Dashboard"), 
    dashboardSidebar(), 
    dashboardBody("Test", 
    # actionButton("show", "Login"), 
    verbatimTextOutput("dataInfo") 
    ) 
) 

server = function(input, output,session) { 

values <- reactiveValues(authenticated = FALSE) 

# Return the UI for a modal dialog with data selection input. If 'failed' 
# is TRUE, then display a message that the previous value was invalid. 
dataModal <- function(failed = FALSE) { 
    modalDialog(
    textInput("username", "Username:"), 
    passwordInput("password", "Password:"), 
    footer = tagList(
     # modalButton("Cancel"), 
     actionButton("ok", "OK") 
    ) 
) 
} 

# Show modal when button is clicked. 
# This `observe` is suspended only whith right user credential 

obs1 <- observe({ 
    showModal(dataModal()) 
}) 

# When OK button is pressed, attempt to authenticate. If successful, 
# remove the modal. 

obs2 <- observe({ 
    req(input$ok) 
    isolate({ 
    Username <- input$username 
    Password <- input$password 
    }) 
    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) { 
     Logged <<- TRUE 
     values$authenticated <- TRUE 
     obs1$suspend() 
     removeModal() 

    } else { 
     values$authenticated <- FALSE 
    }  
    } 
    }) 


output$dataInfo <- renderPrint({ 
    if (values$authenticated) "OK!!!!!" 
    else "You are NOT authenticated" 
}) 

} 

shinyApp(ui,server) 

Answer 2

這是另一種解決方案，它採用與@ Enzo's稍有不同的方法。它創建了第二個UI，因此用戶無法在第一個菜單選項卡上看到該應用顯示的內容。唯一的缺點是一切都基本上被帶到服務器端，這可能會導致代碼的一些問題取決於它的寫法。

library(shiny) 
library(shinydashboard) 

my_username <- "test" 
my_password <- "abc" 

###########################/ui.R/################################## 

header <- dashboardHeader(title = "my heading") 
sidebar <- dashboardSidebar(uiOutput("sidebarpanel")) 
body <- dashboardBody(uiOutput("body")) 

ui <- dashboardPage(header, sidebar, body) 

###########################/server.R/################################## 

server <- function(input, output, session) { 
    Logged <- FALSE 

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

    output$sidebarpanel <- renderUI({ 
    if (USER$Logged == TRUE) { 
     dashboardSidebar(
     sidebarUserPanel("myuser",subtitle = a(icon("user"), "Logout", href="__logout__")), 
     selectInput("in_var", "myvar", multiple = FALSE, 
        choices = c("option 1","option 2")), 
     sidebarMenu(
      menuItem("Item 1", tabName = "t_item1", icon = icon("line-chart")), 
      menuItem("Item 2", tabName = "t_item2", icon = icon("dollar")), 
      menuItem("Item 3", tabName = "t_item3", icon = icon("credit-card")), 
      menuItem("Item 4", tabName = "t_item4", icon = icon("share-alt")) 
     ))} 
    }) 

    output$body <- renderUI({ 
    if (USER$Logged == TRUE) { 
     B <- c(2,3,4,3,7,5,4) 

     box(
     title = p("Histogram", actionLink("Expand", "", icon = icon("expand"))), status = "primary", solidHeader = TRUE, width = 4, 
     hist(B) 
    ) 
    } 
    if (USER$Logged == FALSE) { 
     box(title = "Login",textInput("userName", "Username"), 
      passwordInput("passwd", "Password"), 
      br(), 
      actionButton("Login", "Log in")) 
    } 
    }) 
} 

shinyApp(ui, server)