Hi i made this awesome table with kableExtra, but my only problem is that the height of the rows is not always equal. Does any one know a remedy for this?
my table:
for example, as you can see, the line for item number 22 (6th row) has a larger height (spacing) than other lines.
my code:
my_column_names = c("Item number", "Item",
"Emotion", "Social",
"At Home", "Body", "Emotion",
"Social 1", "Social 2",
"At Home", "Body")
kable(df1,
format = "latex", booktabs = TRUE,
col.names = my_column_names,
caption = "Factor loadings for the 4 and 5 Factor Model") %>%
kable_styling(latex_options = c("striped", "hold_position"),
full_width = FALSE) %>%
add_header_above(c(" " = 2,
"4 Factor Model " = 4, "5 Factor model" = 5)) %>%
add_header_above(c(" " = 2,
"Model" = 9)) %>%
kableExtra::landscape()
The reason why the row height is not always equal is that by default kable inserts a \addlinespace every 5th rows. To get rid of it, put linesep = "" in kable(). See Get rid of \addlinespace in kable for details.
Usually, this is something that you can change via CSS in an HTML table. Not sure how to do this with kableExtra but you might want to consider tableHTML to do it. I am adding a small example below to demonstrate row height:
library(tableHTML)
tableHTML(mtcars[1:10, ],
border = 1,
rownames = TRUE,
caption = 'This is a caption',
footer = 'This is a footer',
widths = c(140, rep(50, 11)),
second_headers = list(c(2, 5, 6), c('', 'col2', 'col3')),
theme = 'scientific') %>%
add_css_row(list('height', '50px'), rows = 3:12)
You don't need to use the scientific theme if you don't want to. The package gives you flexibility to add any css you like (like striped rows, etc.). You can check a tutorial here if interested.
P.S. It currently only supports one extra header. Apart from that your whole table can be replicated.
Related
I'm attempting to combine the use of R packages formattable and kableExtra to create a data-table. Using formattable, I'm adding a green thumbs up symbol to one particular column ("b") for numbers > 0, this displays correctly. I then pass my table to "kable" so that I can add the "hover" feature, widen column 1, and add grouped headers. However, whilst the produced data-table correctly displays the "hover" feature and correct grouped headers, the green thumbs up feature (derived from formattable) is missing.
Here is a minimal, reproducible example:
library(formattable)
library(kableExtra)
library(dplyr)
labels <- c("A", "B", "C")
a <- c(0.22, 0.28, 0.23)
b <- c(890.53, 346.84, 1119.63)
c <- c(6.56, 5.70, 4.59)
d <- c(0.0048, -0.3194, -0.2720)
e <- c(-0.3212, 0.1280, 0.0755)
f <- c("-", "-", "-")
df <- tibble(labels,a,b,c,d,e,f)
customGreen = "#71CA97"
# function to assign a thumbs up to numbers > 0
custom_thumb <- formatter("span", style = x ~ style(font.weight = "bold",
color = ifelse(x > 0, customGreen, ifelse(x < 0, customRed, "black"))),
x ~ icontext(ifelse(x > 0, "thumbs-up", ""), x)
)
# use formattable to add thumbs up symbols
df_frmt <- formattable(df, align =c("l","c","c","c","c","c","c"),
list(`labels` = formatter("span"),
`b` = custom_thumb))
# pass the resulting table to kable for further edits
df_kbl <- kbl(df_frmt, escape = T) %>%
kable_styling("hover", full_width = F) %>%
column_spec(1, width = "5cm") %>%
add_header_above(c(" "=2, "Group 1" = 2, "Group 2" = 2, " " = 1))
df_kbl
Given that the hover feature and grouped headers is working well, is the issue something to do with escaping html? I've tried both "escape=T" and "escape=F" in the kable edit though there's no change. I know that both of these packages can be used together from reading the "Integration with formattable" section of this website. I don't know if it's relevant or not, but I'm running this code in an RMarkdown file inside RStudio. Any helps is appreciated!
Following your mentioned link, combining formattable and kableExtra is not done by passing a formattable to the kbl function.
Instead you might use custom (your custom_thumb) or original functions (color_bar or color_tile) from formattable and integrate them into the kableExtra syntax.
df %>%
mutate(b = custom_thumb(b)) %>%
kable("html", escape = F, align = c("l","c","c","c","c","c","c")) %>%
kable_styling("hover", full_width = F) %>%
column_spec(1, width = "5cm") %>%
add_header_above(c(" " = 2, "Group 1" = 2, "Group 2" = 2, " " = 1))
I created a datatable in a flexdashboard with a checkbox, but the checkbox flows off the page. I tried to adjust the padding {data-padding = 10} but nothing changed. Below is the code and a picture of what the dashboard looks like. How do I move everything to the right so that it's aligned with the title of the page?
---
title: "School Dashboard"
author: "Shannon Coulter"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
theme: spacelab
---
```{r}
library(tidyverse)
library(crosstalk)
library(DT)
library(flexdashboard)
```
Student Lookup
================================================================================
### Chronic Absenteeism Lookup
```{r ca-lookup, echo=FALSE, message=FALSE, warning=FALSE}
ican_tab <- tibble(
year = c("2022", "2022", "2022", "2022", "2022"),
date = c("March", "March","March","March","March"),
school = c("ABC", "CDE","ABC","DEF","GHI"),
grade = c("6th", "7th","8th","4th","5th"),
race_eth = c("White", "Hispanic","White","Filipino","White"),
abs_levels = c("Not At-Risk of Chronic Absenteeism", "At-Risk of Chronic Absenteeism",
"Severe Chronic Absenteeism", "Severe Chronic Absenteeism",
"Moderate Chronic Absenteeism")
)
sd <- SharedData$new(ican_tab)
bscols(list(
filter_checkbox("abs_levels", "Level", sd, ~ abs_levels, inline = TRUE),
datatable(
sd,
extensions = c("Buttons",
"Scroller"),
options = list(
autoWidth = TRUE,
scrollY = F,
columnDefs = list(list(
className = 'dt-center',
targets = c(2, 3, 4, 5)
)),
lengthMenu = c(5, 10, 25, 100),
dom = "Blrtip",
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
buttons = list('copy',
'csv',
'pdf',
'print')
),
filter = "top",
style = "bootstrap",
class = "compact",
width = "100%",
colnames = c(
"Year",
"Date",
"School",
"Grade",
"Race",
"Level"
)
) %>%
formatStyle('abs_levels',
backgroundColor = styleEqual(
unique(ican_tab$abs_levels),
c(
"#73D055ff",
"#95D840FF",
"#B8DE29FF",
"#DCE319FF"
)
))
))
```
[![enter image description here][1]][1]
The easiest way to address this is probably to add style tags to your dashboard. You can put this anywhere. I usually put it right after the YAML or right after my first R chunk, where I just place my knitr options and libraries. This does not go inside an R chunk.
<style>
body { /*push content away from far right and left edges*/
margin-right: 2%;
margin-left: 2%;
}
</style>
Update based on your updated question and comments
I don't have the content around your table, so I will give you a few options that work. For the most part, any one option won't be enough. You can mix and match the options that work best for you.
This is what I've got for the original table:
Option 1: you can use CSS to push the table away from the edges (as in my original response
Option 2: change the font sizes
Option 3: constrain the size of the datatable htmlwidget
Option 4: manually make the columns narrower
Option 5: alter the filter labels (while keeping the same filters and data)
Aesthetically looks the best? It depends on what else is on the dashboard.
I think you will need the original CSS (option 1, in my original answer) regardless of what other options you choose to use.
Option 1 is above
Option 2
To change the font sizes, you have to modify the filter_checkbox and the datatable after they're made. Instead of presenting all of the programming code, I'm going to show you want to add or modify and how I broke down the objects.
Your original code for filter_checkbox remains the same. However, you'll assign it to an object, instead of including it in bscols.
Most of the code in your datatable will remain the same. there is an addition to the parameter options. I've included the original and change for that parameter.
# filter checkbox object
fc = filter_checkbox(...parameters unchanged...)
fc$attribs$style <- css(font.size = "90%") # <-change the font size
dt = datatable(
...
...
options = list( # this will be modified
autoWidth = TRUE, # <- same
scrollY = F, # <- same
initComplete = JS( # <- I'M NEW! change size of all font
"function(settings, json) {",
"$(this.api().table().container()).css({'font-size': '90%'});",
"}"),
columnDefs = list( # <- same
list(className = 'dt-center', targets = c(2, 3, 4, 5))),
...
... # remainder of datatable and formatStyles() original code
)
# now call them together
bscols(list(fc, dt))
The top version is with 90% font size, whereas the bottom is the original table.
Option 3
To constrain the size of the datatable widget, you'll need to create the object outside of bscols, like I did in option 2. If you were to name your widget dt as in my example, this is how you could constrain the widget size. This example sets the datatable to be 50% of the width and height viewer screen (or 1/4 of the webpage). Keep in mind that the filters are not part of the widget, so in all, the table is still more than 1/4th of the webpage. You will have to adjust the size for your purposes, of course. I recommend using a dynamic sizing mechanism like vw, em, rem, and the like.
dt$sizingPolicy$defaultWidth <- "50vw"
dt$sizingPolicy$defaultHeight <- "40vh"
The top image has options 1, 2, and 3; the bottom is the original table.
Option 4
To modify the width of the columns, you can add this modification to the parameter options in you call to datatable. This could be good, because most of the columns don't require as much width as the last column. However, if you change the font size or scale the table, it will change the font size dynamically, so this option may not be necessary.
Despite using em here, in the course of this going from R code to an html_document, it was changed to pixels. So this is not dynamically sized. (Not a great idea! Sigh!)
columnDefs = list(
list(className = 'dt-center', targets = c(2, 3, 4, 5)),
list(width = '5em', targets = c(1,2,3,4,5))), # <- I'm NEW!
Option 5
For this option, I took the programming behind crosstalk::filter_checkbox() and modified the code a bit. I changed the function to filter_checkbox2(). If you use it, you can render it both ways and just keep the one you like better.
This first bit of code is the three functions that work together to create a filter_checkbox object with my modifications so that you can have a label that isn't exactly the same as the levels.
It's important to note that the filters are alphabetized by datatable. It doesn't matter if they're factors, ordered, etc. If you use this new parameter groupLabels, they need to be in an order that aligns with the levels when they're alphabetized.
I put this code in an include=F chunk by itself:
# this is nearly identical to the original function
filter_checkbox2 = function (id, label, sharedData, group,
groupLabels = NULL, # they're optional
allLevels = FALSE, inline = FALSE, columns = 1) {
options <- makeGroupOptions(sharedData, group,
groupLabels, allLevels) # added groupLabels
labels <- options$items$label
values <- options$items$value
options$items <- NULL
makeCheckbox <- if (inline)
inlineCheckbox
else blockCheckbox
htmltools::browsable(attachDependencies(tags$div(id = id,
class = "form-group crosstalk-input-checkboxgroup crosstalk-input",
tags$label(class = "control-label", `for` = id, label),
tags$div(class = "crosstalk-options-group",
crosstalk:::columnize(columns,
mapply(labels, values, FUN = function(label, value) {
makeCheckbox(id, value, label)
}, SIMPLIFY = FALSE, USE.NAMES = FALSE))),
tags$script(type = "application/json", `data-for` = id,
jsonlite::toJSON(options, dataframe = "columns",
pretty = TRUE))),
c(list(crosstalk:::jqueryLib()),crosstalk:::crosstalkLibs())))
}
inlineCheckbox = function (id, value, label) { # unchanged
tags$label(class = "checkbox-inline",
tags$input(type = "checkbox",
name = id, value = value),
tags$span(label))
}
# added groupLabels (optional)
makeGroupOptions = function (sharedData, group, groupLabels = NULL, allLevels) {
df <- sharedData$data(withSelection = FALSE, withFilter = FALSE,
withKey = TRUE)
if (inherits(group, "formula"))
group <- lazyeval::f_eval(group, df)
if (length(group) < 1) {
stop("Can't form options with zero-length group vector")
}
lvls <- if (is.factor(group)) {
if (allLevels) {levels(group) }
else { levels(droplevels(group)) }
}
else { sort(unique(group)) }
matches <- match(group, lvls)
vals <- lapply(1:length(lvls), function(i) {
df$key_[which(matches == i)]
})
lvls_str <- as.character(lvls)
if(is.null(groupLabels)){groupLabels = lvls_str} # if none provided
if(length(groupLabels) != length(lvls_str)){ # if the # labels != the # groups
message("Warning: The number of group labels does not match the number of groups.\nGroups were used as labels.")
groupLabels = lvls_str
}
options <- list(items = data.frame(value = lvls_str, label = groupLabels, # changed from lvls_str
stringsAsFactors = FALSE), map = setNames(vals, lvls_str),
group = sharedData$groupName())
options
}
When I used this new version of I changed label = "Level" to label = "Chronic Absenteeism Level". Then removed " Chronic Absenteeism" from the filter labels. The data and the datatable does not change, just the filter checkbox labels.
filter_checkbox2("abs_levels", "Chronic Absenteeism Level",
sd, ~ abs_levels, inline = TRUE,
groupLabels = unlist(unique(ican_tab$abs_levels)) %>%
str_replace(" Chronic Absenteeism", "") %>% sort())
The first image is your table with options 1, 2, 3, and 5 (not 4).
The top version in the next image has options 1, 2, 3, and 5 (not 4). The bottom is the original table. After that
If I've left anything unclear or if have any other questions, let me know.
I created an R Markdown HTML report where I am using Kable tables. I am trying to convert this report into a Shiny dashboard, and I noticed that the Kable table from the report does not display the images in Shiny.
This is how the table displays in Rmd:
This is how the table displays in Shiny:
This is the code that produces the tables: The images are picked (status_image and significance_image) change depending their pct_change and significant_greater_less_pvalue values.
dt_2 <- cbind(initial_medians_table(), medians_significance_df) %>%
mutate(notes = "",
status_image = paste("![](www/", ifelse(pct_change <= 0, "down_arrow_green", "up_arrow_red"), ".png)", sep = ""),
significance_image = paste("![](www/", ifelse(significant_greater_less_pvalue < input$pvalue_threshold, "significant", "not_significant"), ".png)", sep = ""),
medians_analysis = paste(medians_analysis, " mins (", round(medians_analysis/(24*60), 2), " days)", sep = ""),
medians_baseline = paste(medians_baseline, " mins (", round(medians_baseline/(24*60), 2), "days)", sep = "")) %>%
select(V1, V2, medians_analysis, medians_baseline, change, status_image, significance_image, notes)
And this is how I am rendering in Shiny:
ui.R
uiOutput("tableset")
server.R
output$tableset <- renderUI({
out <- kable(medians_and_significant_test(), align = rep('c', ncol(medians_and_significant_test())), escape = FALSE,
col.names = c("High-Level Process",
"Deeper-Level Process",
"Analysis (Median)",
"Baseline (Median)",
"% Change",
"Performance",
"Statistically Significant?",
"Notes")) %>%
kable_styling(c("striped", "condensed", "hover", "responsive"), full_width = F) %>%
kableExtra::group_rows(index = c("Level 0" = 1, "Level 1" = 3, "Level 2" = 6)) %>%
footnote(symbol = c(paste("Significance test used:", input$sig_test_selected),
paste("p-value threshold used is", input$pvalue_threshold, "to test for significant"))
)
HTML(out)
})
I am using the wrong "string" or call for rendering the images in a cell? I am also happy to use DT if anyone knows how to render images from the www app folder on the cell.
Thanks in advance
I'm using the kableExtra package to output a table to PDF in R markdown.
I use the command group_rows() to group some rows of my table together.
The text in some rows of my first column is too long for the column width, so it is broken into two lines. However, there is no indentation of the second line. Is there a way to either indent also the second line or remove the indentation overall?
Increasing the column width so the text won't be spread over two lines is unfortunately no option since I have way more columns in my real table.
This is a subset of my data frame:
data <- structure(list(`Control variables` = c("GDP growth", "GDP per capita",
"Top income tax rate", "Right-wing executive"), Treated = structure(c("2.29",
"21,523.57", "0.70", "0.62"), class = "AsIs"), top10_synthetic = structure(c("3.37", "19,939.72", "0.68", "0.63"), class = "AsIs"), top10_mean = structure(c("2.95", "30,242.60", "0.64", "0.43"), class = "AsIs")), .Names = c("Control variables", "Treated", "top10_synthetic", "top10_mean"), row.names = c(NA, 4L), class = "data.frame")
This is the code I am using:
```{r}
kable(data, "latex", caption = "table 1", booktabs = T, col.names = c("Control variables", "Treated", "Synthetic", "Mean")) %>%
add_header_above(c("", "", "Top 10%" = 2)) %>%
group_rows("UK", 1, 2) %>%
group_rows("Japan", 3, 4, latex_gap_space = "0.8cm") %>%
footnote(general = "xxx") %>%
kable_styling(latex_options = c("HOLD_position", "scale_down")) %>%
column_spec(1, width = "3cm")
```
This is how the .pdf output looks like. As you can see, e.g. the text "top income tax rate" is split into two lines and I would like the second line to be indented just like the first line.
Thank you for any tips!
If you just run the chunk in the R console, you'll see this LaTeX output:
\begin{table}[H]
\caption{\label{tab:}table 1}
\centering
\resizebox{\linewidth}{!}{
\begin{tabular}[t]{>{\raggedright\arraybackslash}p{3cm}lll}
\toprule
\multicolumn{1}{c}{} & \multicolumn{1}{c}{} & \multicolumn{2}{c}{Top 10\%} \\
\cmidrule(l{2pt}r{2pt}){3-4}
Control variables & Treated & Synthetic & Mean\\
\midrule
\addlinespace[0.3em]
\multicolumn{4}{l}{\textbf{UK}}\\
\hspace{1em}GDP growth & 2.29 & 3.37 & 2.95\\
\hspace{1em}GDP per capita & 21,523.57 & 19,939.72 & 30,242.60\\
\addlinespace[0.8cm]
\multicolumn{4}{l}{\textbf{Japan}}\\
\hspace{1em}Top income tax rate & 0.70 & 0.68 & 0.64\\
\hspace{1em}Right-wing executive & 0.62 & 0.63 & 0.43\\
\bottomrule
\multicolumn{4}{l}{\textit{Note: }}\\
\multicolumn{4}{l}{xxx}\\
\end{tabular}}
\end{table}
As you can see, kableExtra isn't putting in a line break in that title, LaTeX is doing it. This means you need a LaTeX fix for the problem. Maybe someone else knows an easier one, but the best I could find is the following: wrap the long row title in a minipage environment, and fiddle with the spacing to look better.
Since this is kind of messy, I'd write an R function to do it:
inMinipage <- function(x, width)
paste0("\\begin{minipage}[t]{",
width,
"}\\raggedright\\setstretch{0.8}",
x,
"\\vspace{1.2ex}\\end{minipage}")
This needs to be called on the data being put into the table, and kable needs to be told not to escape those backslashes (using escape = FALSE). In addition, the \setstretch command comes from the setspace LaTeX package. So overall your sample document would look like this:
---
output:
pdf_document:
extra_dependencies: setspace
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(kableExtra)
library(knitr)
```
```{r}
inMinipage <- function(x, width)
paste0("\\begin{minipage}[t]{",
width,
"}\\raggedright\\setstretch{0.8}",
x,
"\\end{minipage}")
data <- structure(list(`Control variables` = c("GDP growth", "GDP per capita", "Top income tax rate", "Right-wing executive"), Treated = structure(c("2.29",
"21,523.57", "0.70", "0.62"), class = "AsIs"), top10_synthetic = structure(c("3.37", "19,939.72", "0.68", "0.63"), class = "AsIs"), top10_mean = structure(c("2.95", "30,242.60", "0.64", "0.43"), class = "AsIs")), .Names = c("Control variables", "Treated", "top10_synthetic", "top10_mean"), row.names = c(NA, 4L), class = "data.frame")
data[[1]] <- inMinipage(data[[1]], "2.5cm")
kable(data, "latex", caption = "table 1", booktabs = T, col.names = c("Control variables", "Treated", "Synthetic", "Mean"), escape = FALSE) %>%
add_header_above(c("", "", "Top 10%" = 2)) %>%
group_rows("UK", 1, 2) %>%
group_rows("Japan", 3, 4, latex_gap_space = "0.8cm") %>%
footnote(general = "xxx") %>%
kable_styling(latex_options = c("HOLD_position", "scale_down")) %>%
column_spec(1, width = "3cm")
```
With that code I see this:
The spacing isn't quite right, but it's getting close. I hope this helps.
I am using kableExtra to format some tables in an Rmarkdown document. When running the code below, without any position argument to kable_styling, the grouping row labels (the rows in the table where it says "Group 1" and "Group 2") and the footnotes remain left aligned in relation to the table. This is as I would like it.
```{r cars-table, results='asis'}
kable(mtcars[1:10, 1:2], format = "html", caption = "Group Rows",
col.names = c("MPG[note]", "CYL[note]")) %>%
kable_styling("striped", full_width = F) %>%
group_rows("Group 1", 4, 7) %>%
group_rows("Group 2", 8, 10) %>%
add_footnote(c("Some footnote", "Some other footnote"))
```
But when a position argument is provided to kable_styling, the grouping row labels and footnotes seem to take the opposite alignment, rather than remaining left aligned in relation to the table. I say the opposite alignment, as when I use position = "right", the grouping row labels and footnotes become left aligned.
The code below demonstrates the issue when using position = "left".
```{r cars-table, results='asis'}
kable(mtcars[1:10, 1:2], format = "html", caption = "Group Rows",
col.names = c("MPG[note]", "CYL[note]")) %>%
kable_styling("striped", full_width = F, position = "left") %>%
group_rows("Group 1", 4, 7) %>%
group_rows("Group 2", 8, 10) %>%
add_footnote(c("Some footnote", "Some other footnote"))
```
I only load two libraries to make this example and use the defaults when opening an .Rmd document in RStudio.
library(knitr)
library(kableExtra)
What can I do to make the grouping row labels and footnotes left aligned in relation to the table? Thanks.
In kableExtra 0.3.0 or earlier, there was a bug in the position section of kable_styling. The corresponding CSS for left positioning was mistakenly set as text-align:right... Thank you, #meenaparam, for bringing it up!
Now this bug has been addressed in the current dev version and the CRAN version will be updated in a week.