在我正在开发的系统中,我有3个不同的演员(用户,管理员,支持团队)使用Shiny App。我想知道如何为这三个演员提供身份验证,每个演员只能访问他们的页面。我发现可以使用闪亮的服务器Pro,它不是免费的。有没有办法做到这一点,而不是使用闪亮的服务器专业版。在UI.R中,代码如下:
library(shiny)
library(shinydashboard)
rm(list = ls())
Logged = FALSE;
my_username <- "test"
my_password <- "test"
ui1 <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(
ui = (htmlOutput("page"))
)
)
)
在Server.R中,代码如下: 库(shinydashboard)
库(有光泽)
server = (function(input, output,session) {
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"))}
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,title = "Contratulations you got in!",ui2())))
})
print(ui)
}
})
})
我想转到另一个仅向用户验证的页面。如何将UI.R连接到闪亮App中的不同页面? (例如,显示页面USER.R)。
答案 0 :(得分:4)
尝试这样的 我认为它可以帮助你做你想做的事情
1)ui:
library(shiny)
library(shinydashboard)
shinyUI(
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
uiOutput("page")
)
)
)
2)服务器:
library(shiny)
library(shinydashboard)
source("user.R")
source("admin.R")
my_username <- c("test","admin")
my_password <- c("test","123")
get_role=function(user){
if(user=="test") {
return("TEST")
}else{
return("ADMIN")
}
}
get_ui=function(role){
if(role=="TEST"){
return(list_field_user)
}else{
return(list_field_admin)
}
}
shinyServer(function(input, output,session) {
USER <- reactiveValues(Logged = FALSE,role=NULL)
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: -10px;margin-left: -150px;}")
)}
ui2 <- function(){list(tabPanel("Test",get_ui(USER$role)[2:3]),get_ui(USER$role)[[1]])}
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
USER$role=get_role(Username)
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
box(
div(class="outer",do.call(bootstrapPage,c("",ui1()))))
})
}
if (USER$Logged == TRUE) {
output$page <- renderUI({
box(width = 12,
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
)})
#print(ui)
}
})
})
3)user.r:
list_field_user = list(tabPanel("test2",fluidRow(column(6,numericInput("inputtest", "test", value = 0),column(6,actionButton(inputId ="test1",label ="go"))))),
h1("1234"),h2("234"))
4)admin.r
list_field_admin = list( h1("admin"),h2("admin"))
!!!将所有这些文件放在一个目录中
这个简单的例子,但这可以帮助你