我想知道我的代码是否足以让您开始走上“正确”的道路。如果情况并非如此，请告诉我。
如果登录名和密码正确，下面的代码将显示一个闪亮的仪表板。
但以下问题需要解决：
- 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)
