How I can center the header columns on reactable (r-package)? - r

Hi and thanks for reading me
I am working on some tables with the "reactable" package in r, but I would like to center only the headings of each column. For example:
library(reactable)
reactable(iris,
defaultColDef = colDef(
header = function(value) gsub(".", " ", value, fixed = TRUE),
cell = function(value) format(value, nsmall = 1),
align = "center",
minWidth = 70,
headerStyle = list(background = "#12a09a")
))
Apparently the option colDef(align = "center") centers the entire column, but is there an option to only center the title?

i assume that you are using this tables in an R markdown document or a shiny app. In both you can override the css in order to left align the table text or let the default table and center the title.
In the first case you just need to add this line .rt-align-center{text-align: left;}.
In shiny you just need to add that to your custom css or use the style tag to add it inline like the example below:
library(shiny)
library(reactable)
ui <- fluidPage(
# inline style tag to define table row text alignment
tags$style(HTML(".rt-align-center {text-align: left;}")),
titlePanel("Iris react table"),
sidebarLayout(
sidebarPanel(
helpText("Nothing to see here")
),
mainPanel(
reactableOutput("table")
)
)
)
server <- function(input, output) {
output$table <- renderReactable({
reactable(iris,
defaultColDef = colDef(
header = function(value) gsub(".", " ", value, fixed = TRUE),
cell = function(value) format(value, nsmall = 1),
align = "center",
minWidth = 70,
headerStyle = list(background = "#12a09a")
))
})
}
shinyApp(ui = ui, server = server)
If you are working with an Rmarkdown document just add it to the html in the style tag like this:
<style> .rt-align-center {text-align: left;} </style>
and the result:

Related

How to adjust the size of text and otherwise format the text rendered in a popover in R shiny?

