Wrapping column names in KableExtra with str_wrap - r

I have a table that looks like this:
wide.df <- cbind.data.frame(
Letter = c("A", "B", "C", "D", "E", "F"),
`Component 1 - Class Grades`= c(30,25,15,10,10,10),
`Component 2 - External Grades` = c(10, 10, 10, 15, 25, 30)
)
However, when I output it into kableExtra it obviously comes out looking crappy because of the length of the names.
wide.df %>%
knitr::kable(caption = "Example Kable", row.names = F) %>%
row_spec(0, bold = T, color = "white", background = "darkred")%>%
add_header_above(c("." = 1, "Count of Grades" = (ncol(wide.df)-1)), background = "darkred", color = "white") %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE)
I'd like these column labels to wrap after the component number, e.g.
Component 1 -
Class Grades
Usually I used strwrap in a function for this kind of wrapping for graph titles:
wrapper <- function(x, ...)
{
paste(strwrap(x, ...), collapse = "\n")
}
However I can't figure out a way to do this to rename columns in my dataframe to include linebreaks. When I do this it returns nonsense.
I tried to pivot the data to long format and do the renaming, as seen below:
long.df <-
wide.df %>%
pivot_longer(-Letter, names_to = "Component", values_to = "Perc") %>%
mutate(Component = wrapper(Component, 15))
This, however, just gives me incredible long repeats of the component name in that column.
Any help on an easy way to do this? Either by renaming the columns with appropriate breaks in them, or pivoting to long format to rename then pivoting back to wide?
Also, as a bonus - does anyone know how to make my add_header above color in the header over the "Letter" column without including the dummy "." there? When that header value is blank there is no color

Here's a way of solving the problems:
library(dplyr)
library(kableExtra)
wide.df <- cbind.data.frame(
Letter = c("A", "B", "C", "D", "E", "F"),
`Component 1 - Class Grades` = c(30, 25, 15, 10, 10, 10),
`Component 2 - External Grades` = c(10, 10, 10, 15, 25, 30)
)
wrapper <- function(x, ...)
{
sapply(x, function(y)
paste(strwrap(y, ...), collapse = "<br>"))
}
wide.df %>%
rename_with(.fn = wrapper, width = 15) |>
knitr::kable(caption = "Example Kable",
row.names = F,
escape = FALSE) %>%
row_spec(0,
bold = T,
color = "white",
background = "darkred") %>%
add_header_above(
c(
"<span></span>" = 1,
"Count of Grades" = (ncol(wide.df) - 1)
),
background = "darkred",
color = "white",
escape = FALSE
) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE
)
This works by:
Using rename_with to rename columns according to the wrapper function
passing the html <br> instead of \n, as the kable parts seemed to ignore the newline
(rewriting the wrapper function slightly to handle/return vectors)
adding escape = FALSE to knitr::kable to ensure newline is kept in
For Bonus question: adding "<span></span>" as a blank column name and escape = FALSE to add_header_above

Related

kableExtra addfootnote general spanning multiple lines with PDF (LaTeX) output

