我有包含登录和注销页面的ShinyApp。工作正常。但是，当我从应用程序注销时，它将带我进入主登录页面。当我再次登录时，下拉菜单不会加载，其他所有东西都可以正常工作。如果我关闭浏览器并在浏览器中点击http://127.0.0.1:3479/，它将正常工作。这是一个非常奇怪的错误。我很难修复它。
Install_And_Load <- function(Required_Packages) {
Remaining_Packages <- Required_Packages[!(Required_Packages %in% installed.packages()[,"Package"])];
if(length(Remaining_Packages))
{install.packages(Remaining_Packages);}
for(package_name in Required_Packages)
{library(package_name,character.only=TRUE, quietly = TRUE);}
}
packages <- c("shiny", "shinydashboard", "rhandsontable", "readxl", "DT", "DBI",
"odbc", "dplyr", "shinycssloaders", "rhandsontable", "rintrojs" ,"shinyjs", "glue")
Install_And_Load(packages)
options(DT.options = list(language = list(search = 'Select Species:')))
# Read Excel Files
mydata = iris
# login and log out page
loginUI <- function(id) {
ns <- shiny::NS(id)
shiny::div(id = ns("panel"), style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
shiny::wellPanel(
shiny::tags$h2("Please log in", class = "text-center", style = "padding-top: 0;"),
shiny::textInput(ns("user_name"), shiny::tagList(shiny::icon("user"), "User Name")),
shiny::passwordInput(ns("password"), shiny::tagList(shiny::icon("unlock-alt"), "Password")),
shiny::div(
style = "text-align: center;",
shiny::actionButton(ns("button"), "Log in", class = "btn-primary", style = "color: white;")
),
shinyjs::hidden(
shiny::div(id = ns("error"),
shiny::tags$p("Invalid username or password!",
style = "color: red; font-weight: bold; padding-top: 5px;", class = "text-center"))
)
)
)
}
login <- function(input, output, session, data, user_col, pwd_col,
hashed = FALSE, algo = c("md5", "sha1", "crc32", "sha256", "sha512",
"xxhash32", "xxhash64", "murmur32"),
log_out = NULL) {
algo <- match.arg(algo, several.ok = FALSE)
credentials <- shiny::reactiveValues(user_auth = FALSE, info = NULL)
shiny::observeEvent(log_out(), {
credentials$user_auth <- FALSE
credentials$info <- NULL
})
shiny::observeEvent(credentials$user_auth, ignoreInit = TRUE, {
shinyjs::toggle(id = "panel")
})
users <- dplyr::enquo(user_col)
pwds <- dplyr::enquo(pwd_col)
# ensure all text columns are character class
data <- dplyr::mutate_if(data, is.factor, as.character)
shiny::observeEvent(input$button, {
# check for match of input username to username column in data
row_username <- which(dplyr::pull(data, !! users) == input$user_name)
if(hashed) {
# check for match of hashed input password to hashed password column in data
row_password <- which(dplyr::pull(data, !! pwds) == digest::digest(input$password, algo = algo))
} else {
# if passwords are not hashed, hash them with md5 and do the same with the input password
data <- dplyr::mutate(data, !! pwds := sapply(!! pwds, digest::digest))
row_password <- which(dplyr::pull(data, !! pwds) == digest::digest(input$password))
}
# if user name row and password name row are same, credentials are valid
if (length(row_username) == 1 &&
length(row_password) >= 1 && # more than one user may have same pw
(row_username %in% row_password)) {
credentials$user_auth <- TRUE
credentials$info <- dplyr::filter(data, !! users == input$user_name)
} else { # if not valid temporarily show error message to user
shinyjs::toggle(id = "error", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(5000, shinyjs::toggle(id = "error", anim = TRUE, time = 1, animType = "fade"))
}
})
# return reactive list containing auth boolean and user information
shiny::reactive({
shiny::reactiveValuesToList(credentials)
})
}
logoutUI <- function(id) {
ns <- shiny::NS(id)
shinyjs::hidden(
shiny::actionButton(ns("button"), "Log out", class = "btn-danger", style = "color: white;")
)
}
logout <- function(input, output, session, active) {
shiny::observeEvent(active(), ignoreInit = TRUE, {
shinyjs::toggle(id = "button", anim = TRUE, time = 1, animType = "fade")
})
# return reactive logout button tracker
shiny::reactive({input$button})
}
user_base <- data_frame(
user = c("user1"),
password = c("pass1"),
permissions = c("admin"),
name = c("User One")
)
# User Interface
ui = dashboardPage(skin = "blue",
dashboardHeader(title = 'Sample App',
tags$li(class = "dropdown", style = "padding: 8px;", logoutUI("logout"))),
dashboardSidebar(collapsed = TRUE, sidebarMenuOutput("sideBar_menu_UI")),
dashboardBody(
shinyjs::useShinyjs(),
extendShinyjs(text = jscode, functions = c("closeWindow")),
loginUI("login"),
uiOutput("ui")
)
)
server = shinyServer(function(input, output, session) {
credentials <- callModule(login, "login",
data = user_base,
user_col = user,
pwd_col = password,
log_out = reactive(logout_init()))
logout_init <- callModule(logout, "logout", reactive(credentials()$user_auth))
user_data <- reactive({credentials()$info})
output$sideBar_menu_UI <- renderMenu({
req(credentials()$user_auth)
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon=icon("user")),
fluidRow(div(style="margin-left: 5px; padding-left: 10px;",
actionButton(inputId = "help", label = "App Tour", icon = icon("plane"),
style="color: #333; text-align: left; background-color: #FFF; border-color: #333"))),
menuItem("About App", tabName="about", icon = icon("info"))
)
})
observe({
req(credentials()$user_auth)
updateSelectizeInput(session, 'Speciest', choices = c("All",unique(as.character(mydata$Species))), server = TRUE)
})
output$ui <- renderUI({
req(credentials()$user_auth)
tabItems(
tabItem(tabName ="dashboard",
tabBox( title = "",
width = 12, id = "tabset1",
tabPanel("Species Comparison",
fluidRow(
rintrojs::introjsUI(),
box(title = "Data Filters:",background = "blue" , collapsible = TRUE, width = 12,
introBox(
fluidRow(
column(4, shiny::selectizeInput("Speciest",label="Species Tier",choices= NULL))
),
data.step = 1,
data.intro = "Filter data using Species."
))),
tags$style(".info-box.bg-orange .info-box-number {font-size:28px;} .info-box-text {text-transform: none;"),
tags$style(".info-box.bg-light-blue .info-box-number {font-size:32px;}"),
rintrojs::introBox(
data.step = 2,
data.intro = "Insights will be generated based on dropdown selection in the previous step"),
# fluidRow(div(style="display:inline-block; margin-left:15px;",tags$input(id="search",placeholder="Searching",type="text"))),
fluidRow(tags$style(HTML('#results th {font-weight:bold !important; display: table-cell; vertical-align: middle; background-color: #0073B7 !important; color: white !important;}')),
introBox(
box(width = 12,
DT::renderDataTable({
DT::datatable(dd(), extensions = c('Scroller'),rownames=FALSE,
selection=list(mode = 'single'),
editable = TRUE, options = list( scrollX = TRUE,
scroller = TRUE,
scrollY = "400px",
orderClasses = TRUE,
pageLength = 50,
fixedHeader = TRUE),escape=F)
})
),
data.step = 3,
data.intro = "Green color shows good score. Red color shows bad score. White shows average score. Shades of color depicts intensity of data of the particular metrics.")
)),
tabPanel("Details",
fluidRow(
box(width = 4, background = "blue",
solidHeader = TRUE)
)
)
)
),
tabItem(tabName="about",
titlePanel("About APP"),
HTML("This is an app.")
)
)
})
dd = reactive({
req(credentials()$user_auth)
if (input$Speciest == "All" | input$Speciest == "") {
result = mydata
}
else {
result = mydata %>% filter(Species %in% as.character(input$Speciest))
}
return(result)
})
# start introjs when button is pressed with custom options and events
observeEvent(input$help,
introjs(session, options = list("nextLabel"="Next",
"prevLabel"="Back",
"skipLabel"="Skip Tour"))
)
})
runApp(list(ui = ui, server = server), launch.browser = TRUE)