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:
Related
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
I would like to create a table using knitr:kable in R where I am using several auxiliary columns for conditional formating.
The table (df_prices) looks like this:
device price competion_price
A 20 23
B 158 160
C 1000 999
I am using the mutate and cell_spec for conditional formating just like this:
df_prices%>%
mutate(price= cell_spec(
price, color = "grey", bold = T,
background = ifelse(price <= competion_price, green, red) %>%
kable(escape = F, align = "c") %>%
kable_styling(bootstrap_options = "striped", full_width = T, position = "left",font_size = 14) %>%
collapse_rows(columns = c(1), valign = "middle")
This works OK, but in the final output I would like to hide the column "competion_price" so that the output would look like this but with correct highlighting:
device price
A 20
B 158
C 1000
Is something like this possible? Thank you very much for any suggestions.
Use dplyr::select with - to de-select a column like this.
library(knitr)
library(kableExtra)
library(dplyr)
df_prices <- read.table(text="device price competion_price
A 20 23
B 158 160
C 1000 999", sep='',header=T)
df_prices %>%
dplyr::mutate(price= cell_spec(price, color = "grey", bold = T, background = ifelse(price <= competion_price, 'green', 'red'))) %>%
dplyr::select(-competion_price) %>%
kable(escape = F, align = "c") %>%
kable_styling(bootstrap_options = "striped", full_width = T, position = "left",font_size = 14) %>%
collapse_rows(columns = c(1), valign = "middle")
(there are also a couple of fixes to the original code to make it work)
You can also use kableExtra::remove_column(), to remove a selected column from your final kable table.
For example, this will remove the first column from a table
library(kableExtra)
my_table = kable(mtcars)
remove_column(my_table, 1)
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")
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)
I am formatting a table using formattable:color_bar and would like to add a comma as a thousands separator as well as adjust the colour of the font.
For cells where I don't use color_bar I see how I can use cell_spec to change the font color but I don't know how to do it with cells that are using color_bar.
library(tidyverse)
library(knitr)
library(kableExtra)
library(formattable)
df <- tibble (
rank = c(1,2,3),
tree = c("Norway Maple", "Honey Locust", "Colorado Blue Spruce"),
number = c(74688, 24286, 21917)
)
df %>%
mutate(
tree = cell_spec(tree, "html", color = "black"),
number = color_bar()(number)) %>%
kable("html", escape = F, align = c("l", "l")) %>%
kable_styling(bootstrap_options = c("hover", "responsive", "condensed"), full_width = F, position = "float_left") %>%
column_spec(3, width = "10cm")