Problem
Code
# Toy Data
ID <- c(paste("G0", as.character(1:9), sep = ""),"G10","G11","Mean")
V1 <- c(10.06,11.06,12.06,13.06,14.06,15.06,16.06,17.07,18.07,19.07,6.88,13.86)
V2 <- c(0.21,0.03,0.09,0.03,0.09,0.03,0.09,0.03,0.09,0.21,0.31,NA)
tbl <- data.frame(ID, V1, V1, V2, V1, V2, V1, V2, V2)
colnames(tbl) <- c('ID','Get. \\%','Get. \\%','K','Get. \\%','K','Get. \\%','K','P')
# Specify kable NA value and load kableExtra
options(knitr.kable.NA = '--')
require(kableExtra)
# Generate table for PDF output (LaTeX)
kbl(tbl, format = 'latex', align = 'l', booktabs = T, escape = F, digits = 2,
linesep = "", caption = "This is a table caption.") %>%
add_header_above(c(" ", "AB", "BP" = 2, "CK" = 2, "JAM" = 2, ""), bold = T) %>%
column_spec(1, width = '1.15cm') %>%
row_spec(11, hline_after = T) %>%
row_spec(12, bold = T) %>%
kable_styling(position = "center", latex_options = "hold_position") %>%
footnote(general_title = "Note.", footnote_as_chunk = T,
general = "Relatively long footnote that I would like to span
a couple of lines. Relatively long footnote that I
would like to span a couple of lines.")
Output
Comments
Issue 1: The output displays 'makecell[1]' in the footnote, which I obviously do not want included. Adding the argument escape = T did not resolve this problem as I expected it might have.
N.B. By setting footnote_as_chunk = F, this issue was resolved, but with the unwanted effect of introducing a line break before the caption starts. This is demonstrated by Peter's answer below.
Issue 2 The footnote does not want to be constrained to the length of the table. I suppose one might be able to manually add line breaks in the footnote string, but this seems like tedious work-around, and I'm hoping there is a method for achieving this more efficiently. The documentation shows (see Table 4, p. 25) an example of how one might circumvent this problem, but the code is absent.
EDIT: This issue (#2) was resolved by setting threeparttable = T when calling kbl.
Compiling with pdflatex or xelatex does not seem to make any difference. Any insight would be much appreciated.
Try this:
library(kableExtra)
library(magrittr)
kbl(tbl,
format = 'latex',
longtable = TRUE,
align = 'l',
booktabs = T,
escape = F,
digits = 2,
linesep = "",
caption = "This is a table caption.") %>%
add_header_above(c(" ", "AB", "BP" = 2, "CK" = 2, "JAM" = 2, ""), bold = T) %>%
column_spec(1, width = '1.15cm') %>%
row_spec(11, hline_after = T) %>%
row_spec(12, bold = T) %>%
kable_styling(position = "center", latex_options = "hold_position", full_width = FALSE) %>%
footnote(general_title = "Note.",
footnote_as_chunk = TRUE,
threeparttable = TRUE,
general = "Relatively long footnote that I would like to span a couple of lines. Relatively long footnote that I would like to span a couple of lines.")
With footnote_as_chunk = TRUE using the "general" footnote option "Note." and the "Footnote...." text start on the same line. As in this example, image below.

Display Alternative color_bar value in Formattable Table

Is it possible to populate a formattable color_bar with an alternative display value (i.e. a value other than the value used to determine the size of the color_bar)
In the table below I want to override the values with the following display values for ttl to:
c(1000,1230,1239,1222,1300,1323,1221)
library(tidyverse)
library(knitr)
library(kableExtra)
library(formattable)
tchart <- data.frame(id = 1:7,
Student = c("Billy", "Jane", "Lawrence", "Thomas", "Clyde", "Elizabeth", "Billy Jean"),
grade3 = c(55,70,75,64,62,55,76),
ttl = c(105,120,125,114,112,105,126),
avg =c(52.31,53.0,54.2,51.9,52.0,52.7,53.0))
tchart %>%
mutate(id = cell_spec(id, "html", background = "red", color = "white", align = "center")) %>%
mutate(grade3 = color_bar("lightgreen")(grade3)) %>%
mutate(ttl = color_bar("lightgray")(ttl)) %>%
mutate(avg = color_tile("white","red")(avg)) %>%
kable("html", escape = F) %>%
kable_styling("hover", full_width = F) %>%
column_spec(4, width = "4cm")
I checked the documentation and didn't see this as a possibility, but I was hoping there was a workaround or custom function solution.
I don't think you can quite pass it another set of values, but there are a couple of options that you might find workable.
One thing to note first is that color_bar() can accept two values - a color, and a function that will take the vector of values and transform them to numbers between 0 and 1. By default, that function is formattable::proportion(), which compares everything against the max value. But if you used your display values for ttl, you could conceivably transform the bars to be whatever length you wanted by writing your own function. (See: https://rdrr.io/cran/formattable/man/color_bar.html)
Another possibility would be to make your own formatter. Some examples here:
https://www.littlemissdata.com/blog/prettytables
So, I think you can put the numbers you want in the display, and hopefully can use a function to transform or map those values to get the bar lengths between 0 and 1 that you're looking for.
Add a new variable ttl_bar to determine the size of the bar, and let variable ttl display the value. I use gsub() to replace the ttl_bar to ttl.
tchart <- data.frame(id = 1:7,
Student = c("Billy", "Jane", "Lawrence", "Thomas", "Clyde", "Elizabeth", "Billy Jean"),
grade3 = c(55,70,75,64,62,55,76),
ttl = c(1000,1230,1239,1222,1300,1323,1221),
avg =c(52.31,53.0,54.2,51.9,52.0,52.7,53.0),
ttl_bar = c(105,120,125,114,112,105,126))
tchart %>%
mutate(id = cell_spec(id, "html", background = "red", color = "white", align = "center")) %>%
mutate(grade3 = color_bar("lightgreen")(grade3)) %>%
mutate(avg = color_tile("white","red")(avg)) %>%
mutate(ttl = pmap(list(ttl_bar, ttl, color_bar("lightgray")(ttl_bar)), gsub)) %>%
select(-ttl_bar) %>%
kable("html", escape = F) %>%
kable_styling("hover", full_width = F) %>%
column_spec(4, width = "4cm")
In a more careful way, rewrite gsub() as this mutate(ttl = pmap(list(ttl_bar, ttl, color_bar("lightgray")(ttl_bar)), ~ gsub(paste0(">", ..1, "<"), paste0(">", ..2, "<"), ..3))).
I come up with a better way to use function in color_bar() as the following code.
override = function(x, y) y / 200
tchart <- data.frame(id = 1:7,
Student = c("Billy", "Jane", "Lawrence", "Thomas", "Clyde", "Elizabeth", "Billy Jean"),
grade3 = c(55,70,75,64,62,55,76),
ttl = c(105,120,125,114,112,105,126),
avg =c(52.31,53.0,54.2,51.9,52.0,52.7,53.0),
ttl_bar = c(1000,1230,1239,1222,1300,1323,1221))
tchart %>%
mutate(id = cell_spec(id, "html", background = "red", color = "white", align = "center")) %>%
mutate(grade3 = color_bar("lightgreen")(grade3)) %>%
mutate(avg = color_tile("white","red")(avg)) %>%
mutate(ttl = color_bar("lightgray", fun = override, ttl)(ttl_bar)) %>%
select(-ttl_bar) %>%
kable("html", escape = F) %>%
kable_styling("hover", full_width = F) %>%
column_spec(4, width = "4cm")

Create kable table with fully-colored background

I'm having trouble creating a nicely formatted table in R. I'm 90% of the way there, but can't get all the way.
I need to color the entire cell with a background color as seen in the example below. I read the kable vignette and saw that in html format, background does not color the whole cell. Is there a way to get around this? I tried setting it to latex instead, but the output is in latex rather than shown in the viewer. I'm also a novice markdown user so when I tried it there, the output was not what I was hoping for (which is simply a self-contained table).
I've done tons of searching on SO for a solution, but I haven't been able to get it. It sure isn't easy to produce tables in R. Any help would be appreciated.
Sample Data:
library(tidyverse)
df <- structure(list(Indicator = c("Var1", "Var2", "Var3", "Var4", "Var5"
), Sign = c(-1L, 1L, 1L, -1L, 1L), Freq = c("M", "A", "Q", "M",
"M")), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame"))
df
# A tibble: 5 x 3
Indicator Sign Freq
<chr> <int> <chr>
1 Var1 -1 M
2 Var2 1 A
3 Var3 1 Q
4 Var4 -1 M
5 Var5 1 M
Attempted code:
library(kable)
library(kableExtra)
df %>%
dplyr::rename(Trend = Freq) %>%
mutate(Indicator = cell_spec(Indicator, "html", color = "black", bold = T),
Trend = cell_spec(Trend, "html", color = "white", bold = T,
background = factor(Sign, c(-1, 0, 1),
c("red", "gray", "green")))) %>%
select(Indicator, Trend) %>%
kable(align = c('l', 'c'), format = "html", escape = F) %>%
kable_styling(bootstrap_options = c("bordered", full_width = F, font_size = 16)) %>%
row_spec(0, background = "rgb(172, 178, 152)", color = "black", font_size = 18)
I simplified the initial data to be clear:
df <- tribble(~Indicator, ~Freq, ~cellColor,
'Speed', 43.342, 'red',
'Altitude', 44.444, 'blue',
'Smartness', 0.343, 'green')
To success, we need to create the table object (tbl), because the kable library has function column_spec for the fixed column width setting.
tbl <- df %>%
mutate(Indicator = cell_spec(Indicator, "html", color = "black", bold = T),
Freq = cell_spec(x = Freq,
format = "html",
color = "white",
bold = T,
extra_css = paste(paste('background-color', cellColor, sep = ': '), # combine background-color CSS rule with the observation vector value
'display: inline-block', # extremely important CSS modifier for the span tag in the table cell
'text-align: center', # text align
'padding: 0px', # expand the field of text
'margin: 0px', # expand the field of text
'width: 200px', # future cell/column width
sep = "; "), # CSS notation rule
)
) %>%
select(-cellColor) %>% # exclude cellColor vector
kable(format = "html", escape = F) %>%
kable_styling(bootstrap_options = c("bordered", full_width = F, font_size = 16))
column_spec(tbl, 2, width = "200px") # set the column width as the cell width
tbl # print
As one can see, it is important to match the column and cell size. As an example, I made both of them 200px wide.
The result:

R Using kableExtra to colorize cells and maintain striped formatting with nested if/ifelse?

An expansion to this question: R wanting to limit the amount of digits from csv file
I am using kableExtra and cell_spec to colorize cells with nested ifelse statements.
Instead of colorizing values less than .10 white, I want to leave them alone in order to allow kableExtra to apply the striped formatting.
I have a feeling this isn't possible though because of how the background colors are applied?
DF:
DF <- data.frame(V1 = sample(letters,10,T), V2 = abs(rnorm(10)), V3 = abs(rnorm(10)))
Code:
library(magrittr)
library(kableExtra)
paint <- function(x) {
ifelse(x < 0.1, "white", ifelse(x < 0.2, "yellow", "red"))
}
DF[, -1] = lapply(DF[, -1], formatC, format = 'f', flag='0', digits = 2)
DF[,-1] = lapply(DF[,-1], function(x) cell_spec(x, background = paint(x), format = "latex"))
DF %<>%
mutate_if(is.numeric, function(x) {
cell_spec(x, background = paint(x), format = "latex")
})
kable(DF, caption = "colorized table with striping", digits = 2, format = "latex", booktabs = T, escape = F, longtable = T)%>%
kable_styling(latex_options = c("striped", "hold_position", "repeat_header", font_size = 6))%>%
landscape()%>%
row_spec(0, angle = 45)
Problem area?
paint <- function(x) {
ifelse(x < 0.1, "white", ifelse(x < 0.2, "yellow", "red"))
}
can this be changed to only change the color if between yellow(>=.10<.2) and red(>=.2)? Or do all conditions have to be defined?
Desired output: a striped table that only highlights values as defined, allowing the stripes to exist on values less than .10
You don't need to apply any formatting to the cells you wish to leave alone. So just test for that condition before calling cell_spec (i.e., only call cell_spec for those cells you want to format):
paint <- function(x) ifelse(x < 0.2, "yellow", "red")
DF[,-1] = lapply(DF[,-1], formatC, format = 'f', digits = 2)
DF[,-1] = lapply(DF[,-1], function(x)
ifelse(x < 0.1, x, cell_spec(x, background = paint(x), format = "latex")))
kable(DF, caption = "Highlighted numbers near zero",
digits = 2, format = "latex", booktabs = T, escape = F, longtable = T) %>%
kable_styling(latex_options = c("striped", "hold_position",
"repeat_header", font_size = 6)) %>%
landscape() %>%
row_spec(0, angle = 45)

kable/kableExtra Add superscript to group labels in group_rows

I have a table that I am creating for a pdf presentation using kable and kableExtra. I am wanting to group the rows and I need to use superscripts in the row group labels. I have tried several different things. Here is an example of some of the methods I have tried so far.
library(kable)
library(kableExtra)
foo <- data.frame(a = 1:10, b = 11:20, c = 21:30)
kable(foo, format = "latex", booktabs = T, row.names = FALSE, linesep = "", escape = FALSE) %>%
kable_styling(latex_options = c("striped")) %>%
group_rows("Group1<sup>a</sup>", 1, 2) %>%
group_rows(paste0("Group2", footnote_marker_alphabet(1), sep = ""), 3, 4) %>%
group_rows(expression("Group3"^a), 5, 6) %>%
group_rows("Group4\\textsuperscript{a}", 7, 8)
I have run out of ideas and haven't been able to find any additional suggest in my search.
You need escape=FALSE in your group_rows() calls to allow the latex commands to be interpreted. You also seem to need to double each backslash (I don't quite understand why). After that, there are a few different options that work:
kable(foo, format = "latex", booktabs = T, row.names = FALSE, linesep = "", escape = FALSE) %>%
kable_styling(latex_options = c("striped")) %>%
group_rows("$\\\\text{Group1}^a$", 1, 2, escape = FALSE) %>%
group_rows(paste0("Group2\\\\", footnote_marker_alphabet(1), sep = ""), 3, 4, escape = FALSE) %>%
# I don't think expression() is helpful, doesn't seem to get converted
# to latex
group_rows(expression("Group3"^a), 5, 6) %>%
group_rows("Group4\\\\textsuperscript{a}", 7, 8, escape = FALSE)

Resources