Formatting unequal column length texts in fluidRow in R Shiny - css

I am currently building a Shiny app and would like to display some text blocks. The text blocks are of different lengths, and I would like to color each block and also have some gap between the blocks.
However since the blocks have different text lengths, I am only able to color the block upto the point where there is text and not in the empty area. However that results in a bit ugly coloring.
Also the minimum gap between the columns apparently is 1, and that is too much of a gap from a visual point of view.
What I want to get to is coloring of Columns B & C down to the length of Column A.
I also want to reduce the gap between the columns and I have set it to an offset of 1, but I am unable to offset it to a fraction < 1.
This is the code that results in the picture above:
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Data Visualization",
fluidRow(
column(3,h3("Title A",align = "center"),style = "background-color: red;"),
column(3,h3("Title B",align = "center"),style = "background-color: yellow;",offset = 1),
column(3,h3("Title C",align = "center"),style = "background-color: green;",offset = 1)
),
fluidRow(
column(3, h4(tags$li("Text A")),style = "background-color: red;"),
column(3,tags$li(h4("Text B")),style = "background-color: yellow;",offset = 1),
column(3,tags$li(h4("Text C")),style = "background-color: green;",offset = 1)
),
fluidRow(
column(3, h4(tags$li("More Text A")),style = "background-color: red;"),
column(3,"",style = "background-color: yellow;", offset = 1),
column(3,"",style = "background-color: green;", offset = 1)
),
fluidRow(
column(3, h4(tags$li("More and More Text A")),style = "background-color: red;"),
column(3,"",style = "background-color: yellow;", offset = 1),
column(3,"",style = "background-color: green;", offset = 1)
)
))))
server <- function(input,output) {}
shinyApp(ui = ui, server = server)
Kindly let me know how do I style this without any hardcoded pixel widths (as that might impact the viewing experience of different screen sizes) to get the coloring equal to the max length column.
If there is another way to have such text boxes in shiny then also it would help to know.
Many thanks!

