I am trying to call dashboardPage from a function in server in Shiny. It is not showing the dahsboard page but showing a blank page. How do I redirect it to my dashboardPage. Currently it is showing a blank page to me after redirecting.
Following is the code:
## app.R ##
library(shinydashboard)
library(shiny)
library(shinythemes)
library(DT)
ui1 <- function(){}
ui2 <- dashboardPage(){}
ui = (uiOutput("page"))
server <- function(input, output, session) {
if (USER$Logged == TRUE)
{
output$page <- renderUI({
ui2()
###Here is the problem. It is not redirecting to ui2 which is
###a dashboardPage.
})
}
}
You didn't implement dashboardPage function properly. Below code would give you an idea how to work with it.
library(shinydashboard)
library(shiny)
library(shinythemes)
library(DT)
header <- dashboardHeader(
title = "dynamicDates",
tags$li(class = "dropdown", tags$a(HTML(paste(uiOutput("Refresh1"))))))
body <- dashboardBody("this is body function",
uiOutput("page"))
sidebar <- dashboardSidebar("this is side bar")
#we must pass header,body and sidebar parameters in dashboardPage funtion, which you have missed to specify.
ui <- dashboardPage(header, sidebar, body, title = "example")
server <- function(input, output, session) {
output$Refresh1 <- renderText({
toString(format(Sys.Date(), format = "%A %d %b %Y"))
})
output$page <- renderUI("shiny dashboard")
}
shinyApp(ui, server)
Related
I am using below code and try to do below action.
Click on action button to go to next table. How can I do this?
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table"),
tableOutput("tbl1")
)),
fluidRow(box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
Here's one solution:
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table",
onclick = "location.href='#table2';"),
tableOutput("tbl1")
)),
fluidRow(id = "table2", box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
I've added a unique ID to the location in the UI - here the 2nd fluidRow, then added an onclick javascript function to the actionButton also in the UI. No server function means all the work is done by the user's browser which is handy sometimes.
You can add infinite complexity to the Javascript here to customise it to fit your needs.
i'm trying to make a multi-pages app but the problem is that i don't get a reaction from a button that is supposed to redirect me to the app page, here is my code:
library(shiny)
library(shinyjs)
library(shinythemes)
library(shinydashboard)
render_page <- function(..., f) {
page <- f(...)
renderUI({
fluidPage(page, title = title)
})
}
ui_index <- function(...) {
basicPage(
actionButton("go","Go to App")
)
}
ui_app <- function(...){
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
}
ui <- (htmlOutput("page"))
server <- function(input, output, session){
output$page <- render_page(f = ui_index)
observeEvent(input$go,{
output$page = render_page(f = ui_app)
})
}
shinyApp(ui = ui,server = server)
I am trying to render a few outputs in a shiny application that are contained within a shinyjs::hidden section upon the application running rather than once the section is visible.
EDIT: I had the app set up incorrectly in the original example so have changed it.
I want to be able to run the reactive statement before running the final observe to change the UI from the Alpha text to the Beta text and plot. Ideally this would mean in the console would see "Done plotting" before "Observe run".
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id = "before-content", h3("Aux Text Alpha")),
shinyjs::hidden(
div(
id = "after-content",
h1("Aux Text Beta"),
plotOutput("text")
)
)
)
server <- function( session,input, output) {
in_plot <- reactive({
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observe({
print("Observe run")
hide("before-content")
show("after-content")
})
}
shinyApp(ui, server)
An alternative would be to have a layer over what is classed as the hidden section but am not too sure on how that is accomplished.
You can hide it in the reactive, like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("button", "Click me"),
plotOutput("text")
)
server <- function( session,input, output) {
in_plot <- reactive({
hide("text")
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observeEvent(input$button, {
show("text")
})
}
shinyApp(ui, server)
I have a functional shiny app that uses the shinydashboard package.
A new feature requires user-specific behavior (e.g. use different data sets for different usernames). Therefore I intend to
Display a login form
Validate credentials and set a reactive value LoggedIn to true if successful
Display the actual dashboardPage as soon as LoggedIn is set to TRUE
My approach is based on this app, which decides which element to display in renderUI based on the reactive value.
The following simplified examples are supposed to change the displayed UI element after clicking an actionButton. The only difference between the source is that example 1 (working as intended) uses a fixedPage, whereas example 2 (not working - clicking the button does not switch to ui2) uses a dashboardPage.
Working example
library(shiny)
ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- fixedPage(sliderInput("slider", "slider", 3, 2, 2))
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})
observeEvent(input$btn_login, {
state$LoggedIn = TRUE
})
}
shinyApp(ui, server)
Malfunctioning example
library(shiny)
library(shinydashboard)
ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody())
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})
observeEvent(input$btn_login, {
state$LoggedIn = TRUE
})
}
shinyApp(ui, server)
Is this due to peculiarities of the shinydashboard package?
Has anybody had a similar problem (besides this user) and found a solution?
Thanks in advance for any help!
EDIT
#SeGa This rather useless app renders the dashboardPage after the reactiveTimer has triggered twice - Maybe there is a possibility to get it working without the timer?
library(shiny)
library(shinydashboard)
ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody())
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
timer <- reactiveTimer(1000, session)
output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})
observeEvent(timer(), {
state$LoggedIn = !state$LoggedIn
})
}
shinyApp(ui, server)
EDIT May 29
#Bertil Baron
Is it something like that you mean?
loginUI <- fixedPage(actionButton("btn_login", "Login"))
mainUI <- # See below
ui <- loginUI
server <- function(input, output, session) {
observeEvent(input$btn_login, {
removeUI(selector = "body")
insertUI(selector = "head", where = "afterEnd", mainUI)
})
}
shinyApp(ui, server)
Now this works if mainUI is one of basicPage, bootstrapPage, fillPage, fixedPage, fluidPage, navbarPage - a new body tag is inserted and visible in the DOM, but there is no effect for a bootstrapPage.
In case you meant to initially display the login form in the dashboardBody and replacing it with the actual content after a successful login - that is what I wanted to avoid.
It also works with invalidateLater(), but also only temporary.
library(shiny)
library(shinydashboard)
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
observeEvent(input$btn_login, {
state$LoggedIn = !state$LoggedIn
})
ui1 <- reactive({
fixedPage(actionButton("btn_login", "Login"))
})
ui2 <- reactive({
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody(
sliderInput("slider", "slider", min = 1, max = 10, value = 2)
))
invalidateLater(100, session)
ui2
})
output$ui <- renderUI({if (!state$LoggedIn) ui1() else ui2()})
}
shinyApp(ui, server)
Not sure this is the kind of solution you are after, but here's my attempt using shinyjs and some CSS. It seems hard to switch from a fixedPage to a dashboardPage, so if you really want to use shinydashboard, I would stick with shinydashboard and disable the dashboard look on the login page.
library(shiny)
library(shinyjs)
library(shinydashboard)
ui1 <- div(
id = "login-page",
actionButton("btn_login", "Login")
)
ui2 <- hidden(
div(
id = "main-page",
sliderInput("slider", "slider", 3, 2, 2)
)
)
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(collapsed = TRUE),
dashboardBody(useShinyjs(),
tags$head(
tags$style(
HTML('.main-header {
display: none;
}
.header-visible {
display: inherit;
}')
)
),
fluidPage(ui1, ui2)
)
)
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
observeEvent(input$btn_login, {
state$LoggedIn = TRUE
shinyjs::addClass(selector = "header", class = "header-visible")
shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
shinyjs::hide(id = "login-page")
shinyjs::show(id = "main-page")
})
}
shinyApp(ui, server)
If you want to be able to come back to the login page, you can always add a login button that shows the login page, and hides the appropriate elements (sidebar/header/current page).
The first MWE below generates an empty Shiny dashboard application:
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody()
ui1 <- dashboardPage(header, sidebar, body)
server <- function(input, output){}
shinyApp(ui = ui1, server = server)
I'm trying to generate the same UI page but dynamically from the server side, as done in the second example below where the second page is displayed only when the correct password is written. It works, however the page design is gone:
library(shiny)
library(shinydashboard)
# UI1 ####
ui1 <- fluidPage(
textInput('password', label = 'Say hello')
)
# UI2 ####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody()
ui2 <- dashboardPage(header, sidebar, body)
# Server ####
server <- function(input, output){
status <- reactiveValues(logged = F)
observeEvent(input$password,{
if(input$password == 'hello'){
status$logged <- T
}
})
output$uipage <- renderUI({
if(status$logged){
ui2
} else {
ui1
}
})
}
# UI ####
ui <- uiOutput("uipage")
shinyApp(ui = ui, server = server)
Any idea how to solve this behaviour?
You cannot have 2 ui's (as far as I understand), but you can change part of it. For instance, the dashboard body. I hope this solutions works. If you are trying to have a login page, you probably would like to look at this and this
library(shiny)
library(shinydashboard)
# Ui ####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(uiOutput("uipage"))
ui <- dashboardPage(header, sidebar, body)
# Server ####
server <- function(input, output) {
output$uipage <- renderUI({
fluidPage(
textInput('password', label = 'hello')
)
})
observeEvent(input$password,{
if(input$password == 'hello'){
output$uipage <- renderUI({
fluidPage(
selectInput('enter', label = 'Say hello',choices = c("hello","world"))
)
})
}
})
}
shinyApp(ui = ui, server = server)