Пользовательский интерфейс не отображает выбранную вкладку должным образом - PullRequest
Новая
       16

Пользовательский интерфейс не отображает выбранную вкладку должным образом

0 голосов
/ 08 ноября 2019

Обратите внимание, что у меня есть обозначение SELECTED = TRUE в меню боковой панели, которое, как мне показалось, предполагало сделать эту вкладку "домашней страницей" в том смысле, что это первая страница, которая загружается при рендеринге. Но, как вы можете видеть, это не делает этого. После ввода имени пользователя / пароля (sam / 123) он переходит на пустую страницу, и эта вкладка не появляется, пока вы ее не выберете.

Если флаг SELECTED = TRUE на самом деле не выполняет то, что я думалКаков будет правильный способ получить желаемый результат?

UI: 

 library(shiny)
 library(shinydashboard)

 header <- dashboardHeader(title = "x")
 sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
 body <- dashboardBody(uiOutput("body"))
 ui <- dashboardPage(header, sidebar, body)

login_details <- data.frame(user = c("sam"),
                            pswd = c("123"))
login <- box(
  textInput("userName", "Username"),
  passwordInput("passwd", "Password"),
  actionButton("Login", "Log in")
)

Сервер: 

    server <- function(input, output, session) {
  login.page = paste(
    isolate(session$clientData$url_protocol),
    "//",
    isolate(session$clientData$url_hostname),
    ":",
    isolate(session$clientData$url_port),
    sep = ""
  )
  histdata <- rnorm(500)
  USER <- reactiveValues(Logged = F)
  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(login_details$user %in% Username)
          Id.password <- which(login_details$pswd %in% Password)
          if (length(Id.username) > 0 & length(Id.password) > 0){
            if (Id.username == Id.password) {
              USER$Logged <- TRUE
            }
          }
        }
      }
    }
  })
  output$sidebarpanel <- renderUI({
    if (USER$Logged == TRUE) {
      div(
        sidebarMenu(
          menuItem(
            "Item 1",
            tabName = "t_item1",
            icon = icon("line-chart"),
            selected = TRUE
          )
        )
      )
    }
  })

  output$body <- renderUI({
    if (USER$Logged == TRUE) {
      tabItems(
        tabItem(tabName = "t_item1",
                fluidRow(
                  output$plot1 <- renderPlot({
                    data <- histdata[seq_len(input$slider)]
                    hist(data)
                  }, height = 300, width = 300) ,
                  box(
                    title = "Controls",
                    sliderInput("slider", "observations:", 1, 100, 50)
                  )
                ))
      )
    } else {
      login
    }
  })
}

Ответы [ 2 ]

1 голос
/ 08 ноября 2019

Пожалуйста, попробуйте это: 

library(shiny)
library(shinydashboard)

header <- dashboardHeader(title = "x")
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(uiOutput("body"))
ui <- dashboardPage(header, sidebar, body)

login_details <- data.frame(user = c("sam"),
                            pswd = c("123"))
login <- box(
    textInput("userName", "Username"),
    passwordInput("passwd", "Password"),
    actionButton("Login", "Log in")
)

server <- function(input, output, session) {
    login.page = paste(
        isolate(session$clientData$url_protocol),
        "//",
        isolate(session$clientData$url_hostname),
        ":",
        isolate(session$clientData$url_port),
        sep = ""
    )
    histdata <- rnorm(500)
    USER <- reactiveValues(Logged = F)
    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(login_details$user %in% Username)
                    Id.password <- which(login_details$pswd %in% Password)
                    if (length(Id.username) > 0 & length(Id.password) > 0){
                        if (Id.username == Id.password) {
                            USER$Logged <- TRUE
                        }
                    }
                }
            }
        }
    })
    output$sidebarpanel <- renderUI({
        if (USER$Logged == TRUE) {
            div(
                sidebarMenu(id = "tabs",
                    menuItem(
                        "Item 1",
                        tabName = "t_item1",
                        icon = icon("line-chart")
                    )
                )
            )
        }
    })

    output$body <- renderUI({
        if (USER$Logged == TRUE) {
            tabItems(
                tabItem(tabName = "t_item1",
                        fluidRow(
                            output$plot1 <- renderPlot({
                                data <- histdata[seq_len(input$slider)]
                                hist(data)
                            }, height = 300, width = 300) ,
                            box(
                                title = "Controls",
                                sliderInput("slider", "observations:", 1, 100, 50)
                            )
                        ))
            )
        } else {
            login
        }
    })

    observeEvent(USER$Logged == TRUE, {
        updateTabItems(session, "tabs", selected = "t_item1")
    })
}
shinyApp(ui, server)

Я просто дал id = "tabs", SidebarMenu, а затем добавил: 

    observeEvent(USER$Logged == TRUE, {
        updateTabItems(session, "tabs", selected = "t_item1")
    })
0 голосов
/ 08 ноября 2019

Как насчет этого? 

library(shiny)
library(shinydashboard)

header <- dashboardHeader(title = "x")
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(uiOutput("body"))
ui <- dashboardPage(header, sidebar, body)

login_details <- data.frame(user = c("sam"),
                            pswd = c("123"))
login <- box(
  textInput("userName", "Username"),
  passwordInput("passwd", "Password"),
  actionButton("Login", "Log in")
)

server <- function(input, output, session) {
  login.page = paste(
    isolate(session$clientData$url_protocol),
    "//",
    isolate(session$clientData$url_hostname),
    ":",
    isolate(session$clientData$url_port),
    sep = ""
  )
  histdata <- rnorm(500)
  USER <- reactiveValues(Logged = F)
  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(login_details$user %in% Username)
          Id.password <- which(login_details$pswd %in% Password)
          if (length(Id.username) > 0 & length(Id.password) > 0){
            if (Id.username == Id.password) {
              USER$Logged <- TRUE
            }
          }
        }
      }
    }
  })


  output$sidebarpanel <- renderUI({

    if (USER$Logged == TRUE) {

          sidebarMenu(

            shinydashboard::menuItem("Item 1", tabName = "t_item1", icon = icon("clipboard-check"), selected = TRUE)

          )
    }
  })

  output$body <- renderUI({

    if (USER$Logged == TRUE) {

        menuItem(tabName = "t_item1",
                fluidRow(
                  output$plot1 <- renderPlot({
                    data <- histdata[seq_len(input$slider)]
                    hist(data)
                  }, height = 300, width = 300) ,
                  box(
                    title = "Controls",
                    sliderInput("slider", "observations:", 1, 100, 50)
                  )
                ))

    } else {
      login
    }
  })
}

app<-shinyApp(ui = ui, server = server)
runApp(app, host="0.0.0.0",port=5050, launch.browser = TRUE)

Я заменил tabItems на menuItem в output$body.

...