R闪耀不同的用户 [英] R Shiny different users
本文介绍了R闪耀不同的用户的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我已经在R Shiny中创建了一个应用程序，它实际上是KPI的仪表板。我将它写在两个文件中：ui.r和server.r，我现在要做的是添加一个登录页面，并为不同的用户呈现不同的仪表板。例如，经理应该看到一个仪表板，员工应该看到另一个仪表板。问题是，我不知道如何将我的解决方案转换为使用函数的东西，并且仍然可以看到我在添加登录页面之前单独构建的html页面，以便使登录成为可能。您能帮助我吗？
rm(list = ls())
library(shiny)
Logged = FALSE;
my_usernames <- c("t1","t2")
my_passwords <- c("t10", "t20")
roles<-c("adm","ang")
role<-c()
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;}")
)}
sts<-"primary"
stat<-"primary"
stat1<-"primary"
ui2<-function(){
dashboardPage(
skin = "purple",
dashboardHeader( title = "Dashboard SC REMEMBER SECOND SRL", titleWidth = 450),
dashboardSidebar(
sidebarMenu(
menuItem(
text="KPI",
tabName="KPI",
icon=icon("key")
),
menuItem(
text="KRI",
tabName="KRI",
icon=icon("key")
),
menuItem(
text="Activitate",
tabName="Activitate",
icon=icon("line-chart")
)
)
),
dashboardBody(
tabItems(
tabItem(tabName="KPI",
fluidRow(
h2("Indicatorii cheie de performanta ai companiei")),
sidebarLayout(
sidebarPanel(
selectInput("select_month1","Alegeti luna pentru care doriti sa vizualizati datele: ",c("Septembrie"="Septembrie","Octombrie"="Octombrie","Noiembrie"="Noiembrie")) ),
mainPanel(
fluidRow(
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T,infoBox(" ",100,icon=icon("thumbs-up"))),
infoBoxOutput("vanz_med"),
infoBoxOutput("chelt_med"),
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T, background = "aqua"),
box(title="Vanzarea medie zilnica", status="primary", solidHeader=T),
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T),
valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple")
)
)
)
),
tabItem(tabName="KRI",
fluidRow(
h2("Indicatorii cheie de risc ai companiei"),
box(title="Vanzarea medie zilnica", status="primary", solidHeader=T),
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T)
)
),
tabItem(tabName="Activitate",
fluidRow(
h2("Activitatea companiei")
),
fluidRow(
sidebarLayout(
sidebarPanel(
selectInput("select_month","Alegeti luna pentru care doriti sa vizualizati datele: ",c("Septembrie"="Septembrie","Octombrie"="Octombrie","Noiembrie"="Noiembrie")) ),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Date", tableOutput("date")),
tabPanel("Vanzari",
fluidRow
(
tableOutput("vanz"),
plotOutput("graf1",click = "plot_click")
)
),
tabPanel("Cheltuieli",
fluidRow
(
tableOutput("chelt"),
plotOutput("graf2",click = "plot_click")
)
)
)
)
)
)
)
)
)
)
}
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(Username) > 0 && length(Password) > 0)) {
if(my_passwords[which(my_usernames==Username)]==Password)
{
USER$Logged <<- TRUE
if(Username=="t1")
{
role<-roles[1]
}
else{
if(Username=="t2")
{
role<-roles[2]
}
}
}
else {
USER$Logged <- FALSE
}
}
else {
USER$Logged <- FALSE
}
}
}
}
})
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(bootstrapPage,c("",ui2())))
})
print(ui)
}
})
output$date<-renderTable({
#date_1[,c(subset(date_1,Luna=="Septembrie"), input$select_month)]
subset(date_1,Luna==input$select_month)
})
output$vanz<-renderTable({
subset(date_1,Luna==input$select_month)[,c(1,3)]
})
output$chelt<-renderTable({
subset(date_1,Luna==input$select_month)[,c(1,4)]
})
output$graf1<-renderPlot({
plot(subset(date_1,Luna==input$select_month)[,c(1)],subset(date_1,Luna==input$select_month)[,c(3)], xlab="Ziua",ylab="Valoarea vanzarilor",type="l")
})
output$graf2<-renderPlot({
plot(subset(date_1,Luna==input$select_month)[,c(1)],subset(date_1,Luna==input$select_month)[,c(4)], xlab="Ziua",ylab="Valoarea cheltuielilor",type="l")
})
output$vanz_med<-renderInfoBox({
value<-unname(date_2[date_2[, "Luna"] == input$select_month1, 2])
if ( value> 150)
{
infoBox("Vanzare medie", value, color = "blue",icon=icon("thumbs-up"))
}
else if ( value> 100&&value<150)
{
infoBox("Vanzare medie", value, color = "yellow",icon=icon("exclamation-circle"))
}
else if (value< 100)
{
infoBox("Vanzare medie", value, color = "red", fill = TRUE,icon=icon("thumbs-down"))
}
else {NULL}
})
output$chelt_med<-renderInfoBox({
value1<-unname(date_2[date_2[,"Luna"]==input$select_month1,3])
if ( value1<160)
{
infoBox("Cheltuiala medie zilnica", value1, color = "blue",icon=icon("thumbs-up"))
}
else if ( value1>= 160&&value1<170)
{
infoBox("Cheltuiala medie zilnica", value1, color = "yellow",icon=icon("exclamation-circle"))
}
else if (value1>= 170)
{
infoBox("Cheltuiala medie zilnica", value1,color = "red", fill=TRUE,icon=icon("thumbs-down"))
}
else {NULL}
})
})
runApp(list(ui = ui, server = server))
推荐答案
稍微修改一下代码，我们就可以根据角色生成仪表板。 请看下面的代码：
rm(list = ls())
library(shiny)
library(shinydashboard)
Logged = FALSE;
my_usernames <- c("t1","t2")
my_passwords <- c("t10", "t20")
roles<-c("adm","ang")
sts<-"primary"
stat<-"primary"
stat1<-"primary"
#####Main ui function#################################################################
ui <- shinyUI(
dashboardPage(
skin = "purple",
dashboardHeader(title = "Dashboard SC REMEMBER SECOND SRL", titleWidth = 450),
dashboardSidebar(uiOutput("side"),width = 190),
dashboardBody(uiOutput("page",height=1000)
)
)
)
#################################################################################################
######Login Page#######################################################################################
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;}")
)}
######################################################################################################
####################################ui For managers####################################################
ui2_side=list(
sidebarMenu(id = "tabs",
sidebarMenu(
menuItem(
text="KPI",
tabName="KPI",
icon=icon("key")
),
menuItem(
text="KRI",
tabName="KRI",
icon=icon("key")
),
menuItem(
text="Activitate",
tabName="Activitate",
icon=icon("line-chart")
)
)
))
ui2_main <- list(
tabItems(
tabItem(tabName="KPI",
fluidRow(
h2("Indicatorii cheie de performanta ai companiei")),
sidebarLayout(
sidebarPanel(
selectInput("select_month1","Alegeti luna pentru care doriti sa vizualizati datele: ",c("Septembrie"="Septembrie","Octombrie"="Octombrie","Noiembrie"="Noiembrie")) ),
mainPanel(
fluidRow(
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T,infoBox(" ",100,icon=icon("thumbs-up"))),
infoBoxOutput("vanz_med"),
infoBoxOutput("chelt_med"),
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T, background = "aqua"),
box(title="Vanzarea medie zilnica", status="primary", solidHeader=T),
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T),
valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple")
)
)
)
),
tabItem(tabName="KRI",
fluidRow(
h2("Indicatorii cheie de risc ai companiei"),
box(title="Vanzarea medie zilnica", status="primary", solidHeader=T),
box(title="Vanzarea medie zilnica", status=sts, solidHeader=T)
)
),
tabItem(tabName="Activitate",
fluidRow(
h2("Activitatea companiei")
),
fluidRow(
sidebarLayout(
sidebarPanel(
selectInput("select_month","Alegeti luna pentru care doriti sa vizualizati datele: ",c("Septembrie"="Septembrie","Octombrie"="Octombrie","Noiembrie"="Noiembrie")) ),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Date", tableOutput("date")),
tabPanel("Vanzari",
fluidRow
(
tableOutput("vanz"),
plotOutput("graf1",click = "plot_click")
)
),
tabPanel("Cheltuieli",
fluidRow
(
tableOutput("chelt"),
plotOutput("graf2",click = "plot_click")
)
)
)
)
)
)
)
)
)
###################################################################################################################
###################################ui for other users#############################################################
ui3_side=list(
sidebarMenu(id = "tabs",
sidebarMenu(
menuItem(
text="Other Users",
tabName="Others",
icon=icon("key")
)
)
))
ui3_main <- list(
tabItems(
tabItem(tabName="Others",
h2("Tab item for other users")
)
)
)
#################################################################################################################
##############################################server ############################################################
server = (function(input, output,session) {
USER <- reactiveValues(Logged = Logged, role= NULL)
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(Username) > 0 && length(Password) > 0)) {
if(my_passwords[which(my_usernames==Username)]==Password)
{
# browser()
USER$Logged <<- TRUE
if(Username=="t1")
{
USER$role<-roles[1]
}
else{
if(Username=="t2")
{
USER$role<-roles[2]
}
}
}
else {
USER$Logged <- FALSE
}
}
else {
USER$Logged <- FALSE
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if ((USER$Logged == TRUE)){
if(USER$role == "adm"){
output$side <- renderUI({
ui2_side
})
output$page <- renderUI({
ui2_main
})
}
if(USER$role == "ang"){
output$side <- renderUI({
ui3_side
})
output$page <- renderUI({
ui3_main
})
}
}
})
output$date<-renderTable({
#date_1[,c(subset(date_1,Luna=="Septembrie"), input$select_month)]
subset(date_1,Luna==input$select_month)
})
output$vanz<-renderTable({
subset(date_1,Luna==input$select_month)[,c(1,3)]
})
output$chelt<-renderTable({
subset(date_1,Luna==input$select_month)[,c(1,4)]
})
output$graf1<-renderPlot({
plot(subset(date_1,Luna==input$select_month)[,c(1)],subset(date_1,Luna==input$select_month)[,c(3)], xlab="Ziua",ylab="Valoarea vanzarilor",type="l")
})
output$graf2<-renderPlot({
plot(subset(date_1,Luna==input$select_month)[,c(1)],subset(date_1,Luna==input$select_month)[,c(4)], xlab="Ziua",ylab="Valoarea cheltuielilor",type="l")
})
output$vanz_med<-renderInfoBox({
value<-unname(date_2[date_2[, "Luna"] == input$select_month1, 2])
if ( value> 150)
{
infoBox("Vanzare medie", value, color = "blue",icon=icon("thumbs-up"))
}
else if ( value> 100&&value<150)
{
infoBox("Vanzare medie", value, color = "yellow",icon=icon("exclamation-circle"))
}
else if (value< 100)
{
infoBox("Vanzare medie", value, color = "red", fill = TRUE,icon=icon("thumbs-down"))
}
else {NULL}
})
output$chelt_med<-renderInfoBox({
value1<-unname(date_2[date_2[,"Luna"]==input$select_month1,3])
if ( value1<160)
{
infoBox("Cheltuiala medie zilnica", value1, color = "blue",icon=icon("thumbs-up"))
}
else if ( value1>= 160&&value1<170)
{
infoBox("Cheltuiala medie zilnica", value1, color = "yellow",icon=icon("exclamation-circle"))
}
else if (value1>= 170)
{
infoBox("Cheltuiala medie zilnica", value1,color = "red", fill=TRUE,icon=icon("thumbs-down"))
}
else {NULL}
})
})
################################################################################################################
#Run the App
runApp(list(ui = ui, server = server))
希望能有所帮助！
这篇关于R闪耀不同的用户的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