In running the below code, when hovering the cursor over one of the images rendered in the "Col_help" column on the right of the table, a message pops up to assist the user. How do I increase the font size of that popover text and the size of that popover box too? I would also like to also edit the text so that it is easier for the reader, such as inserting line breaks, using bullet list, etc. Is this possible too?
The reason I am doing this is to provide the user with "helps" in this manner.
Code:
library(magrittr)
library(htmlwidgets)
library(rhandsontable)
library(shiny)
DF = data.frame(
Col_1 = c("This is row 1","This is row 2"),
Col_Help = c(
as.character(img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png", title = "My first help text", style = "width: 50px;")),
as.character(img(src = "https://images.plot.ly/language-icons/api-home/r-logo.png", title = "My second help text", style = "width: 50px;"))
),
text = c("Row 1 does xxx","Row 2 does yyy"),
stringsAsFactors = FALSE
)
ui <- fluidPage(br(),rHandsontableOutput('my_table'))
server <- function(input, output, session) {
output$my_table <- renderRHandsontable({
rhandsontable::rhandsontable(
DF,
allowedTags = "<em><b><strong><a><big><img>"
) %>%
hot_cols(colWidths = c(200, 80)) %>%
hot_col(1:2, renderer = htmlwidgets::JS("safeHtmlRenderer")) %>%
hot_cols(colWidths = ifelse(names(DF) != "text", 100, 0.1))
})
}
shinyApp(ui, server)

RShiny: Reducing bootstrap table cell padding when using `bs_theme()`

# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
I am trying to create a table using the bs_theme() function from the bslib package, specifically using the theme lux. The tables are very large and the cells have massive padding. Adding the "table-cell-padding" argument in bs_theme() doesn't change the cell sizes. How do I make the table compact and the cells tight around the numbers/column names?
Just add tags$style('#DT1 td {padding: 0}'), how simple is that.
# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
tags$style('#DT1 td {padding: 0}'),
# style = "width: 50%",
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
Change the padding: 0 to any valid css unit you want, here I changed to 0, no padding. It will seem that it doesn't work on left and right, that's because you have autoWidth, it will always use the full width of the parent node. So, if you want the width to be smaller, uncomment the style line above, you should see is't only half of the screen.

R Shiny Sortable CSS: Apply different class to labels within the same bucket_list

I am trying to maintain the colour of a given label (e.g "Blue" = blue colour; "Green" = green colour) regardless of the bucekt_list in which it resides. However, I have only been able to modify the CSS for a given bucket_list rather than to individual labels themselves. Therefore, the labels do not maintain their respective colours when dragged into a different bucket_list currently.
library(shiny)
library(sortable)
ui <- fluidPage(
tags$style( HTML(".green-sortable .rank-list-item {
background-color: #53C1BE;
}"),
HTML(".blue-sortable .rank-list-item {
background-color: #4080C9;
}")),
fluidRow(column(6, uiOutput("example1")),
column(6, uiOutput("example2")))
)
server <- function(input, output, session) {
output$example1 <- renderUI({
bucket_list(
header = NULL,
group_name = "colours",
orientation = "horizontal",
class = c("default-sortable", "green-sortable"),
add_rank_list(
text = " ",
input_id = "green",
labels = "Green"
))
})
output$example2 <- renderUI({
bucket_list(
header = NULL,
group_name = "colours",
orientation = "horizontal",
class = c("default-sortable", "blue-sortable"),
add_rank_list(
text = " ",
input_id = "blue",
labels = "Blue"
))
})
}
shinyApp(ui, server)
How could this be modified to as to have the blue and green labels remain blue and green in colour, respectively, regardless of the bucket_list into which they have been dragged?
You need to define the element via a html tag (wrapped in a list) rather than a pure character. In the latter case, sortable will style the elemnt for you and you would need to go through some JS pain, to re-style it. Hence, it is easier to control the element yourself.
However, since your element is still placed in an outer <div> with some styling (most notably a padding) you need some extra css to get to a similiar look and feel.
library(shiny)
library(sortable)
ui <- fluidPage(
tags$style( HTML("#green {
background-color: #53C1BE;
}
.default-sortable .rank-list-container .rank-list-item {
padding: 0;
}
.rank-list-item > div {
line-height:42px;
}
#blue {
background-color: #4080C9;
}")),
fluidRow(column(6, uiOutput("example1")),
column(6, uiOutput("example2")))
)
server <- function(input, output, session) {
output$example1 <- renderUI({
bucket_list(
header = NULL,
group_name = "colours",
orientation = "horizontal",
class = c("default-sortable", "green-sortable"),
add_rank_list(
text = " ",
input_id = "green",
labels = list(div("Green", id = "green")) ## define your element yourself
))
})
output$example2 <- renderUI({
bucket_list(
header = NULL,
group_name = "colours",
orientation = "horizontal",
class = c("default-sortable", "blue-sortable"),
add_rank_list(
text = " ",
input_id = "blue",
labels = list(div("Blue", id = "blue")) ## define your element yourself
))
})
}
shinyApp(ui, server)

R DT Horizontal scroll bar at top of the table

I have a wide and lengthy DT in shiny. By default I would like to show the horizontal scroll bar on top of the table. Is there a way to do this? My current DT definition looks like below:
DT::datatable(dt, rownames = FALSE,
filter = fbox,
style = "bootstrap",
options = list(
dom = dom,
scrollX = TRUE,
columnDefs = list(list(orderSequence = c('desc', 'asc'), targets = "_all")),
processing = FALSE,
pageLength = 500,
lengthMenu = list(c(500, 1000, 5000), c("500","1000","5000"))
),
callback = DT::JS("$(window).unload(function() { table.state.clear(); })")
) %>% DT::formatStyle(., cn_cat, color = "black", backgroundColor = "#dee6ea",fontWeight = "bold")
Thanks in advance.
Flip Scrollbar for All DataTables in App
You could add some css to flip the div containing the scrollbar/table and then flip back the table content, as per this answer:
.dataTables_scrollBody {
transform:rotateX(180deg);
}
.dataTables_scrollBody table {
transform:rotateX(180deg);
}
Flip Scrollbar for Specific DataTable
If you only want to flip the scroll bar on one table, you could select the specific table:
#flipped > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody {
transform:rotateX(180deg);
}
#flipped > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody table{
transform:rotateX(180deg);
}
Example
library(shiny)
library(DT)
css <- HTML(
"#flipped > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody {
transform:rotateX(180deg);
}
#flipped > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody table{
transform:rotateX(180deg);
}"
)
ui <- fluidPage(
tags$head(tags$style(css)),
fluidRow(column(width = 6,
h4("Flipped Scrollbar"),
br(),
DT::dataTableOutput("flipped")
),
column(width = 6,
h4("Regular Scrollbar"),
br(),
DT::dataTableOutput("regular")
)
)
)
server <- function(input, output, session) {
output$flipped <- DT::renderDataTable({
DT::datatable(mtcars, rownames = FALSE,
options = list(
scrollX = TRUE
)
)
})
output$regular <- DT::renderDataTable({
DT::datatable(mtcars, rownames = FALSE,
options = list(
scrollX = TRUE
)
)
})
}
shinyApp(ui, server)
I managed to get the Scrollbar on top using what #HallieSwam suggested, but looked into the source HTML code to understand what parts needed to be rotated.
What worked for me:
tags$head(tags$style(HTML(
"#Table1 .dataTables_scrollBody {transform:rotate(180deg);}
#Table1 .dataTables_scrollHead {transform:rotate(180deg);}
#Table1 .dataTables_scroll table {transform:rotate(180deg);}
"
)))
scrollBody turns the whole table, including the scrolling bar, then scrollHead is required to align the scrolling bar with the header in the final table. Scroll table will turn just the content in the table, leaving the scrolling bar on top.

