Show all object with renderUI - r

I'm working on a shiny app with dynamic rendering. When the user uncheck the box, he must have an output with 8 wellPanel and when the box is checked, he must have two wellPanel. I used the function renderUI to generate output but when the box is unchecked, I only have 4 wellPanel instead of 8. This is what I did :
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
body <- dashboardBody(
tabItems(
tabItem(tabName = "menutab1",
checkboxInput(inputId = "my_id", "check the box", value = TRUE),
####### renderUI #####
uiOutput("results")
)
)
)
ui <- dashboardPage(
title = "test",
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(disable = FALSE),
sidebar = dashboardSidebar(
minified = TRUE, collapsed = TRUE,
sidebarMenu(id="mymenu",
menuItem("first", tabName = "tab1", icon = icon("fas fa-acorn"),
menuSubItem('menu 1',
tabName = 'menutab1',
icon = icon('fas fa-hand-point-right'))
)
)
),
body
)
############# SERVER ############
server <- function(input, output) {
output$results <- renderUI({
if(input$my_id){
# object 1
fluidRow(
column(6,
wellPanel(
h1("A")
),
br(),
wellPanel(
h1("B")
)
)
)
} else {
# object 2 : doesnt show, why ?
fluidRow(
column(6,
wellPanel(
h1("C")
),
br(),
wellPanel(
h1("D")
)
),
column(6,
wellPanel(
h1("E")
),
br(),
wellPanel(
h1("F")
)
)
)
# object 3 : I only got this
fluidRow(
column(6,
wellPanel(
h1("H")
),
br(),
wellPanel(
h1("I")
)
),
column(6,
wellPanel(
h1("J")
),
br(),
wellPanel(
h1("K")
)
)
)
}
})
}
############# RUN #############
shinyApp(ui = ui, server = server)
How can we fix that ?
Some help would be appreciated

The problem with your above code is, that only the last object of the else statement is returned. You can wrap both fluidRows in a tagList to get the desired output.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
body <- dashboardBody(tabItems(tabItem(
tabName = "menutab1",
checkboxInput(inputId = "my_id", "check the box", value = TRUE),
uiOutput("results")
)))
ui <- dashboardPage(
title = "test",
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(disable = FALSE),
sidebar = dashboardSidebar(
minified = TRUE,
collapsed = TRUE,
sidebarMenu(
id = "mymenu",
menuItem(
"first",
tabName = "tab1",
icon = icon("fas fa-acorn"),
menuSubItem(
'menu 1',
tabName = 'menutab1',
icon = icon('fas fa-hand-point-right')
)
)
)
),
body
)
server <- function(input, output) {
output$results <- renderUI({
if (input$my_id) {
fluidRow(column(6,
wellPanel(h1("A")),
br(),
wellPanel(h1("B"))
)
)
} else {
tagList(
fluidRow(
column(6,
wellPanel(h1("C")),
br(),
wellPanel(h1("D"))),
column(6,
wellPanel(h1("E")),
br(),
wellPanel(h1("F")))
),
fluidRow(
column(6,
wellPanel(h1("H")),
br(),
wellPanel(h1("I"))),
column(6,
wellPanel(h1("J")),
br(),
wellPanel(h1("K")))
)
)
}
})
}
shinyApp(ui = ui, server = server)

Related

How to display content in nested tab menu structure (3 levels)?

In order to achieve a menu item, with two sub-levels, I wrote the code below. As you can see, the text in the subMenuItems is getting displayed properly. However, when the top level tab is selected, I want to display an empty page and on the second level (menuItem inside menuItem), I want to display the text "second".
What do I need to change, in order to get there?
# shiny lib
library(shiny)
library(shinythemes)
library(shinydashboard)
# UI
ui <- dashboardPage(
dashboardHeader(title = "Test"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Top_Level", tabName = "first",
icon = icon("chart-line"),
menuItem("Second_level",
tabName = "second",
menuSubItem("Summary",
tabName = "third1",
),
menuSubItem("Details",
tabName = "third2",
)
)
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "first",
mainPanel(width = 100,
fluidPage(fluidRow(
p("")
)
)
)
),
tabItem(tabName = "second",
mainPanel(width = 100,
fluidPage(fluidRow(
p("second")
)
)
)
),
tabItem(tabName = "third1",
mainPanel(width = 100,
fluidPage(fluidRow(
p("third.1")
)
)
)
),
tabItem(tabName = "third2",
mainPanel(width = 100,
fluidPage(fluidRow(
p("third.2")
)
)
)
)
)
)
)
# server
server <- function(input, output, session) {
renderText(output$first)
renderText(output$second)
renderText(output$third1)
renderText(output$third2)
}
runApp(list(ui = ui, server = server), launch.browser = TRUE)