I think using shinydashboard::box() would be an easier approach:
library(shiny)
library(shinydashboard)
body <- dashboardBody(
# change this to set space between boxes
tags$head(tags$style(
HTML('.row div {padding: 0% 1% 0% 1% !important;}'))),
fluidRow(
box(
title = "Title A", width = 4, background = "red",
"Some text that is contained within a red box"
),
box(
title = "Title B", width = 4, background = "yellow",
"Some text that is contained within a yellow box and also a bit longer
than the other boxes."
),
box(
title = "Title C",width = 4, background = "green",
"Some text that is contained within a green box"
)
),
fluidRow(
box(
width = 4, background = "red",
"And simply don't specify a title to create some more text about topic A."
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Example of Dashboard"),
dashboardSidebar(),
body
)
shinyApp(ui = ui, server = function(input, output) { })
which gives you

Related

Aligning all sub-menu items in dropMenu to the right and hiding drop arrow

I have an application which uses box::dropdownMenu to render a dropdown menu which the user will use to set plot options. I'm able to implement this functionality without any issue, but I would like to do two additional things.
Is it possible to:
(1) Hide the arrow to the right of the cog-icon?
(2) On the dropdown menu, is it possible to keep the text left-alligned, but have the radio buttons be right aligned?
Current State:
Desired End Result:
Code:
library(shiny)
library(shinyWidgets)
library(shinydashboardPlus)
ui <- fluidPage(
box(
title = "Box Title",
dropdownMenu = dropdown(
width = "200px",
icon = icon("gear"),
materialSwitch(inputId = "Id079", label = "Color:"),
materialSwitch(inputId = "Id079", label = "Display Goal:"),
),
textOutput("text")
)
)
server <- function(input, output, session) {
output$text <- renderText("Hello World!")
}
shinyApp(ui, server)
To remove the arrow, one should change style to something other than the default. You can use fill or bordered for example.
shinyWidgets::dropdown(
width = "200px",
style = "fill",
icon = icon("cog"),
materialSwitch(inputId = "Id079", label = "Color:"),
# Change IDs to unique IDs otherwise it won't work
materialSwitch(inputId = "Id080", label = "Display Goal:"),
)
For the alignment, you can play around with the .label-default elements (attrinutes?)
ui <- fluidPage(
# Need to play with the margin-left part
tags$head(tags$style(HTML(".label-default{
margin-left: 50px;}
"))),
shinyWidgets::dropdown(
width = "300px",
style = "fill",
icon = icon("cog"),
materialSwitch(inputId = "Id079", label = "Color:"),
materialSwitch(inputId = "Id080", label = "Display Goal:"),
),
textOutput("text")
)
The problem with this is that it is not easy to uniformly change the margins for non-equal labels.

Filters in Mainpanel Horizontally

I'm trying to build Rshiny app, i have 3 tabs, but my problem is in the first one, I have 2 filters for this page "Country" and "Package" and i want to show in the top of main panel both filters but horizontally, i mean, Package should be in the right part of Country filter, How can i modify my current code to show both filters in one line?, Thanks !!
shinyAppui <- tagList(
useShinyjs(),
navbarPage(
title = "Alternative Risk Transfer - Parametric Weather Solutions",
id = "navbar",
tabPanel(title="Map",
value= "_map",
sidebarLayout(
sidebarPanel( width = NULL, height = NULL
# Filter for country
# pickerInput(inputId = "country_", label = strong(" Select Country"),
# choices = unique(Stations_static$Country), "Labels",
# options = list(`live-search` = TRUE)),
#
# # Filter for package
# uiOutput("data_filtered_country")
#
),
mainPanel(
pickerInput(inputId = "country_", label = strong(" Select Country"),
choices = unique(Stations_static$Country), "Labels",
options = list(`live-search` = TRUE), inline = TRUE),
uiOutput("data_filtered_country"),
leafletOutput("map_stations",width="150%",height="550px"),
DT::DTOutput("table_map",width="150%",height="550px")
)),
fluidRow(
style = "border-top: 1px solid; border-color: #A9A9A9; padding-top: 10px;padding-bottom: 10px;",
column(width = 8),
column(width = 2),
column(
width = 2,
style = "padding-left: 0px;",
actionButton(
inputId = "showTabRiskQuantification",
label = "Static data updated as of June 2020",
width = '100%'
)
)
)
), # ends tab panel
As #YBS said in the comment when you want to place objects in the same row you should use the fluidRow(column(),column(),...) structure. This will make your dashboard responsive as well. In this case it would look like this.
fluidRow(
column(
width = 3,
pickerInput(inputId = "country_", label = strong(" Select Country"),
choices = unique(Stations_static$Country), "Labels",
options = list(`live-search` = TRUE), inline = TRUE)
),
column(
width = 3,
uiOutput("data_filtered_country")
)
)
where you can play around with different values for width to get the spacing you want.

Create Center Navigation Bar in Shiny with Symbols

Currently, I have a shiny app built with the following UI structure.
tabsetPanel(tabPanel("Tab1"),
tabPanel("Tab2"),
tabPanel("Tab3"),
tabPanel("Tab4")
However, I would like to change the look and feel of the navigation bars. I would like to center the tabs in the middle of the page as opposed to having them left-aligned (This post is not reproducible and does not seem sustainable). Then insert a triangle in between each tab panel to show a "story line" to indicated content from tab1, 2, etc. is informing and influencing the rest of the dashboard. Then also have the tab highlighted each time the tab changes (green color below). I inserted a quick screenshot of the general UI format I am going for. I couldn't find much online of people trying to do this. Anything to put me in the right direction would be great! Much appreciated! The below is not a hard guidance or request, but just a general style.
You can mimic a layout like this using shinyWidgets::radioGroupButtons (and get reasonably close). Note that you still might need HTML/CSS customization of the buttons and arrows between them. This post might be a good resource: Create a Button with right triangle/pointer
library(shiny)
library(shinyWidgets)
ui <- fluidPage(titlePanel("Hack with shinyWidgets::radioGroupButtons"),
mainPanel(
fluidRow(
column(width = 3, "some space"),
column(
width = 9,
align = "center",
radioGroupButtons(
inputId = "item",
label = "",
status = "success",
size = "lg",
direction = "horizontal",
justified = FALSE,
width = "100%",
individual = TRUE,
checkIcon = list(
"yes" = icon("check"),
"yes" = icon("check"),
"yes" = icon("check"),
"yes" = icon("check")
),
choiceNames = as.list(names(iris)[1:4]),
choiceValues = as.list(1:4)
)
)
),
tags$hr(),
column(width = 3, "some space"),
column(
width = 9,
align = "center",
textOutput("text"),
wellPanel(dataTableOutput("out"))
)
))
server <- function(input, output) {
out_tbl <- reactive({
x <- iris[,c(5, as.numeric(input$item))]
return(x)
})
output$out <- renderDataTable({
out_tbl()
},options = list(pageLength = 5)
)
output$text <- renderText({paste("Contents for tab", input$item)})
}
shinyApp(ui, server)
A screen shot of the layout:

Removing gap between columns in splitLayout within dashboardSidebar

I'm using the splitLayout() function within a dashboardSidebar() from the shinydashboard package. When I do, there is a significant gap between inputs within my splitLayout().
When I used vanilla shiny, I could control this gap with parameter cellArgs = list(style="padding: 0px") but this seems to have a different effect within a dashboardSidebar().
Question:
How can I control the gap between inputs inside a splitLayout() within a dashboardSidebar()?
Here is a MRE which shows my unsuccessful attempts at using padding
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(width=400,
sidebarMenu(
menuItem("Default", tabName = "dashboard", icon = icon("dashboard"),startExpanded = T,
splitLayout(cellWidths = c(100,100,100,100),
textInput("a1",label=NULL,value = 1),
textInput("a2",label=NULL,value = 2),
textInput("a3",label=NULL,value = 3),
textInput("a4",label=NULL,value = 4)
),
splitLayout(cellWidths = c(100,100,100,100),cellArgs = list(style="padding: 0px"),
textInput("b1",label=NULL,value = 1),
textInput("b2",label=NULL,value = 2),
textInput("b3",label=NULL,value = 3),
textInput("b4",label=NULL,value = 4)
),
#see the effect of padding
splitLayout(cellWidths = c(100,100,100,100),cellArgs = list(style="padding: 20px"),
textInput("c1",label=NULL,value = 1),
textInput("c2",label=NULL,value = 2),
textInput("c3",label=NULL,value = 3),
textInput("c4",label=NULL,value = 4)
)
)
)
)
body <- dashboardBody(
)
# Put them together into a dashboardPage
ui <- dashboardPage(
dashboardHeader(title = "Padding demo",titleWidth=400),
sidebar,
body
)
server <- function(input, output) {
}
shinyApp(ui,server)
your problem is not the padding of the the splitCells - that is working fine. It has more to do with that the inputs also have padding around them. To remove this you can add the following code
body <- dashboardBody(
tags$head(
tags$style(
".shiny-input-container{padding:0px !important;}"
)
)
)
hope this helps

Shiny: How to adjust the width of the tabsetPanel?

Here is my app embedded in my site. I want to get rid of the scroll widget below my app, this is due to the width of the tabsetPanel.
I embed the app using this code:
<iframe width="800" height="480" frameborder="0" src="http://spark.rstudio.com/alstated/meanvar/"></iframe>
App Codes:
ui.R
library(shiny)
# Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
headerPanel(title = ""),
sidebarPanel(
sliderInput("size",
"Number of Observations",
min = 10,
max = 200,
value = 95),
sliderInput("mu",
"Mean",
min = -100,
max = 100,
value = 0),
sliderInput("sd",
"Standard Deviation",
min = 1,
max = 6,
value = 3),
checkboxInput(inputId = "indiv_obs",
label = "Show individual observations",
value = FALSE),
checkboxInput(inputId = "density",
label = "Show density estimate",
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth Adjustment",
min = 0.2,
max = 2,
value = 1,
step = 0.2))
),
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
))
)
)
server.R
library(shiny)
# Define server logic required to generate and plot a random distribution
shinyServer(function(input, output) {
data <- reactive(rnorm(
n = input$size,
mean = input$mu,
sd = input$sd
))
output$histogram <- renderPlot({
hist(data(),
probability = TRUE,
xlab = "Data",
ylab = "Density",
main = "Histogram of Random Samples")
if(input$indiv_obs){
rug(data())
}
if(input$density){
dens <- density(data(), adjust = input$bw_adjust)
lines(dens, col = "blue")
}
})
output$datsummary <- renderPrint(summary(data()))
})
Any help is greatly appreciated!
I figure it now, I inspect the html code of the app on Shiny Homepage. And the tabsetPanel is adjusted using the <div> (Document Division) tag in html by setting the option class to either span1, span2, span3 and so on. The higher the suffix of the span the larger the width of the division. And I just add div() tag in my ui.R code:
div(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
), class = "span7")
Another way to adjust width (and height):
add
), style='width: 1000px; height: 1000px' # end of tabsetPanel
after tabsetPanel, no need for div() in this case
The examples above work in certain circumstances. I needed a more general solution. The following solution can be tailored to any situation. For example, your Shiny app could still be responsive.
My solution
First, create a div before the tabsetPanel and give it a class. Second, write a piece of jQuery/javascript to find the parent element of that div. Third, change the class of this parent element using javascript/jQuery. You can change the class into anything you like, for example, col-sm-12, col-sm-11, some other standard Bootstrap class or you can add and create your own class. Fourth, add the custom jQuery/javascript to your Shiny application (make sure that you save the .js-file in the www folder of your Shiny app).
Here is my example:
Javascript/jQuery (general.js):
$(function (){
$("div.delParentClass").parent().removeClass("col-sm-8").addClass("col-sm-12");
/* In addClass you can specify the class of the div that you want. In this example,
I make use of a standard Bootstrap class to change the width of the tabset: col-sm-12.
If you want the tabset to be smaller use: col-sm-11, col-sm-10, ... or add
and create your own class. */
});
Shiny UI
mainPanel(
tags$head(tags$script(src="general.js")),
div(class="delParentClass",
tabsetPanel(
tabPanel("Some panel", .....),
tabPanel("Some panel", .....),
tabPanel("Some panel", .....)
)
)
)
A different way to adjust the width of sidebarPanel and tabsetPanel was based on modifying the width property of the col-sm-4 and col-sm-8 CSS classes, respectively.
Using tag$head and tag$style it is possibile to add CSS directly to the Shiny UI.
See https://shiny.rstudio.com/articles/css.html for details.
This is not an elegant solution, but it works correctly.
Shiny UI
shinyUI(fluidPage(
tags$head(
tags$style(HTML("
.col-sm-4 { width: 25%;}
.col-sm-8 { width: 75%;}
"))
),
headerPanel(title = ""),
sidebarPanel(
sliderInput("size",
"Number of Observations",
min = 10,
max = 200,
value = 95),
sliderInput("mu",
"Mean",
min = -100,
max = 100,
value = 0),
sliderInput("sd",
"Standard Deviation",
min = 1,
max = 6,
value = 3),
checkboxInput(inputId = "indiv_obs",
label = "Show individual observations",
value = FALSE),
checkboxInput(inputId = "density",
label = "Show density estimate",
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth Adjustment",
min = 0.2,
max = 2,
value = 1,
step = 0.2))
),
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
))
)
)

Resources