I use shiny with shinydashboard. I have one tabbox with two tabPanels. Then there is another box which should display either textOutput("a") if tab1 in tabbox is selected or textOutput("b") if tab2 is selected.
I provide whole code for reproducibility but watch out for comments which show where the important part is.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
skin = "red",
dashboardHeader(title = "lalala", titleWidth = 450),
sidebar <- dashboardSidebar(width = 400,
sidebarMenu(
menuItem(
text = strong("First tab"),
tabName = "first",
icon = icon("dashboard")
)
)),
body <- dashboardBody(fluidRow(
tabBox(
title = "First tabBox",
id = "tabset1",
height = "250px",
############## based on which of this tab is selected
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
box(
title = "Selection criteria for chart",
height = "700px",
width = 4,
solidHeader = TRUE,
status = "danger",
############## I want in this box to display either textouput "a" or "b"
textOutput("a")
)
))
)
server <- function(input, output) {
output$a <- renderText(a <- "ahoj")
output$b <- renderText(b <- "cau")
}
input$tabset1 returns the id of the currently selected tab (so either Tab1 or Tab2). Then you can use an if/else statement to print the content you like depending on this return value.
Related
I'm struggling to get my dashboard layout to be formatted in a way that looks good.
I have a box that is not the full width of my dashboard and the plot that is inside of it is actually wider and sticks out of it. (although I do believe once I make a plotly graph it will work fine).
I'm using fillRow but it does not fill the entire row and only half of the page.
Here is my code.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Overview",tabName = "Overview", icon = icon("tachometer-alt")),
menuItem("Assessments",tabName = "Assessments", icon = icon("list"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "Overview",
# Boxes need to be put in a row (or column)
fluidRow(
valueBoxOutput("rate"),
valueBoxOutput("count"),
valueBoxOutput("users"),
),
fluidRow(
box(title = "Title",
status = "primary",
),
box(align = "center",
title = "Select Inputs",status = "warning", solidHeader = F,
selectInput("dropdown1", "Select Drilldown:", c(50,100,200)))
),
fillRow(width = "100%",
box(
title = "Graph 1", status = "primary", solidHeader = TRUE,
plotOutput("plot1", height = "50vh", width = "100vh")))
),
tabItem(tabName = "Assessments",
h2("Assessmnents tab content")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$dropdown1)]
hist(data)
})
output$instructions <- renderText("Company Name")
output$rate <- renderValueBox({
valueBox(
value = 130,
subtitle = "Overview 1",
icon = icon("area-chart"),
color = "aqua"
)
})
output$count <- renderValueBox({
valueBox(
value = 120,
subtitle = "Overview 2",
icon = icon("download"),
color = "red"
)
})
output$users <- renderValueBox({
valueBox(
value = 85,
subtitle = "Overview 3",
icon = icon("users"),
color = "purple"
)
})
}
shinyApp(ui, server)
And a screen shot
My desired goal would be something like this
Is there any reccomended resources I can read to get better at shiny dashboard layouts and controlling the view?
You need to use width = 12 in the box function. Additionally, to make sure the plot is always using the entire width of the box use width = "100%" in plotOutput.
fillRow(
box(
width = 12,
title = "Graph 1",
status = "primary",
solidHeader = TRUE,
plotOutput(
"plot1",
height = "50vh",
width = "100%")
)
)
The Shiny Dashboard documentation is a good place to start learning the structure, appearance, and behavior of Shiny Dashboard. You can also get some extra functionality by using shinydashboardPlus. Finally, shinyWidgets provides a great selection of custom widgets with an improved visual look.
It's all about layout. Here I provide shinydashboard skeleton and some explanation that might suits your problem'. You can put this code inside dashboardBody(tabItems(tabItem(tabName = "Overview",...)))
fluidPage(
fluidRow(
column(width = 4,valueBoxOutput(width = 12,"blue_value_box")) ,
column(width = 4,valueBoxOutput(width = 12,"red_value_box")) ,
column(width = 4,valueBoxOutput(width = 12,"purple_value_box"))
),
fluidRow(
column(width = 6,box(width = 12,"Title")),
column(width = 6,box(width = 12,"Select Inputs",
selectInput("someinputhere")))
),
fluidRow(
column(width = 12,
box(width = 12,plotOutput("histogramofdata"))
)
)
)
First of all the column is not necessary for your case, its just very helpful to explain shiny layout. Keep in mind shiny have a strict width value, 12 maximum. If you define width in something like box or column(), everything inside that will follow its width rather than global width. For example in my example, i put valueboxoutput() inside column(). you can see that the column has width = 4 and the valueboxoutput has 12. The column() will follow the page width and the valuebox will follow column width. I don't know if this is the best practice but i like to use fluidrow() to make a separation by row between an shiny object.
For more clearer example, in the image above, i highlighted the fluidrow() in red and blue for column().
In the Shiny app below I am updating tabPanel content when the selection in sidebarMenu changes. However, there is a minor delay in the tabPanel content update when I change the selection in sidebarMenu.
For the small number of input values, this delay is negligible, but when I have a selectizeInput control in sidebarMenu and I load 1000 values there, then the content update in tabPanel is substantial. Is there a way to update tabPanel content instantly? Something like - content in all tabs is updated as soon as someone makes a selection in sidebarMenu, even before someone clicks at the tab?
library(shiny)
library(shinydashboard)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
radioButtons("select_by", "Select by:",
c("Food Type" = "Food",
"Gym Type" = "Gym",
"TV show" = "TV"))
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1", textOutput("tabset1Selected")),
tabPanel("Tab2", "Tab content 2", textOutput("tabset2Selected")),
tabPanel("Tab3", "Tab content 3", textOutput("tabset3Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- output$tabset2Selected <- output$tabset3Selected <- renderText({
input$select_by
})
}
)
Using the outputOptions to set suspendWhenHidden = FALSE updates the outputs also if they aren't visible:
library(shiny)
library(shinydashboard)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
selectizeInput(inputId = "select_by", label = "Select by:",
choices= as.character(1:1000))
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1", textOutput("tabset1Selected")),
tabPanel("Tab2", "Tab content 2", textOutput("tabset2Selected")),
tabPanel("Tab3", "Tab content 3", textOutput("tabset3Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- output$tabset2Selected <- output$tabset3Selected <- renderText({
input$select_by
})
lapply(list("tabset1Selected", "tabset2Selected", "tabset3Selected"), outputOptions, x = output, suspendWhenHidden = FALSE)
}
)
Furthermore you should consider using a server-side selectizeInput to enhance the performance for many choices.
In essence, I would like to replace the icon in each menuItem() in a shinydashboard with an image. More specifically, I just need each menuItem() to have an image then text next to it.
Here's some moderately successful attempts I have tried (commented in code below);
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard MenuItems"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem(
"Dashboard",
tabName = "dashboard",
## creates a drop down w/ no image
# label = img(src = "logo.png",
# title = "logo", height = "35pt")
## creates a drop down with the images
# `tag$` isn't needed
# tags$img(src = "logo.png",
# title = "logo", height = "35pt")
),
menuItem(
"Not Dashboard",
tabname = "not_dashboard"
)
) # end sidebarMenu
), # end dashboardSidebar
dashboardBody(
fluidRow(
box(
title = "stuff goes here",
width = 12
)
)
) # end dashboardBody
)
server <- function(input, output, session) {
message("You can do it!")
}
shinyApp(ui, server)
I successfully used action buttons with background images to simulate the behavior, but I would prefer to find a solution using menuItem()s, if possible.
I was hoping there would be a similar method to add the image to the background of the menuItem() or concatenate the image with the text within the menuItem().
I am not good with shiny tags. I don't really know much about HTML/CSS/JS or Bootstrap, most of the time I can find a solution here and hack my way to what I want, but this one has eluded me.
Any ideas?
You can keep your images in the www folder and use a div to wrap the image along with the text as shown below.
ui <- dashboardPage(
dashboardHeader(title = "Dashboard MenuItems"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem( div(tags$img(src = "YBS.png", width="20px"), "Dashboard2"),
tabName = "dashboard" # , icon=icon("b_icon")
),
menuItem(
div(tags$img(src = "mouse.png", width="35px"),"Not Dashboard"),
tabname = "not_dashboard" #, icon=icon("home")
)
) # end sidebarMenu
), # end dashboardSidebar
dashboardBody(
fluidRow(
box(
title = "stuff goes here",
width = 12
)
)
) # end dashboardBody
)
server <- function(input, output, session) {
message("You can do it!")
}
shinyApp(ui, server)
I have a shiny application, where in I am trying to provide a checkbox on top of a graph for the user to select. Currently, the check box is rendered below the title, whereas I want the title on the left hand side and the check box on the right hand side in the same line. I am sure it can be achieved through recoding CSS, but don't know how. The current code looks as follows:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "MODULE",titleWidth = 225
),
dashboardSidebar(
width = 225,
sidebarMenu(id = "tabs",
menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "tplines",
fluidRow(
box(
checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE),
width = 6, status = "info", title = "Inventory information",
div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
)
)))))
server <- function(session,input,output){
}
shinyApp(ui,server)
Maybe you are just looking for the standard row partition with columns. The title arguement takes any ui elements, so we input a row that is half your original title and half the checkbox input. Thus, they are in line. Of course, the checkbox then has the same style as the title. If you don't want that, you can alter the style by setting a style parameter in the checkbox column.
library(shiny)
library(shinydashboard)
library(plotly)
ui <- dashboardPage(
dashboardHeader(
title = "MODULE",titleWidth = 225
),
dashboardSidebar(
width = 225,
sidebarMenu(id = "tabs",
menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "tplines",
fluidRow(
box(
width = 6, status = "info", title = fluidRow(
column(6, "Inventory information"),
column(6, checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE))
),
div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
)
)
)
)
)
)
server <- function(session,input,output){}
shinyApp(ui,server)
I'm trying to build a Shiny dashboard page which will have tabbed pages with different types of plots, allow users to change settings dynamically, etc. Starting with the standard demo code from the Shiny Dashboards page, I can get a stacked version of the page (https://rstudio.github.io/shinydashboard/structure.html#tabbox):
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
tabBox(
title = "First tabBox",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1",
tabPanel("Tab1", "First tab content", plotOutput('test')),
tabPanel("Tab2", "Tab content 2")
),
tabBox(
side = "right",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1"),
tabPanel("Tab2", "Tab content 2"),
tabPanel("Tab3", "Note that when side=right, the tab order is reversed.")
)
),
fluidRow(
tabBox(
# Title can include an icon
title = tagList(shiny::icon("gear"), "tabBox status"),
tabPanel("Tab1",
"Currently selected tab from first box:",
verbatimTextOutput("tabset1Selected")
),
tabPanel("Tab2", "Tab content 2")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
dashboardSidebar(),
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
output$test = renderPlot(
boxplot(len ~ dose, data = ToothGrowth,
boxwex = 0.25, at = 1:3 - 0.2,
subset = supp == "VC", col = "yellow",
main = "Guinea Pigs' Tooth Growth",
xlab = "Vitamin C dose mg",
ylab = "tooth length",
xlim = c(0.5, 3.5), ylim = c(0, 35), yaxs = "i"))
}
)
If I modify line 10 to this:
tabPanel("Tab1", column(4,"First tab content"),
column(8, plotOutput('test'))
),
I get the heading and the boxplot split into columns, but the tabBox no longer expands to contain them.
Is there any way to control the contents of the tabPanel to allow columnar formatting of the output?
Just wrap your columns inside a fluidRow or fluidPage. Then the tabPanel gets the right size and stretches out to fit your columns.