Неверная R Блестящая приборная панель. - PullRequest
0 голосов
/ 10 октября 2019

Я пытаюсь добавить параметры входа для моего приложения 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)
)

Любой совет будет признателен. Спасибо!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...