Невозможно перейти к блестящей панели инструментов после успешного входа

Question

Я разрабатываю блестящую панель инструментов, и у меня есть два интерфейса (скажем, Login, Dashboard). После успешного входа в систему должна отображаться панель управления. Я использовал это как ссылка .

Но я не могу перейти на следующую страницу после успешного входа в систему.

Используемый код пользовательского интерфейса выглядит следующим образом:

    library(shiny)
    library(shinydashboard)

    `%AND%` <- function (x, y) {
      if (!is.null(x) && !anyNA(x))
        if (!is.null(y) && !anyNA(y))
          return(y)
      return(NULL)
    }

    passwordInputAddon <- function (inputId, label, value = "", placeholder = NULL, addon, width = NULL)
    {
      value <- shiny::restoreInput(id = inputId, default = value)
      htmltools::tags$div(
        class = "form-group shiny-input-container",
        label %AND% htmltools::tags$label(label, `for` = inputId),
        style = if (!is.null(width)) paste0("width: ", htmltools::validateCssUnit(width), ";"),
        htmltools::tags$div(
          style = "margin-bottom: 5px;", class="input-group",
          addon %AND% htmltools::tags$span(class="input-group-addon", addon),
          htmltools::tags$input(
            id = inputId, type = "password", class = "form-control",
            value = value, placeholder = placeholder
          )
        )
      )
    }

    my_username <- "test"
    my_password <- "abc"

ui1 <- function(){

  tagList(
    div(id = "login",
        fluidPage(

          tags$style(".container-fluid {margin-top: 13%}"),
          setBackgroundColor(color = "#2d3c44"),              
          fluidRow(
            column(8, align = "center", offset = 2,
                   textInputAddon("name", label = "", placeholder = "Username", addon = icon("user"),width = "25%"),
                   tags$style(type="text/css", "#string { height: 50px; width: 50%; text-align:center;
                        font-size: 30px; display: block;}")
            )
          ),
          fluidRow(
            column(8, align = "center", offset = 2,
                   passwordInputAddon("password", label = "", placeholder = "Password", addon = icon("key"),width = "25%"),               
                   tags$style(type="text/css", "#string { height: 50px; width: 50%; text-align:center;
                        font-size: 30px; display: block;}")
            )
          ),

          fluidRow(
            column(12, div(style = "height:20px;background-color: #2d3c44;")
            )

          ),

          fluidRow(
            column(6, align = "center", offset = 3,
                   actionButton("login",label = "Login", width = "35%", style = "color: #fff; background-color: #1bc3d7; border-color: #1bc3d7;"))),
          fluidRow(
            column(6, tags$head(tags$style(HTML('#dataInfo{color: red"}'))),
                   align = "center", offset = 3,
                   verbatimTextOutput("dataInfo")))

        )
        )


    )
}

ui2 <- function(){

  tagList(

    dashboardPage(
      dashboardHeader(
        title="Shiny Dashboard",
        tags$li(
          class="dropdown"
        )
      ),
      dashboardSidebar(
        sidebarMenu(
          id = 'dashboard_menu',
          sidebarMenuOutput("menu")

        )
      ),
      dashboardBody(
        tabItems(
          tabItem(tabName="Item1"),
          tabItem(tabName="Item2"),
          tabItem(tabName="Item3")
        )

      ))

  )

}

Код сервера следующий:

server <- function(input, output,session){

  Logged <- FALSE
  Security <- TRUE

  USER <- reactiveValues(Logged = Logged)
  SEC <- reactiveValues(Security = Security)

  observe({ 
    if (USER$Logged == FALSE) {
      if (!is.null(input$login)) {
        if (input$login > 0) {
          Username <- isolate(input$name)
          Password <- isolate(input$password)
          if(my_username == Username & my_password == Password) {
            USER$Logged <- TRUE
          } else {SEC$Security <- FALSE}
        } 
      }
    }    
  })

  observe({
    if (USER$Logged == FALSE) {({ui1()})}
    if (USER$Logged == TRUE) {({ui2()})}
  })

  observe({
    output$dataInfo <- renderText({
      if (SEC$Security) {""}
      else {"Your username or password is not correct"}
    })
  })
}

Я не могу перейти на другую страницу. Там нет ошибки, а также навигация не происходит. Я не знаю, где ошибка.

Может кто-нибудь решить эту проблему?

Answer 1

возможно, вы можете использовать shinymanager пакет для входа в систему? Полномочия находятся в таблице

library(shiny)
library(shinymanager)
library(shinydashboard)

# data.frame with credentials info
credentials <- data.frame(
  user = c("Nevedha"),
  password = c("welcome123"),
  stringsAsFactors = FALSE
)

ui <- secure_app(
  dashboardPage(
    dashboardHeader(
      title="Shiny Dashboard",
      tags$li(
        class="dropdown"
      )
    ),
    dashboardSidebar(
      sidebarMenu(
        id = 'dashboard_menu',
        sidebarMenuOutput("menu")

      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName="Item1"),
        tabItem(tabName="Item2"),
        tabItem(tabName="Item3")
      )

    ))
)

server <- function(input, output, session) {

  result_auth <- secure_server(check_credentials = check_credentials(credentials))

  output$res_auth <- renderPrint({
    a <- reactiveValuesToList(result_auth)
    # username
    a$user
  })

  # classic app
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })
}

shinyApp(ui = ui, server = server)