Is it possible to add a sidebarPanel and a mainPanel in each tabPanel using navbarPage?

I have at least 2 individual apps that I want to join in one single app. Although I was using shinyDashboard, I think that it could be a good idea to try with navbarPage.
However, I don't know if it is possible to do what I want with this new approach.
To put you in a context, this is an example of my shinyDashboard. Each tab has a sidebarPanel and mainPanel. I replicated the info in all the tabs, but the idea is that each tab has different things.
However, I was thinking to have this using navbarPage. Do you know if it is possible?
Here I attach you the code that I used for the shinyDashboard:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1", icon = icon("th")),
menuItem("Tab2", tabName = "Tab2", icon = icon("th")),
menuItem("Tab3", tabName = "Tab3", icon = icon("th"))
)
),
dashboardBody(
fluidRow(
tabItems(
tabItem(tabName = "Tab1",
sidebarPanel(
numericInput("num",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove", "Remove...", value = FALSE),
sliderInput("slider", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot1")
)
),
tabItem(tabName = "Tab2",
sidebarPanel(
numericInput("num2",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove2", "Remove...", value = FALSE),
sliderInput("slider2", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot2")
)
),
tabItem(tabName = "Tab3",
sidebarPanel(
numericInput("num3",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove3", "Remove...", value = FALSE),
sliderInput("slider3", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot3")
)
)
)
)
)
)
server <- function(input, output, session) {
output$plot1 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
output$plot2 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
output$plot3 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
}
shinyApp(ui, server)
And the code for the navbarPage approach:
library(shinythemes)
library(shiny)
ui <- fluidPage(theme = shinytheme("flatly"),
navbarPage(
collapsible = T,
fluid = T,
"",
tabPanel("Tab 1", "one"),
tabPanel("Tab 2", "two"),
tabPanel("Tab 3", "three"),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Thanks very much in advance
You can do that with sidebarLayout. Here I've done it for the first tabPanel:
library(shinythemes)
library(shiny)
ui <- fluidPage(
theme = shinytheme("flatly"),
navbarPage(
title = "Your App Title",
collapsible = TRUE,
fluid = TRUE,
tabPanel(
title = "Tab 1",
sidebarLayout(
sidebarPanel = sidebarPanel(
tags$h3(
"Sidebar Content Here!"
)
),
mainPanel = mainPanel(
tags$h3(
"Main Panel Content Here!"
)
)
)
),
tabPanel(
title = "Tab 2",
"three"
),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)

Shiny: Re-using the same plot in multiple tabs is not working

I am trying to create a shiny dashboard that has two tabs.
First tab (called: dashboard) shows two graphs, and the other one (called: widgets) is intended to show the first graph from the first tab (called: mpg) and below it is the rpivottable.
Problem is that the moment I add graphs/rpivottable to the second tab, all the graphs disappear.
I figured that the moment I take away the content of the second tab, the dashboard starts displaying the first tab content. Any idea why it is happening and how to fix it ?
Sample code:
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(writexl)
library(readxl)
library(stringr)
library(ggplot2)
library(rpivotTable)
ui <- dashboardPage(skin = 'green',
dashboardHeader( title = "Test", titleWidth = 280),
dashboardSidebar(width = 280,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Pivot", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(5, 'Mpg Table') ),
br(),
fluidRow(
rHandsontableOutput ('mpg')),
br(),
fluidRow(
column(5,'mtcars Summary')),
br(),
fluidRow(
column(3),column(6, tableOutput ('mtcars')),column(3))
),
# Second tab content
tabItem(tabName = "widgets",
fluidRow(
column(5,'Mpg table')),
br(),
fluidRow(
rHandsontableOutput ('mpg')),
br(),
fluidRow(
rpivotTableOutput('pivot')
)
)
)
)
)
server <- shinyServer(function(input, output) {
#mpg
output$mpg <- renderRHandsontable ({ rhandsontable({
mpg[1,] })
})
#mtcars
output$mtcars <-renderTable ({
head(mtcars)})
# pivot table
output$pivot <- renderRpivotTable({ rpivotTable(mtcars)})
})
shinyApp(ui, server)
You cannot re-use the same id to bind multiple outputs (Look here). So one option would be to give the mpg table a unique id in both tabs and render the table output twice in the server with: output$mpg1 <- output$mpg2 <- renderRHandsontable ({}).
Working example:
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(writexl)
library(readxl)
library(stringr)
library(ggplot2)
library(rpivotTable)
ui <- dashboardPage(skin = 'green',
dashboardHeader(title = "Test", titleWidth = 280),
dashboardSidebar(width = 280,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Pivot", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(5, 'Mpg Table') ),
br(),
fluidRow(
rHandsontableOutput ('mpg1')),
br(),
fluidRow(
column(5, 'mtcars Summary')),
br(),
fluidRow(
column(3),
column(6, tableOutput ('mtcars')),column(3))
),
# Second tab content
tabItem(tabName = "widgets",
fluidRow(
column(5,'Mpg table')),
br(),
fluidRow(
rHandsontableOutput ('mpg2')),
br(),
fluidRow(
rpivotTableOutput('pivot'))
)
)
)
)
server <- shinyServer(function(input, output) {
#mpg
output$mpg1 <-output$mpg2<- renderRHandsontable ({
rhandsontable({
mpg[1,]})
})
#mtcars
output$mtcars <-renderTable ({
head(mtcars)})
# pivot table
output$pivot <- renderRpivotTable({rpivotTable(mtcars)})
})
shinyApp(ui, server)
simple example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(skin = 'green',
dashboardHeader( title = "Test", titleWidth = 280),
dashboardSidebar(width = 280,
sidebarMenu(
menuItem(text = "Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem(text = "Pivot", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(5, 'Mpg Table') ),
br(),
fluidRow(column(width = 12, plotOutput("plot1")
)
)),
# Second tab content
tabItem(tabName = "widgets",
fluidRow(
column(5,'Mpg table')),
br(),
fluidRow(column(width = 6, plotOutput("plot2")),
column(width = 6, plotOutput("plot3"))
),
br(),
fluidRow(column(width = 12, plotOutput("plot4"))
)
)
)
)
)
server <- shinyServer(function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(1000))
})
output$plot2 <- renderPlot({
plot(rnorm(1000), rnorm(1000))
})
output$plot3 <- renderPlot({
boxplot(rnorm(100))
})
output$plot4 <- renderPlot({
ts.plot(rnorm(100))
})
})
shinyApp(ui, server)

