I am trying to use update my Shiny Dashboard Sidebar based on the tab selected in the Main body. So when tab "Overall" is selected then this should display the menu items in Conditional Panel 1 (TA.Name1,TA.Name2), and when tab "Other" is selected then the sidebar displays the menu items for conditional panel 2. Data is bellow:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
conditionalPanel(condition="input.conditionedPanels==1", sidebarMenu(width=150,
menuItem("TA.Name1", tabName = "TA1")),
menuItem("TA.Name2", tabName = "TA2"))),
conditionalPanel(condition="input.conditionedPanels==2",sidebarMenu(width=150,
menuItem("EA.Name1", tabName = "EA1")),
menuItem("EA.Name2", tabName = "EA2"))),
dashboardBody(
tabsetPanel(
tabPanel("Overall",value=1,fluidRow(
column(3,selectInput("PACO", h5("PACO"), levels(OA$PACO)))),
tabItems(
tabItem(tabName = "TA1","TA1"),fluidRow(
box(title="TA.Name1,dygraphOutput("TA1.data")),
box(title="TA.Name2,dygraphOutput("TA2.data")))),
tabItem(tabName = "TA2","TA2")
)),
tabPanel("Other",value=2,fluidRow(
column(3,selectInput("CV", h5("CV"), levels(OA$CV)))),
tabItems(
tabItem(tabName = "EA1","EA1"),fluidRow(
box(title="EA.Name1,dygraphOutput("EA1.data")),
box(title="EA.Name2,dygraphOutput("EA2.data")))),
tabItem(tabName = "EA2","EA2")
))))
Your Example Code is not good, i think You should have a look at this feed:
http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example
I had to simplify Your code to actually find solution...
Have a look at it:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id="tabs",
sidebarMenuOutput("menu"))),
dashboardBody(
tabsetPanel(id="tabs2",
tabPanel("Overall",value=1),
tabPanel("Other",value=2))))
server <- function(input, output, session) {
output$menu <- renderMenu({
if (input$tabs2 == 1 ) {
sidebarMenu(
menuItem("TA.Name1", tabName = "TA1"),
menuItem("TA.Name2", tabName = "TA2"))}
else{
sidebarMenu(
menuItem("EA.Name1", tabName = "EA1"),
menuItem("EA.Name2", tabName = "EA2"))
}
})
}
shinyApp(ui = ui, server = server)
It should do what You want -- > reactive sidebarMenu
Related
Im trying to add an actionButton() in the fist tabItem that when pressed will move to the second tabItem named widgets. I cannot understand what am I doing wrong.
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(id="inTabset",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
)
)
server <- function(input, output) {
tabItems(
# First tab content
tabItem(tabName = "dashboard",
"dashboard",
actionButton("nextt","Next")
),
# Second tab content
tabItem(tabName = "widgets",
"widgets"
)
)
observeEvent(input$nextt, {
updateTabItems(session, "inTabset",selected = "dashboard")
})
}
shinyApp(ui, server)
The issue is that you added the tabItems in the server instead of inside dashboardBody. Additionally, to switch from dashboard to widgets you have to do selected="widgets" in updateTabItems and finally your server should have an argument session:
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
id = "inTabset",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
actionButton("nextt", "Next")
),
tabItem(
tabName = "widgets"
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$nextt, {
updateTabItems(session, "inTabset", selected = "widgets")
})
}
shinyApp(ui, server)
I have the shiny dashboard below and as you see I want to display a datatable inside sidebar but the issue is that the table is much wider. Can I make the table fit in exactly in the sidebar without increasing sidbar width?
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Table" , tabname = "my_table", icon = icon("table"),DT::dataTableOutput("example_table")
),
menuItem("Next Widget", tabName = "Other"))),
dashboardBody(
tabItems(
tabItem(tabName = "subMenu", #my_table",
fluidRow(
)),
tabItem(tabName = "Other",
h2("Other tab")
)
)))
server <- function(input, output) {
output$example_table <- DT::renderDataTable(head(mtcars))
}
shinyApp(ui, server)
One quick way is to enable horizontal scrolling for your DT. Then the table will fit the container but be scrollable:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Table" , tabname = "my_table", icon = icon("table"),DT::dataTableOutput("example_table")
),
menuItem("Next Widget", tabName = "Other"))),
dashboardBody(
tabItems(
tabItem(tabName = "subMenu", #my_table",
fluidRow(
)),
tabItem(tabName = "Other",
h2("Other tab")
)
)))
server <- function(input, output) {
output$example_table <- DT::renderDataTable(head(mtcars), options = list(scrollX=TRUE))
}
shinyApp(ui, server)
The UI doesn't update the page when I have an input in the sidebar menu. In the example below when I click on "load data" it still shows a menu on the page.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("About", tabName = "a", icon = icon("info-circle")),
menuItem("Load Data", icon = icon("gear"), tabName = "b",
selectInput(inputId="convertToLog", label="Are X values on log2 scale?",choices=list('Yes'=1,'No'=0),selected=1))
)),
dashboardBody(
tabItems(
tabItem(tabName ="a", "a menu"),
tabItem(tabName ="b", "b menu")
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
As far as I know, you can/should not put another item in a menuItem, except for subMenuItems. You could use a conditionalPanel to achieve what you want though:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id="mysidebar",
menuItem("About", tabName = "a", icon = icon("info-circle")),
menuItem("Load Data", icon = icon("gear"), tabName = "b"),
conditionalPanel("input.mysidebar == 'b'",
selectInput(inputId="convertToLog", label="Are X values on log2 scale?",choices=list('Yes'=1,'No'=0),selected=1)),
menuItem('Another tab',tabName='c',icon = icon("gear"))
)
),
dashboardBody(
tabItems(
tabItem(tabName ="a", "a menu"),
tabItem(tabName ="b", "b menu"),
tabItem(tabName ="c", "c menu")
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
Note that I gave the sidebarMenu an ID to use in the condition of the conditionalPanel, and I added a tab to show that the conditionalPanel does not have to be at the bottom of the menu.
I hope this helps!
I am trying to embed the weather forecast from forecast.io in a Shiny dashboard. I originally had trouble with the ampersand but saw a post that provided an example of how to format HTML code with special characters. However, when I run the app I see a simple "Not Found", even though I know that the link works and is being formatted correctly. I'm not sure what I'm missing.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(12,
mainPanel(htmlOutput("frame")
)
)
)
)
)
)
)
server <- shinyServer(function(input, output) {
output$frame <- renderUI({
tags$iframe(id = 'app', src = url("https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston"), width = '100%')
})
})
shinyApp(ui,server)
Screen capture of error in Shiny Dashboard
Update with inserted dashboard
I transfered url from server to ui:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("dashboard")
)
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
fluidRow(
tags$iframe(
seamless = "seamless",
src = "https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston",
height = 800, width = 1400
)
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
I am using shinydashboard to create the interface of my shiny App. However I want one input which appear in the two tabMenu. In the example below, I want to textInput i_test appears in menu menu1 and menu2.
How should I implement it? Thanks for any suggestions.
library(shiny)
library(shinydashboard)
# Side bar boardy
sidebar <- dashboardSidebar(
sidebarMenu(
id = 'menu_tabs'
, menuItem('menu1', tabName = 'menu1')
, menuItem('menu2', tabName = 'menu2')
, menuItem('menu3', tabName = 'menu3')
)
)
# Body board
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'menu1',
textInput('i_test', 'Test')
),
tabItem(
tabName = 'menu2'
)
)
)
# Shiny UI
ui <- dashboardPage(
title = 'test',
dashboardHeader(),
sidebar,
body
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
It seems that shiny always renders two distinct elements, even if you try to build the same element a second time.
Thats why i could only come up with a solution that only makes it look like the two text iputs are the same.
Check the Code:
library(shiny)
library(shinydashboard)
# Side bar boardy
sidebar <- dashboardSidebar(
sidebarMenu(
id = 'menu_tabs'
, menuItem('menu1', tabName = 'menu1')
, menuItem('menu2', tabName = 'menu2')
, menuItem('menu3', tabName = 'menu3')
)
)
# Body board
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'menu1',
textInput('i_test_1', 'Test')
),
tabItem(
tabName = 'menu2',
textInput('i_test_2', 'Test')
),
tabItem(
tabName = 'menu3'
)
)
)
# Shiny UI
ui <- dashboardPage(
title = 'test',
dashboardHeader(),
sidebar,
body
)
server <- function(input, output, session) {
observe({
text1 <- input$i_test_1
updateTextInput(session, 'i_test_2', value = text1)
})
observe({
text2 <- input$i_test_2
updateTextInput(session, 'i_test_1', value = text2)
})
}
shinyApp(ui, server)