Below I display 2 attempts.I have a shiny dashboard with tabPanels. I would like to create the tabPanels of the tabPanel Data automatically based on the Uni dataframe. In my first try below those tabPanels are commented out inorder to make clear what I mean.
Uni<-data.frame(NAME=c("A","B","C"))
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
title = "Tabs"
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table"),
tabsetPanel(
id ="tabA",
type = "tabs",
for(i in 1:nrow(Uni)){
tabPanel(
paste0(Uni[i,1])
,icon = icon("table"))
}
#tabPanel("A",icon = icon("table")),
#tabPanel("B", icon = icon("table")),
#tabPanel("C", icon = icon("table"))
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
and my 2nd attempt:
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
title = "Tabs"
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table"),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
uiOutput("panels")
#tabPanel("A",icon = icon("table")),
#tabPanel("B", icon = icon("table")),
#tabPanel("C", icon = icon("table"))
)
)
)
)
)
server <- function(input, output) {
output$panels <- renderUI({
pan = lapply(1:length(Uni), function(i)
tabPanel(Uni[i,1],icon = icon("table")))
do.call(tabBox,pan)
})
}
shinyApp(ui = ui, server = server)
You have to write the entire tabSetPanel in a do.call statement. tabSetPanels never listen to a list of objects.
Uni<-data.frame(NAME=c("A","B","C"))
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
title = "Tabs"
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table"),
do.call(tabsetPanel,
c(id='tabA',
type="tabs",
lapply(1:nrow(Uni), function(i) {
tabPanel(Uni[i,],icon = icon("table"))
}))
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Related
How is it possible to hide the left sidebar of a shinydashboard() totally without also affecting the header section that almost hides the title by using the toggle button that is already there?
## app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "dashboard"
),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table")
)
)
),
controlbar = dashboardControlbar()
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Just use shinydashboardPlus::dashboardSidebar()'s minified parameter:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "dashboard"),
dashboardSidebar(minified = FALSE),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table")
)
)
),
controlbar = dashboardControlbar()
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
Maybe you can call the shinydashboard::dashboardSidebar instead:
ui <- dashboardPage(
dashboardHeader(title = "dashboard"),
shinydashboard::dashboardSidebar(collapsed = TRUE,disable =TRUE),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table")
)
)
),controlbar = dashboardControlbar()
)
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")
),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
The above example, the output renders when the tabs dashboard and widgets are clicked seperately. In the dashboard tab, i have my slider input in the body.
Now when I change my slider to have it at the sidebar:
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable"),
),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
set.seed(122)
histdata <- rnorm(500)
output$myPlot = renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
Problem here:
1) The text placeholder cloud, initially only rendered when the tab menuItem2 is clicked, now gets rendered together with the histogram which was supposed to render only when i clicked menuItem1
2) clicking on menuItem2 does not do anything. I would like to have tab2 when clicked, show a scatterplot as seen in this below block of code.
i.e., i would like to "integrate the below 3rd block of code" into the 2nd, the above so when i run the second block of code, when i click tab1, the input for the slider appears and renders the histogram. when i click tab2, the scatterplot will be rendered
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1")
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable")),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
output$myPlot = renderPlot({
plot(plotData())
})
}
shinyApp(ui, server)
Any help is appreciated.I am new to Shiny.
for your 2nd part you said "clicking on menuItem2 does not do anything."... but you don't have any action for menuItem2 see
menuItem("menuItem2", tabName = "tab2")
I started building my first shiny app but am now struggling with a strange behaviour. First, when I initially load the app, no tab is selected by default. Second, when clicking on any menu on the sidebar it shows the body only on the first time. When I go from "Overview" to "Pivot-Tabelle" and back, the body is blank. What am I missing? Below is the code I used.
library(shiny)
library(shinydashboard)
df<-data.frame(a=c(1,2,3,4),
b=c("A","B","C","D"))
###################Beginn der App################
ui <- dashboardPage(
# Application title
dashboardHeader(),
##----DashboardSidebar----
dashboardSidebar(
menuItem("Overview", tabName = "overview",selected=TRUE),
menuItem("Pivot-Tabelle", tabName = "pivot"),
menuItem("Test", tabName = "farmer")
),
##----DashboardBody----
dashboardBody(
tabItems(
##----TabItem: Overview----
tabItem(tabName="overview",
fluidRow(
valueBoxOutput("A"),
valueBoxOutput("B")
)
),
###----TabItem:Pivot----
tabItem(tabName = "pivot",
##Pivot
column(6,offset=4,titlePanel("Daten-Explorer")),
column(12,
mainPanel(
rpivotTableOutput("pivot")
)
)
),
##----TabItem:Test----
tabItem(tabName = "Test",
h2("In Progress"))
)
)
)
server <- function(input, output) {
##----server:overview----
output$A<-renderValueBox({
valueBox(
paste0(25, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
output$B<-renderValueBox({
valueBox(
paste0(55, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
##----server:pivot----
output$pivot <- renderRpivotTable({
rpivotTable(data = df)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This seems to work. You need to have sidebarMenu for your menuItems. Also, you need to change tabName to farmer so it matches your menuItem. And I don't think you need mainPanel in there (you can use mainPanel with sidebarPanel as part of a sidebarLayout if you wanted that layout - see layout options). See if this works for you.
library(shiny)
library(shinydashboard)
library(rpivotTable)
df<-data.frame(a=c(1,2,3,4),
b=c("A","B","C","D"))
###################Beginn der App################
ui <- dashboardPage(
# Application title
dashboardHeader(),
##----DashboardSidebar----
dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName = "overview",selected=TRUE),
menuItem("Pivot-Tabelle", tabName = "pivot"),
menuItem("Test", tabName = "farmer")
)
),
##----DashboardBody----
dashboardBody(
tabItems(
##----TabItem: Overview----
tabItem(tabName="overview",
fluidRow(
valueBoxOutput("A"),
valueBoxOutput("B")
)
),
###----TabItem:Pivot----
tabItem(tabName = "pivot",
##Pivot
column(6,offset=4,titlePanel("Daten-Explorer")),
column(12,
#mainPanel(
rpivotTableOutput("pivot")
#)
)
),
##----TabItem:Test----
tabItem(tabName = "farmer",
h2("In Progress"))
)
)
)
server <- function(input, output) {
##----server:overview----
output$A<-renderValueBox({
valueBox(
paste0(25, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
output$B<-renderValueBox({
valueBox(
paste0(55, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
##----server:pivot----
output$pivot <- renderRpivotTable({
rpivotTable(data = df)
})
}
# Run the application
shinyApp(ui = ui, server = server)
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)
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)