shinydashboard: menuSubItem not rendering at start in case of several menuSubItems

I found that menuSubItem content is not rendering in case of several (more than one) tabItems.
Minimal example demonstrating this behavior is below.
The desired behavior is to show content of the tabItem marked as selected = TRUE on startup. Now, the content shows up only after switching between menuSubItems in the sidebar.
How can I make it work?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("body")
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
output$body <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
}
shinyApp(ui = ui, server = server)
Indeed, putting ui elements directly in UI solves it.
But the approach of putting everything inside ui is limited to situations that do not involve using reactive values. As I understand passing reactive value from server to ui is not possible in general (or limited to special cases). Please correct if I am wrong... Thanks
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)
Renaming your output to something other than "body" helps - please see this.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("myBodyOutput")
)
)
server <- function(input, output, session) {
output$myBodyOutput <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
output$menu <- renderMenu(
sidebarMenu(id = "sidebarID",
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)

Hide any tabpanel in shiny

I have a tabsetPanel() and I try to hide one tabPanel() if choice is two and checkbox is on. I tried the following code to do that, however it does not work.
ui
shinyUI(
fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
radioButtons("radio", label = h5("Data uploaded"),
choices = list("Aff" = 1, "Cod" = 2,
"Ill" = 3),selected = 1)
)),
checkboxInput("checkbox", "cheb", value = F)
),
mainPanel(
tabsetPanel(
tabPanel("Plot", "plot1"),
conditionalPanel(
condition = "input.radio !=2 && input.checkbox == false",
tabPanel("Summary", "summary1")
),
tabPanel("Table", "table1")
)
)
)
)
)
server
shinyServer(function(input,output,session){
})
How can I hide a tabPanel()?
You could do it with renderUI():
Create the tabpanels() in a list within the renderUI()
and conditionally add the third one:
if(input$radio == 2 & !input$checkbox)
and then return the whole tabsetPanel() with do.call(tabsetPanel, panels).
ui <- shinyUI(
fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
radioButtons("radio", label = h5("Data uploaded"),
choices = list("Aff" = 1, "Cod" = 2,
"Ill" = 3),selected = 1)
)),
checkboxInput("checkbox", "cheb", value = F)
),
mainPanel(
uiOutput("summary")
)
)
)
)
server <- shinyServer(function(input,output,session){
output$summary <- renderUI({
panels <- list(
tabPanel("Plot", "plot1"),
tabPanel("Table", "table1")
)
if(input$radio == 2 & !input$checkbox) panels[[3]] <- tabPanel("Summary", "summary1")
do.call(tabsetPanel, panels)
})
})
shinyApp(ui, server)

Resources