问题
I have created an app in R shiny that is practically a dashboard for KPIs.I have written it in two files, ui.r and server.r and what I am now trying to do is to add a login page and render different dashboards for different users.For example,the manager should see one dashboard and the employees should see another one.The problem is that I do not know how to convert my solution in something that uses functions and still see the html page that I have built separately before I added the login page, in order to make the login possible.Could you help me?
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))
回答1:
With slight modification in your code we can generate dashboard as per the role. Have a look at the code below:
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))
Hope it helps!
来源：https://stackoverflow.com/questions/46649412/r-shiny-different-users