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
Related
I would like to clear a datatable with an actionButton.
The chunk does work, but the table is still there. How can I update the content of the table when the actionButton is pressed?
Please find the toy sampel as following.
library(shiny)
library(shinydashboard)
library(DT)
DT1 <- iris
shinyApp(
ui <-
dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(),
dashboardBody(
DTOutput("DT"),
actionButton("clear", "clear")
)
),
server <-
function(input, output, session) {
output$DT <- renderDT(datatable(DT1))
observeEvent(input$clear, {
DT1 <- data.frame()
})
}
)
This is what you need -
server <- function(input, output, session) {
dt_data <- reactiveValues(dt_data = iris)
observeEvent(input$clear, {
dt_data$dt_data <- data.frame() # use iris[0, ] if you want empty df
})
output$DT <- renderDT(datatable(dt_data$dt_data))
}
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 want to render the elements of each list to a valuebox.
i am able to show the element of single list like below example (run the code for ex) but not nested list.
what i want is to have valuebox which consist of elements of all list.
Please run the code to get the idea.Thankyou
#this should be the result:
1stvaluebox 2ndvaluebox 3rdvaluebox 4thvaluebox
A C E H
Kim John Satish Kevin
1 2 3 4
#Data and code
list_data <- list(letters = c("A","C","E","H"),names = c("Kim","John","Satish","Kevin"),numbers = 1:4)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_entities")
)
)
)
)
)
)
)
server <- function(input, output) {
output$nlp_entities <- renderUI({
a <- lapply(list_data[[1]], function(x) {
valueBox(x,"names")
})
tagList(a)
})
}
shinyApp(ui = ui, server = server)
You can iterate from 1 to the length of sub-list and with each iteration extract wanted information.
server <- function(input, output) {
output$nlp_entities <- renderUI({
a <- list()
for(i in seq_len(lengths(list_data)[1])) {
a[[i]] <- valueBox(lapply(list_data[c(1, 3)], "[[", i),
list_data[[2]][i])
}
tagList(a)
})
}
I'm currently trying to set up a UI that is creating valueBoxes dynamically.
I' picked up the code shown here which does exactly what I want, but using plots.
Actually the following works, but the boxes aren't rendered as expected:
library(shiny)
library(shinydashboard)
ui <- pageWithSidebar(
headerPanel("Dynamic number of valueBoxes"),
sidebarPanel(
selectInput(inputId = "choosevar",
label = "Choose Cut Variable:",
choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
),
mainPanel(
# This is the dynamic UI for the plots
uiOutput("plots")
)
)
server <- function(input, output) {
#dynamically create the right number of htmlOutput
# renderUI
output$plots <- renderUI({
plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
plotname <- paste0("plot", i)
# valueBoxOutput(plotname)
htmlOutput(plotname)
})
tagList(plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
local({
my_i <- i
plotname <- paste0("plot", my_i)
output[[plotname]] <- renderUI({
valueBox(
input$choosevar,
my_i,
icon = icon("credit-card")
)
})
})
}
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks for any hints!
You are mixing shinydashboard elements with normal shiny-uis. You have to create a dashboard-ui, as the valueboxes are for dashboards.
The following should work:
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "Dynamic number of valueBoxes"),
dashboardSidebar(
selectInput(inputId = "choosevar",
label = "Choose Cut Variable:",
choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
),
dashboardBody(
uiOutput("plots")
)
)
server <- function(input, output) {
#dynamically create the right number of htmlOutput
# renderUI
output$plots <- renderUI({
plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
plotname <- paste0("plot", i)
valueBoxOutput(plotname)
# htmlOutput(plotname)
})
tagList(plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
local({
my_i <- i
plotname <- paste0("plot", my_i)
output[[plotname]] <- renderUI({
valueBox(
input$choosevar,
my_i,
icon = icon("credit-card")
)
})
})
}
}
# Run the application
shinyApp(ui = ui, server = server)
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)