A dynamically resizing shiny textAreaInput box?

I am trying to make a textAreaInput box in shiny that spans 100% of my webpage and resizes when the browser is min/maximised. I can make a simple textInput with this behavior by supplying the argument width = 100%. Supplying the same argument to textAreaInput does not produce the same behavior even though width has the same description on the textInput and textAreaInput man pages. Is this desired behavour or a bug?
A minimal working example -
library(shiny)
shinyApp(
#UI
ui = fluidPage(
fluidRow(
column(12,
textAreaInput("big_box", "Big box", value = "", width = '100%', rows = 5, resize = "both")
)
),
fluidRow(
column(12,
textInput("long_box", "Long box", value = "", width = '100%')
)
)
),
#Server
server = function(input, output) {
}
)
Example output -
Cheers
A simpler workaround is to set the height and width parameters to the parent element, using shiny::tagAppendAttributes function.
For example:
textAreaInput("big_box", "Big box", value = "", rows = 5, resize = "both") %>%
shiny::tagAppendAttributes(style = 'width: 100%;')
Or you could just override the css by using a header tag within your ui function e.g:
tags$style(HTML("
.shiny-input-container:not(.shiny-input-container-inline) {
width: 100%;
}"))
textAreaInput was recently added to Shiny in version 14, it seems that it is a bug cause by the class shiny-input-container. In shiny.css we can find:
/* Limit the width of inputs in the general case. */
.shiny-input-container:not(.shiny-input-container-inline) {
width: 300px;
max-width: 100%;
}
The simplest workaround is to create a new function based on the original without the class shiny-input-container. Below is the new function.
library(shiny)
#based on Shiny textAreaInput
textAreaInput2 <- function (inputId, label, value = "", width = NULL, height = NULL,
cols = NULL, rows = NULL, placeholder = NULL, resize = NULL)
{
value <- restoreInput(id = inputId, default = value)
if (!is.null(resize)) {
resize <- match.arg(resize, c("both", "none", "vertical",
"horizontal"))
}
style <- paste("max-width: 100%;", if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"), if (!is.null(height))
paste0("height: ", validateCssUnit(height), ";"), if (!is.null(resize))
paste0("resize: ", resize, ";"))
if (length(style) == 0)
style <- NULL
div(class = "form-group",
tags$label(label, `for` = inputId), tags$textarea(id = inputId,
class = "form-control", placeholder = placeholder, style = style,
rows = rows, cols = cols, value))
}
shinyApp(
#UI
ui = fluidPage(
fluidRow(
column(12,
textAreaInput2("big_box2", "Big box", value = "", width = '100%', rows = 5, resize = "both")
)
),
fluidRow(
column(12,
textInput("long_box", "Long box", value = "", width = '100%')
)
)
),
#Server
server = function(input, output) {
}
)

Resources