I am trying to use plotOutput in R shiny in multiple sub-menu items. However, I believe it is not possible for plotOutput to be used at multiple places with same id. Please help me if it is possible somehow. attaching the snapshot for reference.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
))),
dashboardBody(
tabItems(tabItem("subitem1", 3),
tabItem("subitem2", plotOutput("brand_selector")))
))
server <- shinyServer(function(input, output) {
output$brand_selector <- renderPlot({
plot(iris$Sepal.Length)
})
})
shinyApp(ui = ui, server = server)
Update
library(shiny)
library(shinydashboard)
submenuUI <- function(id) {
ns <- NS(id)
# return a list of tags
tagList(
column(2,offset = 0, style='padding:1px;',
selectInput(ns("select1"),"select1",c("A1","A2","A3","A2","A1","A3","A1"))),
column(2,offset = 0, style='padding:1px;',
selectInput(ns("select2"),"select2",c("B3","B4","B5","B3","B6","B2","B3")))
)
}
submenu <- function(input,output,session){}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2"),
menuSubItem("Sub-item 3", tabName = "subitem3"),
menuSubItem("Sub-item 4", tabName = "subitem4")
))),
dashboardBody(
tabItems(tabItem("subitem1", submenuUI('submenu1')),
tabItem("subitem2", submenuUI('submenu2')),
tabItem("subitem3", submenuUI('submenu3')),
tabItem("subitem4", "Sub-item 2 tab content"))))
server <- function(input, output, session) {
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',
choices= input$select2[input$Select1 == "A1"] )
})
callModule(submenu, "submenu")
}
shinyApp(ui, server)
Please help me to update the second selectInput based on input from the previous selectInput.
This is the modularized code for multiple plotting: Very similar to the selectInput one.
library(shiny)
library(shinydashboard)
plotopUI <- function(id) {
ns <- NS(id)
# return a list of tags
tagList(
plotOutput(ns('plt'))
)
}
plotop <- function(input,output,session){
ns <- session$ns
output$plt <- renderPlot({
plot(iris$Sepal.Length)
})
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
))),
dashboardBody(
tabItems(tabItem("subitem1", plotopUI('plt1')),
tabItem("subitem2", plotopUI('plt2')))))
server <- function(input, output, session) {
callModule(plotop, "plt1")
callModule(plotop, "plt2")
}
shinyApp(ui, server)
Related
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 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)
In a shinydashboard with several tabs like here
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Sample Shiny"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab1"),
menuItem("Tab 2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(
"tab1",
fluidRow(
box(title = "Foo")
)
),
tabItem(
"tab2",
fluidRow(
box(title = "Bar")
)
)
)
)
)
server <- function(input, output) { }
shinyApp(ui = ui, server = server)
is it possible to let the application switch the active tab periodically? I want to have the dashboard on my screen with switching the active tab every x minutes.
I already checked the Shiny docs for a solution but haven't found an appropriate function. But maybe I simply overlooked such a feature. If Shiny does not offer a suitable feature, is it possible to include some custom JavaScript that does the job?
Here's a way to do it, using invalidateLater and updateTabItems:
app.R:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Sample Shiny"),
dashboardSidebar(
sidebarMenu(
id = 'tabs',
menuItem("Tab 1", tabName = "tab1"),
menuItem("Tab 2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(
"tab1",
fluidRow(
box(title = "Foo")
)
),
tabItem(
"tab2",
fluidRow(
box(title = "Bar")
)
)
)
)
)
tabnames = c('tab1', 'tab2')
server <- function(input, output, session) {
#keep track of active tab
active <- reactiveValues(tab = 1)
observe({
#Change every 5 secs, you can set this to whatever you want
invalidateLater(5000,session)
#update tab
isolate(active$tab <- active$tab%%length(tabnames) + 1)
updateTabItems(session,'tabs',tabnames[active$tab])
})
}
shinyApp(ui = ui, server = server)
I am trying to build a shiny application using sidebarMenu with menuItems. Currently the menu items are duplicated,
enter image description here
Clicking the first and second menu items are not showing the table or the plot. Only the last two shows the output. How can I modify it to have only two items - 1) Plots Menu, 2) Table Menu (with sub items) and clicking on it show the respective output. Used the mtcars dataset and the code ispasted below
data(mtcars)
ibrary(shiny)
library(shinydashboard)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(
menuItem("Plots Menu", tabName = "plot_page", icon = icon("line-chart")),
menuItem("Table Menu", tabName="intro_page", icon = icon("info"),
selectInput(inputId = "mcm", label = "Some label",
multiple = TRUE, choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)))
),
sidebarMenuOutput("menu")
),
dashboardBody(tabItems(
tabItem(tabName = "plots", h2("Dashboard plots"),
fluidRow(column(width = 12, class = "well",
h4("Boxplot"),
plotOutput("bxp")))
),
tabItem(tabName = "dashboard", h2("Dashboard tab content"),
dataTableOutput(outputId = "subdt"))
)
)
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", tabName="dashboard", icon = icon("calendar"))
)
})
datsub <- reactive({
mtcars %>%
filter_at(vars("cyl"), all_vars(. %in% input$mcm))
})
output$subdt <- renderDataTable({
datsub()
})
output$bxp <- renderPlot({
hist(rnorm(100))
})
}
shinyApp(ui, server)
I put the code together.
-Ian
data(mtcars)
library(shiny)
library(shinydashboard)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu"))),
dashboardBody(tabItems
(
tabItem
(tabName = "plots", h2("Dashboard plots"),
fluidRow(column(width = 12, class = "well",
h4("Boxplot"),
plotOutput("bxp")))
),
tabItem(tabName = "dashboard", h2("Dashboard tab content"),
dataTableOutput(outputId = "subdt"))
)
)
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", icon = icon("info"),
menuSubItem(
"Dashboard", tabName = "dashboard", icon = icon("calendar")
),
selectInput(
inputId = "mcm", label = "Some label", multiple = TRUE,
choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
)
)
)
})
datsub <- reactive({
mtcars %>%
filter_at(vars("cyl"), all_vars(. %in% input$mcm))
})
output$subdt <- renderDataTable({
datsub()
})
output$bxp <- renderPlot({
hist(rnorm(100))
})
}
shinyApp(ui, server)
You have both the standard and reactive sidebar options running in tandem. If you need a reactive sidebar, just put the contents in the server function and call all of it with sidebarMenuOutput in ui.
ui.R
dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu")))
server.R
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", icon = icon("info"),
menuSubItem(
"Dashboard", tabName = "dashboard", icon = icon("calendar")
),
selectInput(
inputId = "mcm", label = "Some label", multiple = TRUE,
choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
)
)
)
})
library(shiny)
library(shinydashboard)
ui <- dashboardPage( skin="blue",title = "asdfasf",
dashboardHeader(title = "Fund Analysis Status Tool",titleWidth=255, .list=NULL),
dashboardSidebar( width = 255, sidebarMenu(menuItem("Analysis", icon = icon("th"),menuSubItem("ME-1", tabName = "Analysis-ME-1"),
menuSubItem("Current", tabName = "Analysis-Current")),menuItem("Post-Analysis1",icon = icon("th"),menuSubItem("ME-1", tabName = "Post_Analysis-ME-1"),menuSubItem("Current", tabName = "Post_Analysis-Current")))), # it gives heading in the left panel
dashboardBody(
tabItems(tabItem(tabName = "Analysis-ME-1",fluidRow(box(dataTableOutput('table')),box(title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)))),
tabItem(tabName = "Analysis-Current",h2("To be discussed1")),
# Second tab content
tabItem(tabName = "Post_Analysis-ME-1", h2("To be discussed1")),
tabItem(tabName = "Post_Analysis-Current",h2("To be discussed2")))))
server <- function(input, output) {
histdata <- rnorm(500)
output$table <- renderDataTable(iris)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
This is largely a matter of opinion on how you go about this. I've reorganized your code to how I might approach it below.
In the few applications I've built, my choice of strategy has varied by how large the application is. In smaller applications, I'll source in functions or define them in global.R and then use those functions throughout the application. More recently, I've started just writing each application as a stand alone package.
Either way, the general process is to break your application into small steps, write each of those steps into a function with a descriptive name (brevity isn't necessarily a virtue here), and then call the functions to generate your application.
library(shiny)
library(shinydashboard)
#* Put these in your global.R file, perhaps.
dashboard_header <- function(){
dashboardHeader(
title = "Fund Analysis Status Tool",
titleWidth=255,
.list=NULL
)
}
dashboard_sidebar <- function(){
dashboardSidebar(
width = 255,
sidebarMenu(
menuItem("Analysis", icon = icon("th"),
menuSubItem(
"ME-1",
tabName = "Analysis-ME-1"
),
menuSubItem(
"Current",
tabName = "Analysis-Current"
)
),
menuItem(
"Post-Analysis1",
icon = icon("th"),
menuSubItem(
"ME-1",
tabName = "Post_Analysis-ME-1"
),
menuSubItem(
"Current",
tabName = "Post_Analysis-Current"
)
)
)
)
}
tab_items <- function(){
tabItems(
# First tab content
tabItem(
tabName = "Analysis-ME-1",
fluidRow(
box( dataTableOutput('table') )
),
box(
title = "Controls",
sliderInput(
"slider",
"Number of observations:",
1,
100,
50
)
)
),
tabItem(
tabName = "Analysis-Current",
h2("To be discussed1")
),
# Second tab content
tabItem(
tabName = "Post_Analysis-ME-1",
h2("To be discussed1")
),
tabItem(
tabName = "Post_Analysis-Current",
h2("To be discussed2")
)
)
}
#***************************
#***************************
#* And now the ui and server
ui <-
dashboardPage(
skin="blue",
title = "asdfasf",
dashboard_header(),
dashboard_sidebar(),# it gives heading in the left panel
dashboardBody(
tab_items()
)
)
server <- shinyServer(function(input, output) {
histdata <- rnorm(500)
output$table <- renderDataTable(iris)
output$plot1 <- renderPlot({ data <- histdata[seq_len(input$slider)]
hist(data) })
})
shinyApp(ui, server)