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)
Related
I have a simple ui/server modules. When I try using uiOutput/renderUI, the disable/enable function does not work. But, if I call ui module directly in the ui, it works fine.
library(shiny)
library(shinyjs)
library(shinydashboard)
my_UI <- function(id = "xyz") {
ns <- NS(id)
tagList(
downloadButton(ns("dl"), "Download")
)
}
my_Server <- function(id = "xyz") {
moduleServer(id,
function(input, output, session) {
disable("dl")
}
)
}
ui <- dashboardPage(
dashboardHeader(title = "test"),
dashboardSidebar(disable = TRUE),
dashboardBody(
useShinyjs(),
uiOutput("app_ui")
# my_UI()
)
)
server <- function(input, output, session) {
output$app_ui <- renderUI({
my_UI()
})
my_Server()
}
shinyApp(ui, server)
That's because the download button is not rendered yet when disable is executed. You can use shinyjs::delay to delay the execution. Actually this works with a delay of 0ms, because this function also puts the expression it executes in a queue.
my_Server <- function(id = "xyz") {
moduleServer(
id,
function(input, output, session) {
delay(0, disable("dl"))
}
)
}
We can also start with the button already disabled using shinyjs::disabled()
my_UI <- function(id = "xyz") {
ns <- NS(id)
tagList(
shinyjs::disabled(downloadButton(ns("dl"), "Download"))
)
}
I'm using the attached code to generate sub-tables based on groups. For some reason only the last portion of the data is rendered for every table.
It would be great if someone can tell me what is going wrong.
BR
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
tabnames <- LETTERS[1:6]
DT <- data.table(mtcars[1:30,], keep.rownames=TRUE)
DT[, grp:=rep(tabnames, each=trunc(nrow(mtcars)/length(tabnames)))]
ui = dashboardPage(
dashboardHeader(title = "Dynamic DTs"),
dashboardSidebar(),
dashboardBody(
uiOutput("tables"),
p(),
verbatimTextOutput("selectedCells")
)
)
server <- function(input, output, session) {
output$tables <- renderUI({
output_list <- list()
for(i in seq(tabnames)){
output_list[[i]] <- column(4, DT::dataTableOutput(outputId=tabnames[i]))
}
print(fluidRow(output_list))
return(fluidRow(output_list))
})
for(i in seq(tabnames)){
tabname <- tabnames[i]
local({
print(DT[grp %in% tabname, 1:3])
output[[tabname]] <- DT::renderDataTable({
DT[grp %in% tabname, 1:3]
}, selection=list(mode="multiple", target="cell"))
})
}
output$selectedCells <- renderPrint(input$A_cells_selected)
}
shinyApp(ui = ui, server = server)
Ok, found a solution: needed to pass it in a separate variable:
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
tabnames <- LETTERS[1:6]
DT <- data.table(mtcars[1:30,], keep.rownames=TRUE)
DT[, grp:=rep(tabnames, each=trunc(nrow(mtcars)/length(tabnames)))]
ui = dashboardPage(
dashboardHeader(title = "Dynamic DTs"),
dashboardSidebar(),
dashboardBody(
uiOutput("tables"),
p(),
verbatimTextOutput("selectedCells")
)
)
server <- function(input, output, session) {
output$tables <- renderUI({
output_list <- list()
for(i in seq(tabnames)){
output_list[[i]] <- column(4, DT::dataTableOutput(outputId=tabnames[i]))
}
print(fluidRow(output_list))
return(fluidRow(output_list))
})
for(i in seq(tabnames)){
tabname <- tabnames[i]
local({
subDT <- DT[grp %in% tabname, 1:3]
output[[tabname]] <- DT::renderDataTable({
subDT
}, selection=list(mode="multiple", target="cell"))
})
}
output$selectedCells <- renderPrint(input$A_cells_selected)
}
shinyApp(ui = ui, server = server)
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)
The dashboard page will not expand when more rows are shown from the DTOutput. The output is visible, but looks like it is no longer contained within the dashboard page.
ui <- function() {
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
mainPanel(width = 12,
fluidRow(DTOutput(outputId = "table"))
)))}
server <- function(input, output) {
data <- data.frame(1:100)
output$table <- renderDT(
data
)
}
shinyApp(ui = ui, server = server)
Screenshot of issue.
The gray background for the dashboard page ends around row 15.
This can be fixed by adding some CSS to the document:
section.content {
overflow-y: hidden;
}
MWE:
library(shiny)
library(shinydashboard)
library(DT)
library(htmltools)
ui <- function() {
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style("section.content { overflow-y: hidden; }")),
mainPanel(width = 12,
fluidRow(DTOutput(outputId = "table"))
)))}
server <- function(input, output) {
data <- data.frame(1:100)
output$table <- renderDT(
data
)
}
shinyApp(ui = ui, server = server)
I am using Shiny and I am trying to make a set of tabPanels appear dynamically based on a set of parameters. In the code below, I would like to make the first tabPanel appear only when showTab1 <- T and so on.
I tried with simple if statements and conditionalPanels but it fails. Below there is an example of code:
rm(list = ls())
library(shiny)
library(shinydashboard)
showTab1 <- T
showTab2 <- F
showTab3 <- T
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
),
dashboardBody(
uiOutput("tabs")
)
)
server <- function(input, output) {
output$tabs <- renderUI({
tabBox(width = 1000,height = 500,
if (showTab1 == T) { tabPanel("tab1") },
if (showTab2 == T) { tabPanel("tab2") },
if (showTab3 == T) { tabPanel("tab3") }
)
})
}
shinyApp(ui, server)
Thanks for your help.
Cheers,
Kostas
You can dynamically create them:
rm(list = ls())
library(shiny)
library(shinydashboard)
showTab1 <- T
showTab2 <- F
showTab3 <- T
ShowTotal <- which(c(showTab1,showTab2,showTab3))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("ui"))
)
server <- function(input, output) {
output$ui <- renderUI({
myTabs = lapply(paste('tab', ShowTotal), tabPanel)
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui, server)
Thanks for your answer earlier. Following your suggestion I think the following example can work for my case. The only issue I have is that in the end I cannot adjust the width and height of the tabBox.
library(shiny)
library(shinydashboard)
showTab1 <- T
showTab2 <- F
showTab3 <- T
ShowTotal <- which(c(showTab1,showTab2,showTab3))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("ui"))
)
server <- function(input, output) {
output$ui <- renderUI({
tabs <- list()
k <- 0
if (showTab1 == T){
k <- k+1
tabs[[k]] <- tabPanel("Tab1", p("A phrase"), br(""), p("I can place a chart here"))
}
if (showTab2 == T){
k <- k+1
tabs[[k]] <- tabPanel("Tab2", p("B phrase"), br(""), p("I can place a chart here"))
}
if (showTab3 == T){
k <- k+1
tabs[[k]] <- tabPanel("Tab3", p("C phrase"), br(""), p("I can place a chart here"))
}
do.call(tabBox, tabs)
})
}
shinyApp(ui, server)
Thanks,
Kostas