I am trying to render a checkbox menu in a collapsed menu item in shinydashboard, but I cannot get it to work. So far, I have only found an similar github issue when rendering to the dashboardBody, but I couldn't figure out how that would apply to the siderbarMenu.
library('shiny')
library("shinydashboard")
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Inputs", icon = icon("bar-chart-o"), tabName = "tabOne",
uiOutput('mymenu')
)
)
)
body <- dashboardBody(
h3('nothing here')
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
output$mymenu <- renderUI({
checkboxGroupInput('mymenu', 'lettersMenu',
letters[1:5],
letters[1:5])
})
}
)
I think the problem is that there is nothing triggering this renderUI. Try adding this to your code:
outputOptions(output, "mymenu", suspendWhenHidden = FALSE)
edit
library('shiny')
library("shinydashboard")
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Inputs", icon = icon("bar-chart-o"), tabName = "tabOne",
uiOutput('mymenu')
)
)
)
body <- dashboardBody(
h3('nothing here')
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
output$mymenu <- renderUI({
checkboxGroupInput('mymenu', 'lettersMenu',
letters[1:5],
letters[1:5])
})
outputOptions(output, "mymenu", suspendWhenHidden = FALSE)
}
)
Related
I have a need of having the icon in valueBoxes centered. Can that be done?
Here is a snippet with my aproach
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar(disable = TRUE)
body <- dashboardBody(
tags$head(tags$style(HTML('.small-box .icon-large {top: 5px;}'))),
valueBox(
value = "Test",
subtitle = NULL,
icon = tags$div(class = "fas fa-thumbs-down", style="text-align:center")
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output){}
)
Here's one way using a CSS trick.
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar(disable = TRUE)
body <- dashboardBody(
tags$head(tags$style(HTML('.small-box .icon-large {top: 5px;}'))),
valueBox(
value = "Test",
subtitle = NULL,
icon = icon("fas fa-thumbs-down",
style = "position:relative;right:200px;bottom: 15px")
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output){}
)
You may further adjust right and bottom property as per your requirement.
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 am trying to make the sidebarPanel overlay the mainPanel inside a tabBox but using z-index doesn't seem to work. I.e. the box size shouldn't change when the button is clicked and the sidebarPanel appears, it should just overlay the mainPanel
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
tabPanel("Tab 1",
sidebarLayout(
div(id = "Sidebar",
style = "z-index: 1000;",
sidebarPanel("There are currently 20 overdue here", width = 6)
),
mainPanel(plotOutput("plot1"), width = 12)
)
),
tabPanel("Tab 2"),
title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
selected = "Tab 1"
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
shinyjs::hide(id = "Sidebar")
observeEvent(input$Link, {
shinyjs::toggle(id = "Sidebar")
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(50)]
hist(data)
})
}
shinyApp(ui, server)
For the Main Sidebar
The sidebar position is not depending on the z-index of the sidebar and/or the main panel.
So changing these values will not give you your desired behaviour.
What you can do is changing the margin-left css attribute of the main panel to 0px to achieve your desired result.
With this code you can achieve this, just simply add it to your dashboardBody
tags$style(".content-wrapper{margin-left: 0px;}")
Resulting in following complete code:
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
tags$style(".content-wrapper{margin-left: 0px;}"),
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
tabPanel("Tab 1",
sidebarLayout(
div(id = "Sidebar",
style = "z-index: 1000;",
sidebarPanel("There are currently 20 overdue here", width = 6)
),
mainPanel(plotOutput("plot1"), width = 12)
)
),
tabPanel("Tab 2"),
title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
selected = "Tab 1"
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
shinyjs::hide(id = "Sidebar")
observeEvent(input$Link, {
shinyjs::toggle(id = "Sidebar")
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(50)]
hist(data)
})
}
shinyApp(ui, server)
EDIT:
For the info Icons Sidebar:
The following will do what you want:
adding the following to the style paramerter of your sidebar div will get that done
position: fixed;
Even though this is a solution I would highly recommend you to checkout the shinydasboardPlus package and theire version of the tabbox sidebar/help. Maybe this would also be fine for you and it would require less manuel effort on your side https://github.com/RinteRface/shinydashboardPlus
They also have a demo hosted here: https://rinterface.com/shiny/shinydashboardPlus/
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
tabPanel("Tab 1",
sidebarLayout(
div(id = "Sidebar",
style = "z-index: 1000;position: fixed;",
sidebarPanel("There are currently 20 overdue here", width = 6)
),
mainPanel(plotOutput("plot1"), width = 12)
)
),
tabPanel("Tab 2"),
title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
selected = "Tab 1"
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
shinyjs::hide(id = "Sidebar")
observeEvent(input$Link, {
shinyjs::toggle(id = "Sidebar")
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(50)]
hist(data)
})
}
shinyApp(ui, server)
I am working in an application similar to one below. I have my input panel in sidebar under a menu which is initally expanded. I want to collapse the menu and hide all the input panel so that my sidebar will be clean. But It should appear when I expand (not permanently hide). I tried the following solution but it is not working. Please help me to find a solution or any alternative approach.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))
You need to add useShinyjs() into ui part
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
useShinyjs(),
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(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)