ui <- dashboardPage(
dashboardHeader(title = "Sales"),
dashboardSidebar(),
dashboardBody(
tags$style(HTML(".box-header{background:#d2d2d2; color:#d83000; text-align:center;}")),
shinyUI(fluidPage(
fluidRow(
box(fluidRow(column(width = 12,
valueBox(1000,"Total Sales", width = 2),
valueBox(500,"Existing Sales", width = 2),
valueBox(300,"New Sales", width = 2),
valueBox(100,"Lost Sales", width = 2),
valueBox(100,"Unclassified Sales", width = 2))),
fluidRow(column(width=12, offset = 2,valueBox(250, "within existing sales", width = 2))),
width = 12, title = tags$b("BUSINESS MODEL"), solidHeader = TRUE)
)#,
#box(title = "Title", height = 20, width = 8, solidHeader = TRUE)
))))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
})
# Run the application
shinyApp(ui = ui, server = server)
Result
As you can see the "within existing sales" valuebox is not in align with "existing sales" valuebox. I tried offsetting with as 3.5 but it does not work. I even tried inspecting the result but I not much of a programmer.
The second row is not aligned because you are adding a offset of 2 to a column with a width of 12. On Bootstrap, you can not use more than 12 column in a row.
To solve that you should use a column-based layout, using a column for each valueBox and setting width = NULL. The follow example is using to separate rows, but you can also use only one row.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Sales"),
dashboardSidebar(),
dashboardBody(
tags$style(HTML(".box-header{background:#d2d2d2; color:#d83000; text-align:center;}")),
shinyUI(fluidPage(
fluidRow(
box( width = 12, title = tags$b("BUSINESS MODEL"), solidHeader = TRUE,
fluidRow(
column(width = 2, valueBox(1000,"Total Sales", width = NULL)),
column(width = 2, valueBox(500,"Existing Sales", width = NULL)),
column(width = 2, valueBox(300,"New Sales", width = NULL)),
column(width = 2, valueBox(100,"Lost Sales", width = NULL)),
column(width = 2, valueBox(100,"Unclassified Sales", width = NULL))
),
fluidRow(
column(width = 2, offset = 2,
valueBox(250, "within existing sales", width = NULL)
)
)
)
)#,
#box(title = "Title", height = 20, width = 8, solidHeader = TRUE)
))))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
})
# Run the application
shinyApp(ui = ui, server = server)
Related
Help! For the life of me, I can't get values to populate from the server to the infoBox in the UI.
I've tried to define the infoboxes from the server section, but the infoboxes will only appear if I construct them in the UI (as shown below).
The goal is to populate the boxes with filtered data based on user inputs, but I've abandoned this at this stage because I can't even pass a value from the server to the UI infobox here:
infoBox("Participants Trained",
value = renderText("AYval"), # tried every combo here
width = 12,color = "blue", # tried width = NULL
icon = icon("fa-solid fa-people-group"), fill = F)
A value shows when I hardcode a value in "value = ", but none of the render options, renderText, verbatimText, output$AYval, valueTextbox, listen(),react() will get a value that is hard-coded in the server side to show up in this infobox.
To get the dashboard to display boxes, I'm using header = tagList(useShinydashboard()). My guess is this useShinydashboard() is the culprit.
I thought this comment might be relevant:
Your code using lapply and the navbarPage doesn't generate the UI in
the proper namespace, since when using the navbarPage construct your
modules are "one level deeper".
The script:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
#library(shinyjs)
side_width <- 5
#completing the ui part with dashboardPage
ui <- navbarPage(fluid = TRUE,
theme = shinythemes::shinytheme("flatly"),
collapsible = TRUE,
header = tagList(
useShinydashboard()
),
tabPanel("START"),
tabPanel("Home Dashboard",
value = "Tab1",
# useShinyjs(),
fluidRow(
column(4,
# Selection Input ---------------------------------------------------------
selectInput(inputId = "AY","Academic Year",
multiple = T,
choices = unique(INDGEN$AcademicYear),
selected = unique(INDGEN$AcademicYear)
)),
column(4,
selectInput(inputId = "State","Select State",
choices = c("State","States"))),
column(4,
selectInput(inputId = "Program","Select Program",
choices = c("Program","Programs")))
),
fluidRow(column(12,
box(width = 4,
infoBox("Who?",
width = 12,color = "blue",
fill = F)
),
box(width = 4,
infoBox("Where?", width = 12,color = "blue",
fill = F)
),
box(width = 4,
infoBox("What?", width = 12,color = "blue",
fill = F))
)),
# UI Box R1 ---------------------------------------------------------------
fluidRow(column(12,
box(width = 4,
# uiOutput(infoBoxOutput("BOX1",width = NULL)),
infoBox("Participants Trained", value =
renderText("AYval"),
width = 12,color = "blue",
icon = icon("fa-solid fa-people-group"), fill = F)
),box(width = 4,
infoBox("Training Sites", nrow(data), width = 12,color = "blue",
icon = icon("fa-solid fa-school"), fill = F)
),box(width = 4,
infoBox("Training Programs Offered", nrow(data), width = 12,color = "blue",
icon = icon("fa-solid fa-book-open-reader"), fill = F))
)),
server <- function(input, output,session) {
output$AYval <- renderText({
textInput(13)
})
output$BOX1 <- renderInfoBox({
infoBox(title = "Participants Trained",
value = 13,
width = NULL,color = "blue",
icon = icon("fa-solid fa-people-group"), fill = T)
})
}#Server End
shinyApp(ui = ui,server = server,options = list(height = 1440))
Notice the "participant trained" box is empty. That's because that value isn't hard-coded. The rest are.
Here's a small reproducible example of how to change the value contents dynamically:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
data(iris)
ui <- navbarPage(
fluid = TRUE,
theme = shinythemes::shinytheme("flatly"),
collapsible = TRUE,
header = tagList(
useShinydashboard()
),
tabPanel("START"),
tabPanel(
title = "Home Dashboard",
value = "Tab1",
selectInput("column",
label = "Select a column",
choices = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
),
box(
width = 4,
infoBoxOutput("test")
)
)
)
server <- function(input, output, session) {
iris_sum <- reactive({
sum(iris[input$column])
})
output$test <- shinydashboard::renderInfoBox({
infoBox(
title = "Where?",
value = iris_sum(),
width = 12,
color = "blue",
fill = F
)
})
}
shinyApp(ui, server)
Using bs4Dash, I am trying to create a box that contains several other boxes, have them horizontally aligned, and span equal-distances across the page no matter how big or small the window is. I was able to get the boxes in-line using a div(), but cannot seem to make them equidistant in width.
This is my reproducible example:
if (interactive()) {
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 12, div(style="display: inline-block;vertical-align:top;", box(
solidHeader = FALSE,
title = "Status summary",
background = NULL,
width = 12,
status = "danger",
footer = fluidRow(
descriptionBlock(
number = "17%",
numberColor = "pink",
numberIcon = icon("caret-up"),
header = "$35,210.43",
text = "TOTAL REVENUE",
rightBorder = TRUE,
marginBottom = FALSE
),
descriptionBlock(
number = "18%",
numberColor = "secondary",
numberIcon = icon("caret-down"),
header = "1200",
text = "GOAL COMPLETION",
rightBorder = FALSE,
marginBottom = FALSE
)
)
)),
div(style="display: inline-block;vertical-align:top;", box(title = "second box", width = 12))
)
)
),
title = "Description Blocks"
),
server = function(input, output) { }
)
}
I'm not sure if you've answered this question since you posted it, but it might be useful for others.
In bs4Dash, the key is to use constant combinations of fluidRow(column(width = X, box(width = NULL))) even within boxes.
For example, a box with two boxes inside of it might look like this:
column(width = 12,
box(width = NULL, title = "Main box",
fluidRow(
column(width = 6,
box(width = NULL, title = "Internal box 1")
),
column(width = 6,
box(width = NULL, title = "Internal box 2")
)
)
)
)
Here's a reproducible example that should achieve your outcomes:
library(shiny)
library(bs4Dash)
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(width = 12,
box(width = NULL,
fluidRow(
column(width = 6,
box(
solidHeader = FALSE,
title = "Status summary",
background = NULL,
width = NULL,
status = "danger",
footer = fluidRow(
column(width = 6,
descriptionBlock(
number = "17%",
numberColor = "pink",
numberIcon = icon("caret-up"),
header = "$35,210.43",
text = "TOTAL REVENUE",
rightBorder = TRUE,
marginBottom = FALSE
)
),
column(width = 6,
descriptionBlock(
number = "18%",
numberColor = "secondary",
numberIcon = icon("caret-down"),
header = "1200",
text = "GOAL COMPLETION",
rightBorder = FALSE,
marginBottom = FALSE
)
)
)
)
),
column(width = 6,
box(title = "second box", width = NULL))
)
)
)
)
)
)
server = function(input, output) { }
shinyApp(ui = ui, server = server)
As the title says. I have entered the code exactly as it is the book, but I run into this error message: "Error in shiny::tabsetPanel(..., id=id, selected = selected) : argument is missing, with no default"
I have no idea what is missing.
Here is the code:
library(shinydashboard)
ui<- dashboardPage(
dashboardHeader(title= "Uniform Distribution"),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(width =6,
box(title = "Select a Number",
solidHeader = TRUE,
background = "yellow",
status = "warning",
width = NULL,
height = 312,
sliderInput(inputId = "number",
label = "",
value = 500, min = 25, max = 1000)),
box(
background= "light-blue",
solidHeader = TRUE,
status ="primary",
title = "Histogram",
width = NULL,
plotOutput("hist", height = 250))),
column(width = 6,
tabBox(
title ="Central Tendency",
id ="tabs1", height = 120, width =NULL,
tabPanel("Mean", h2(textOutput("meantext")),width=NULL),
tabPanel("Median", h2(textOutput("mediantext")),width=NULL),
),
tabBox(
title ="Variability",
id ="tabs2", height = 120, width =NULL,
tabPanel("Variance", h2(textOutput("vartext")),width=NULL),
tabPanel("Standard Deviation", h2(textOutput("sdtext")),width=NULL))
)
)
))
server <- function(input,output){
histdata <- reactive({runif(input$number, min=0, max = 1)})
output$hist <- renderPlot({
hist(histdata(), xlab = "Value",
main= paste(input$number,"random values between 0 and 1"))
})
output$meantext <- renderText({
paste("Mean =", round(mean(histdata()),3))})
output$mediantext <- renderText({
paste("Median =", round(median(histdata()),3))})
output$vartext <- renderText({
paste("Variance =", round(var(histdata()),3))})
output$sdtext <- renderText({
paste("Standard Deviation =", round(sd(histdata()),3))})
}
shinyApp(ui, server)
You have tabPanels outside of tabsetPanels. Your tabPanels need to wrapped inside tabsetPanel() or navBarPage()
See below:
ui<- dashboardPage(
dashboardHeader(title= "Uniform Distribution"),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(width =6,
box(title = "Select a Number",
solidHeader = TRUE,
background = "yellow",
status = "warning",
width = NULL,
height = 312,
sliderInput(inputId = "number",
label = "",
value = 500, min = 25, max = 1000)),
box(
background= "light-blue",
solidHeader = TRUE,
status ="primary",
title = "Histogram",
width = NULL,
plotOutput("hist", height = 250))),
column(width = 6,
tabBox(
title ="Central Tendency",
id ="tabs1", height = 120, width =NULL,
tabsetPanel(
tabPanel("Mean", h2(textOutput("meantext")),width=NULL),
tabPanel("Median", h2(textOutput("mediantext")),width=NULL)
)
),
tabBox(
title ="Variability",
id ="tabs2", height = 120, width =NULL,
tabsetPanel(
tabPanel("Variance", h2(textOutput("vartext")),width=NULL),
tabPanel("Standard Deviation", h2(textOutput("sdtext")),width=NULL)
)
)
)
)
))
Im using shiny dashboard for an app, but cant find a way to center the title:
box(title = "Labels"
, status = "primary", solidHeader = T...
The "Labels title is in the left corner, of the box and would like it to be in the center, any ideas?
Some options for you...
library(shiny)
library(shinydashboard)
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Test App"),
dashboardSidebar(
selectInput("dt","Data", choices = list("cars","mtcars","pressure") )
),
## BODY
dashboardBody(
fluidRow(
column(
width = 10,
box(title = h1("My Title with h1 ", align="center"),
solidHeader = T,
width = 5, height = 500,
collapsible = T,
plotOutput("plot1", height=350)
),
box(title = h6("My Title with h6 ", align="center"),
solidHeader = T,
width = 5, height = 500,
collapsible = T,
plotOutput("plot2")
))), br(), br(),
fluidRow(
column(width = 8, align="center",
box(title = div("My Title with div, red color and font-size 22 ", style='color:red; font-size:22px;'),
solidHeader = T,
width = 8, height = 500,
collapsible = T,
plotOutput("plot3")
) )
)
)))
server <- shinyServer(function(input, output) {
output$plot1 <- renderPlot({
req(input$dt)
plot(get(input$dt))
})
output$plot2 <- renderPlot({plot(mtcars)})
output$plot3 <- renderPlot({plot(pressure)})
})
shinyApp(ui = ui, server = server)
How to align widgets in fluidRow without huge gaps. Take for example this code:
library(shiny)
ui <- bootstrapPage(
absolutePanel(
id = "pn", top = 5, right = 5, class = "panel panel-default",
fluidRow(
column(width = 3, selectInput("place_format", NULL, choices = character(0))),
column(width = 7, selectizeInput("place", NULL, choices = character(0))),
column(width = 2, actionButton("zoom","Zoom!"))
)
)
)
server <- function(input, output){}
shinyApp(ui = ui, server = server)
if all width aren't4 there is 'huge' gap between button and 2nd widget. And also after button there is a 'lot' of free space.
The definition of your absolutePanel is incomplete. Please see the details section in ?absolutePanel
The position (top, left, right, bottom) and size (width, height)
parameters are all optional, but you should specify exactly two of
top, bottom, and height and exactly two of left, right, and width for
predictable results.
Please check the following example:
library(shiny)
ui <- bootstrapPage(
absolutePanel(
id = "pn", top = "100px", left = "100px", right = "100px", bottom = "100px", class = "panel panel-default",
fluidRow(
column(width = 3, selectInput("place_format", NULL, choices = character(0), width = "100%")),
column(width = 7, selectizeInput("place", NULL, choices = character(0), width = "100%")),
column(width = 2, actionButton("zoom","Zoom!", width = "100%"))
)
)
)
server <- function(input, output){}
shinyApp(ui = ui, server = server)