Я пытаюсь добавить параметры входа для моего приложения Shiny, и сейчас пытаюсь найти решение здесь: https://www.r -craft.org / r-news / how-to-build-login-page-in-r -iny-app /
Я немного изменил код (помеченный комментариями ниже), но столкнулся с проблемами, такими как положение tabsetPanel очень смещено вправо и HTMLКод в dashboardBody не работает для цвета фона боковой панели и шрифта.
library(shiny)
library(shinydashboard)
library(DT)
library(shinyjs)
library(sodium)
# Main login screen
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
wellPanel(
tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
br(),
div(
style = "text-align: center;",
actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
padding: 10px 15px; width: 150px; cursor: pointer;
font-size: 18px; font-weight: 600;"),
shinyjs::hidden(
div(id = "nomatch",
tags$p("Oops! Incorrect username or password!",
style = "color: red; font-weight: 600;
padding-top: 5px;font-size:16px;",
class = "text-center"))),
br(),
br(),
tags$code("Username: myuser Password: mypass"),
br(),
tags$code("Username: myuser1 Password: mypass1")
))
)
credentials = data.frame(
username_id = c("myuser", "myuser1"),
passod = sapply(c("mypass", "mypass1"),password_store),
permission = c("basic", "advanced"),
stringsAsFactors = F
)
header <- dashboardHeader(
#------Header changes starts (this change seems to work fine)
title = h3(HTML("ABC")),
tags$li(class = "dropdown",
tags$style(".main-header .logo {height: 100px}")
),
#User
tags$li(
class = "dropdown",
a(tags$img
(
height = "70px",
width = "45px",
src="Pic.png",
style = "margin-top:50px cursor: pointer;"
)
)
),
#Logo
tags$li(
class = "dropdown",
a(tags$img
(
height = "70px",
width = "200px",
src="Pic.png",
style = "margin-left:-10px; cursor: pointer;"
)
)
),
tags$li(
class = "dropdown",
a(tags$img
(
height = "95px",
width = "948.7px",
src="Pic.png",
style = "margin:-1em"
)
)
)
)
#------Header changes ends (this change seems to work fine)
#------Changes starts
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(uiOutput("body"))
#------Changes ends
ui<-dashboardPage(header, sidebar, body, skin = "blue")
server <- function(input, output, session) {
login = FALSE
USER <- reactiveValues(login = login)
observe({
if (USER$login == FALSE) {
if (!is.null(input$login)) {
if (input$login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
if(length(which(credentials$username_id==Username))==1) {
pasmatch <- credentials["passod"][which(credentials$username_id==Username),]
pasverify <- password_verify(pasmatch, Password)
if(pasverify) {
USER$login <- TRUE
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
}
}
}
})
output$sidebarpanel <- renderUI({
if (USER$login == TRUE ){
#------Change starts (this change seems to work fine)
dashboardSidebar(
hr(),
hr(),
selectInput('name', 'Name', c("Andrew"), multiple = FALSE , selected = "Andrew")
)
}
})
#------Change ends (this change seems to work fine)
output$body <- renderUI({
if (USER$login == TRUE ) {
#------Change starts (this part is not working)
dashboardBody(
tags$head(tags$style(HTML(
'.skin-black .main-sidebar {
background-color: #15317E;}')
)),
tags$style(type = "text/css", "a{color: #15317E;}"),
tabsetPanel(
tabPanel("Tab",
tabsetPanel(
tabPanel(
"SubpannelA",
img(
height = "450px",
width = "1250px",
src="Image.png",
align = "middle")
),
tabPanel(
"SubpannelB",
fluidRow(column(width = 6))
),
tabPanel(
"SubpannelC",
fluidRow(column(width = 6))
)
)
)))
#------Change ends
}
else {
loginpage
}
})
output$results <- DT::renderDataTable({
datatable(iris, options = list(autoWidth = TRUE,
searching = FALSE))
})
}
runApp(list(ui = ui, server = server), launch.browser = TRUE)
)
Любой совет будет признателен. Спасибо!