Reputation:
Notice that I have the SELECTED = TRUE
flag designation in the sidebar menu, which I was under the impression was suppose to make that tab a "homepage" in the sense that it's the first page that loads upon rendering. But as you can see, it does not do this. After entering the username/password (sam/123) It goes to a blank page, and that tab doesn't appear until you select it.
If the SELECTED = TRUE
flag doesn't actually do what I thought, what would be the correct way to get my desired output?
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:
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
}
})
}
Upvotes: 0
Views: 591
Reputation: 2725
Please try this:
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)
I just gave an id = "tabs",
to sidebarMenu and then added:
observeEvent(USER$Logged == TRUE, {
updateTabItems(session, "tabs", selected = "t_item1")
})
Upvotes: 2
Reputation: 1111
How about this?
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)
I replaced tabItems
with menuItem
in output$body
.
Upvotes: 0