This is an extension of my previous question. Now I am not able to extend the height of my main panel.
This is my code below
library(shiny)
library(shinydashboard)
library(shinyBS)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarPanel(
textInput("text", "Enter Id:"),
box(width = 1, background = 'purple'),
actionButton("Ok", "Press Ok",style='padding:8px; font-size:100%')
)
),
dashboardBody(
mainPanel(width = 12,
tabsetPanel(
tabPanel("About", value=1, h6("The objective is to test width of ShinyApp in tabPanel design", br(),
br(),
"Distribution Prototype"
)
),
tabPanel("Data", value=2,
fluidRow(
valueBoxOutput("vbox1", width = 2),
valueBoxOutput("vbox2", width = 2),
valueBoxOutput("vbox3", width = 2),
valueBoxOutput("vbox4", width = 2),
valueBoxOutput("vbox5", width = 2),
valueBoxOutput("vbox6", width = 2)
),
fluidRow(
column(width = 4, box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
column(width = 4, box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
column(width = 4, box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3")))),
fluidRow(
column(width = 4, box(title = "Plot1", width = NULL, solidHeader = FALSE, plotOutput("plot1", height = "600px"))),
column(width = 4, box(title = "Plot2", width = NULL, solidHeader = FALSE, plotOutput("plot2", height = "600px"))),
column(width = 4, box(title = "Plot3", width = NULL, solidHeader = FALSE, plotOutput("plot3", height = "600px")))
)
)
)
)
))
server <- function(input, output) {
output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
output$vbox3 <- renderValueBox({ valueBox( "Three","Yes",icon = icon("stethoscope"))})
output$vbox4 <- renderValueBox({ valueBox( "Four","Yes",icon = icon("stethoscope"))})
output$vbox5 <- renderValueBox({ valueBox( "Five","Yes",icon = icon("stethoscope"))})
output$vbox6 <- renderValueBox({ valueBox( "Six","Yes",icon = icon("stethoscope"))})
output$dat1 <- renderDataTable({datatable(iris)})
output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE) )})
}
shinyApp(ui, server)
The plots are sticking out of the default layout space and I am not finding any options in the mainPanel() to increase the height. I attempted forcing the height value within the mainPanel(), like this mainPanel(width = 12, height, 20 ....) and that did not work. Any suggestion is much appreciated.
+
---------Updated-------------
Not sure if this helps, this is not an issue when I dont use mainpanel()
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(
conditionalPanel(condition="input.tabselected==3",
textInput("text", "Enter Id:"),
box(width = 1, background = 'purple'),
actionButton("Ok", "Press Ok",style='padding:8px; font-size:100%')
)
),
dashboardBody(
fluidRow(
valueBoxOutput("vbox1", width = 2),
valueBoxOutput("vbox2", width = 2),
valueBoxOutput("vbox3", width = 2),
valueBoxOutput("vbox4", width = 2),
valueBoxOutput("vbox5", width = 2),
valueBoxOutput("vbox6", width = 2)
),
fluidRow(
column(width = 4, box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
column(width = 4, box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
column(width = 4, box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3")))
),
fluidRow(
column(width = 4, box(title = "Plot1 ", width = NULL, solidHeader = FALSE, plotOutput("plot1", height = "600px"))),
column(width = 4, box(title = "Plot2", width = NULL, solidHeader = FALSE, plotOutput("plot2", height = "600px"))),
column(width = 4, box(title = "Plot3", width = NULL, solidHeader = FALSE, plotOutput("plot3", height = "600px")))
)
)
)
server <- function(input, output) {
output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
output$vbox3 <- renderValueBox({ valueBox( "Three","Yes",icon = icon("stethoscope"))})
output$vbox4 <- renderValueBox({ valueBox( "Four","Yes",icon = icon("stethoscope"))})
output$vbox5 <- renderValueBox({ valueBox( "Five","Yes",icon = icon("stethoscope"))})
output$vbox6 <- renderValueBox({ valueBox( "Six","Yes",icon = icon("stethoscope"))})
output$dat1 <- renderDataTable({datatable(iris)})
output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE) )})
#output$dat4 <- renderDataTable({datatable(data.frame(HairEyeColor),extensions = 'Responsive' )})
}
shinyApp(ui, server)
You are not using the functions from shinydashboard but rather the standard shiny package and you need to wrap your tabBox inside a fluidRow.
library(shiny)
library(shinydashboard)
library(shinyBS)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarPanel(
textInput("text", "Enter Id:"),
box(width = 1, background = 'purple'),
actionButton("Ok", "Press Ok",style='padding:8px; font-size:100%')
)
),
dashboardBody(
fluidRow(
tabBox(width = 12, height = NULL,
tabPanel("About", value=1, h6("The objective is to test width of ShinyApp in tabPanel design", br(),
br(),
"Distribution Prototype"
)
),
tabPanel("Data", value=2,
fluidRow(
valueBoxOutput("vbox1", width = 2),
valueBoxOutput("vbox2", width = 2),
valueBoxOutput("vbox3", width = 2),
valueBoxOutput("vbox4", width = 2),
valueBoxOutput("vbox5", width = 2),
valueBoxOutput("vbox6", width = 2)
),
fluidRow(
column(width = 4, box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
column(width = 4, box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
column(width = 4, box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3")))),
fluidRow(
column(width = 4, box(title = "Plot1", width = NULL, solidHeader = FALSE, plotOutput("plot1"))),
column(width = 4, box(title = "Plot2", width = NULL, solidHeader = FALSE, plotOutput("plot2"))),
column(width = 4, box(title = "Plot3", width = NULL, solidHeader = FALSE, plotOutput("plot3")))
)
)
)
)
))
server <- function(input, output) {
output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
output$vbox3 <- renderValueBox({ valueBox( "Three","Yes",icon = icon("stethoscope"))})
output$vbox4 <- renderValueBox({ valueBox( "Four","Yes",icon = icon("stethoscope"))})
output$vbox5 <- renderValueBox({ valueBox( "Five","Yes",icon = icon("stethoscope"))})
output$vbox6 <- renderValueBox({ valueBox( "Six","Yes",icon = icon("stethoscope"))})
output$dat1 <- renderDataTable({datatable(iris)})
output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE) )})
}
shinyApp(ui, server)
Related
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)
I am creating a simple shiny app with some valuebox and three datatables.
If I design the app without using tabpanel everything works fine.
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("vbox1", width = 2),
valueBoxOutput("vbox2", width = 2),
valueBoxOutput("vbox3", width = 2),
valueBoxOutput("vbox4", width = 2),
valueBoxOutput("vbox5", width = 2),
valueBoxOutput("vbox6", width = 2)
),
fluidRow(
column(width = 4, box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
column(width = 4, box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
column(width = 4, box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3")))
))
)
server <- function(input, output) {
output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
output$vbox3 <- renderValueBox({ valueBox( "Skip","Yes",icon = icon("stethoscope"))})
output$vbox4 <- renderValueBox({ valueBox( "a Two","Yes",icon = icon("stethoscope"))})
output$vbox5 <- renderValueBox({ valueBox( "Then","Yes",icon = icon("stethoscope"))})
output$vbox6 <- renderValueBox({ valueBox( "some","Yes",icon = icon("stethoscope"))})
output$dat1 <- renderDataTable({datatable(iris)})
output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE) )})
}
shinyApp(ui, server)
Now if I design the app using tabpanel function there is a lot of wasted white space on the rightside.
library(shiny)
library(shinydashboard)
library(shinyBS)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarPanel(
textInput("text", "Enter Id:"),
box(width = 1, background = 'purple'),
actionButton("Ok", "Press Ok",style='padding:8px; font-size:100%')
)
),
dashboardBody(
mainPanel(
tabsetPanel(
tabPanel("About", value=1, h6("The objective is to test width of ShinyApp in tabPanel design", br(),
br(),
"Distribution Prototype"
)
),
tabPanel("Data", value=2,
fluidRow(
valueBoxOutput("vbox1", width = 2),
valueBoxOutput("vbox2", width = 2),
valueBoxOutput("vbox3", width = 2),
valueBoxOutput("vbox4", width = 2),
valueBoxOutput("vbox5", width = 2),
valueBoxOutput("vbox6", width = 2)
),
fluidRow(
column(width = 4, box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
column(width = 4, box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
column(width = 4, box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3"))))
)
)
)
))
server <- function(input, output) {
output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
output$vbox3 <- renderValueBox({ valueBox( "Skip","Yes",icon = icon("stethoscope"))})
output$vbox4 <- renderValueBox({ valueBox( "a Two","Yes",icon = icon("stethoscope"))})
output$vbox5 <- renderValueBox({ valueBox( "Then","Yes",icon = icon("stethoscope"))})
output$vbox6 <- renderValueBox({ valueBox( "some","Yes",icon = icon("stethoscope"))})
output$dat1 <- renderDataTable({datatable(iris)})
output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE) )})
}
shinyApp(ui, server)
Wasted White Space Image
My usecase dictates that I use tabpanel, so any suggestions on making these objects span across the entire layout without wasting space is much appreciated.
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)