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.
Related
I want to control the position of a DT table output within a tabBox():
This example app gives this:
library(shiny)
library(bs4Dash)
library(DT)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabBox(
id = "tabset1",
height = 750,
tabPanel("Hello", "This is the hello tab",
DT::DTOutput("myTable")
))
)
),
server = function(input, output, session) {
output$myTable <- DT::renderDT({
DT::datatable(
mtcars)
})
}
)
As you can see the DT table is exceeding the borders of tabBox panel. How can we force DT to keep inside tabBox panel (width and height).
Desired output:
You can include in your tabBox the width parameter, in shiny max allowed is 12. Then, your ui part is:
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabBox(
id = "tabset1",
height = 750,
width = 12,
tabPanel("Hello", "This is the hello tab",
DT::DTOutput("myTable")
))
)
),
That look like this:
Another option its include an horizontal scroll to your tabBox:
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabBox(
id = "tabset1",
height = 750,
#width = 12,
tabPanel("Hello", "This is the hello tab",
div(style = 'overflow-x: scroll', DT::dataTableOutput('myTable'))
))
)
),
server = function(input, output, session) {
output$myTable <- DT::renderDT({
DT::datatable(
mtcars)
})
}
)
That look like this:
We can also use scrollX option:
output$myTable <- DT::renderDT({
DT::datatable(
mtcars,
options = list(
scrollX = TRUE
)
)
})
I have this shiny app I am making. My goal is to have a fluid row that has an image and some inputs
# Test Version with google logo
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dashbaord"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center",
width = "100%",
style="height: 50px")), #I'm trying to change the size here but it doesn't work
box(align = "center",
title = "Select Inputs",status = "warning", solidHeader = F,
selectInput("dropdown1", "Select Drilldown:", c(50,100,200))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Technically this code works, but I don't like how the box with the image changes based off the monitor/view. I would like for both boxes to be the same height and remain uniformed. I posted some screen shots below.
Full Screen
Half Screen
Desire Output (row is the same height no matter what).
Edit:
box_height = "20em"
plot_height = "16em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center",
width = "100%"),
height = box_height),
box(plotOutput("speed_distbn",height = plot_height), height = box_height)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Boxes stay the same height but the image overlaps the box
How about this
library(shinydashboard)
library(shiny)
my_height = "30em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center", style = paste0("width: 100%; height: ", my_height, ";"))
),
box(title = "Plot", plotOutput("speed_distbn", height = my_height))
)
)
)
server <- function(input, output) {
output$speed_distbn <- renderPlot(plot(1))
}
shinyApp(ui, server)
In your first case, if you want to use other random tags on the right side. In order to have the right the same height as left, we can use spsComps::heightMatcher. We can use this function to dynamically match the height of the right side to the left side.
library(shinydashboard)
library(shiny)
my_height = "30em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
id= "box_l",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center", style = paste0("width: 100%; height: ", my_height, ";"))
),
box(
title = "Select inputs",
id= "box_r",
selectInput("dropdown1", "Select Drilldown:", c(50,100,200))
),
spsComps::heightMatcher("box_r", "box_l")
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
In your case, the height on left is fixed, but heightMatcher can do it even with dynamically changed height. try click on spsComps shiny demo and go to the Misc tab and see the dynamic heightMatcher example.
I am using shinydashboardPlus because I want to use dashboardFooter, but I removed the sidebar. the problem is that the logo header/sidebar header is still there, and haven't figure out a way to remove it. I tried to solve the issue by changing my css script, with no luck. The image shows what I want to remove:
Here is a simple, reproducible example:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
library(shinyjs)
header <- dashboardHeader(tags$li(class = "dropdown",
sidebarMenu(
id = "mysearch",
menuItem(
text = "Main",
tabName = "main",
icon = icon("home")
)
)))
sidebar <- dashboardSidebar(
width = "0px"
)
body <- dashboardBody()
ui <- (dashboardPage(
header = header,
sidebar = sidebar,
body,
footer = dashboardFooter(
left = tags$b(
icon("envelope"),
tags$a(href = "mailto:", "myemail#email.no"),
icon("home"),
tags$a(href = "https://somesite.no", "www.somesite.no/")
),
right = ""
)
))
server <- function(input, output, session) {}
shinyApp(ui, server)
Any ideas?
Try titleWidth=0, as
header <- dashboardHeader(
titleWidth=0,
tags$li(class = "dropdown",...)
)
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 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)
}
)