How to color one cell with kableExtra - r

I am just trying to highlight one cell in my table with kableExtra. The issue that I am having is that some of my cells have $s and ()s. Here is what it looks like
df3 <- data.frame(
"Bitcoin Price:" = c("Snow Panther B1+", "ASICminer 8 nano", "S9", "Avalon 921", "Dragonmint T1", "Edit E11++"),
"3000" = c("($270.71)", "($3376.85)", "($115.80)", "($530.81)", "($1108.14)", "($1035.42)"),
"6000" = c("$1050.37", "($1004.31)", "$666.06", "$547.62", "($245.39)", "$1337.12"),
"9000" = c("$2371.44", "$1368.24", "$1447.92", "$1626.04", "$617.35", "$3709.66"),
stringsAsFactors = FALSE, check.names=FALSE)
I have tried this but it doesn't work
df3 %>%
mutate(
`6000`[,2] = cell_spec(`6000`[,2], color = "red", bold = T)
) %>%
select("Bitcoin Price:", everything()) %>%
kable(align = "c", escape = F) %>%
kable_styling("hover", "striped", full_width = F) %>%
add_header_above(c(" " = 1, "Current Difficulty" = 3)) %>%
add_footnote(c("Statistics Calculated 2019"), notation = "symbol")
Does anyone have any suggestions? I feel like I am close. I am trying to make the cells with the value ($1004.31), red.

Is this what you are looking for?
df3 %>%
mutate(`6000` = cell_spec(`6000`, "html",color = ifelse(`6000` == "($1004.31)", "red", "grey"))) %>%
select("Bitcoin Price:", everything()) %>%
kable(align = "c", escape = F) %>%
kable_styling("hover", "striped", full_width = F) %>%
add_header_above(c(" " = 1, "Current Difficulty" = 3)) %>%
add_footnote(c("Statistics Calculated 2019"), notation = "symbol")

Related

Missing diacritics in GT table output

I am using GT package in R to create tables for my diploma thesis and I ran into a problem. The diploma is to be written in the czech language.
When GT draws the table it does not display the letter ě properly and shows e instead.
The code for GT table:
desc_sex[,2:ncol(desc_sex)] %>% gt(rowname_col = "sex"
) %>% tab_stubhead(
label = html("Kategorie")
) %>% cols_align(
align = "center",
columns = everything()
) %>% cols_label(
n = html("n"),
procent = html("%")
) %>% tab_row_group(
label = html("<b>Sledované regiony celkem"),
rows = 7:9
) %>% tab_row_group(
label = html("<b>Krajský soud v Ostravě"),
rows = 4:6
) %>% tab_row_group(
label = html("<b>Městský soud v Praze"),
rows = 1:3
) %>% summary_rows(
groups = T,
fns = list(
Celkem = ~sum(.)),
formatter = fmt_number,
decimals = 0
)
Here are the data in CSV compliant format:
"reg_reside","sex","n","procent","single"
"MSPH","Muž",93,46.5,52
"MSPH","Žena",83,41.5,34
"MSPH","Manželský pár",24,12,0
"KSOS","Muž",113,56.5,51
"KSOS","Žena",68,34,30
"KSOS","Manželský pár",19,9.5,0
"Celkem","Muž",206,51.5,103
"Celkem","Žena",151,37.8,64
"Celkem","Manželský pár",43,10.8,0
Here is how the output looks in GT - the mistake is in Ostrave (should be Ostravě) and Mestsky (should be Městský):
You can try using html entities like i.e. ě = &ecaron;
desc_sex[,2:ncol(desc_sex)] %>%
gt(rowname_col = "sex") %>%
tab_stubhead(label = html("Kategorie")) %>%
cols_align(align = "center",columns = everything()) %>%
cols_label(n = html("n"),
procent = html("%")) %>%
tab_row_group(label = html("<b>Sledované regiony celkem"),
rows = 7:9) %>%
tab_row_group(label = html("<b>Krajský soud v Ostrav&ecaron;"),
rows = 4:6) %>%
tab_row_group(label = html("<b>M&ecaron;stský soud v Praze"),
rows = 1:3) %>%
summary_rows(groups = T,
fns = list(Celkem = ~sum(.)),
formatter = fmt_number,
decimals = 0)

bold entries in r data.frame RMarkdown

I am listing my results in RMarkdown. I want to show max values in each column in bold. How can I do that?
See the code, and output (as png) below please.
data<-data.frame(A=c(1,2,4,3), B=c(8,7,9,10), C=c(14,12,13,11), D=c(15,18,17,16))
rownames(data)<-c("E", "F", "G", "H")
library(knitr)
library(kableExtra)
kable(data) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
) %>%
add_header_above(c( '', Group1 = 2, Group2 = 2))
We could do this with cell_spec
Loop across the columns of the dataset, add the cell_spec layer with bold argument as a logical vector i.e. TRUE where the column value is max with ==
Convert to kable and use the OP's code as in the post
library(dplyr)
library(knitr)
library(kableExtra)
data %>%
mutate(across(everything(), ~ cell_spec(., bold = . == max(.)))) %>%
kable(escape = FALSE, booktabs = TRUE) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
) %>%
add_header_above(c( '', Group1 = 2, Group2 = 2))
-output
If this needs to be by row maxs, then an option would be to transpose
data %>% t %>%
as.data.frame %>%
mutate(across(everything(), ~ cell_spec(., bold = . == max(.)))) %>%
t %>%
as.data.frame %>%
kable(escape = FALSE, booktabs = TRUE) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
) %>%
add_header_above(c( '', Group1 = 2, Group2 = 2))
-output
Or for the rowwise, create the cell_spec layer with apply
data[] <- t(apply(data, 1, function(x) cell_spec(x, bold = x == max(x))))
data %>%
kable(escape = FALSE, booktabs = TRUE) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
) %>%
add_header_above(c( '', Group1 = 2, Group2 = 2))
Or may use dapply from collapse for faster execution
library(collapse)
dapply(data, MARGIN = 1, FUN = function(x) cell_spec(x, bold = x == fmax(x))) %>%
kable(escape = FALSE, booktabs = TRUE) %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
) %>%
add_header_above(c( '', Group1 = 2, Group2 = 2))

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")

LaTex table in knitr with complex structure (rotating multirow text, removing column separators)

I need to create a latex table in RStudio for pdf output with the following structure:
This table was created for html output with the following code:
mat <- data.frame(a = c("column header","column header"),
rowx=c("row1","row2"),b = c("a","b"),
c = c("x","y"))
kable(mat, align = "c",col.names = c("","","v1","v2")) %>%
kable_styling(bootstrap_options = "striped", full_width = F,
position = "left",font_size = 12) %>%
column_spec(1, bold = T,width="2em",extra_css="transform: rotate(-90deg);") %>%
collapse_rows(columns = 1, valign = "middle") %>%
add_header_above(c(" " = 2, "row header" = 2))
I need to create a similar structure with LaTeX tables.
His is how far I got:
mat <- data.frame(a = c("column header","column header"),
rowx=c("row1","row2"),b = c("a","b"),c = c("x","y"))
kable(mat, align = "c",col.names = c("","","v1","v2")) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left",font_size = 12) %>%
collapse_rows(columns = 1, latex_hline = "none") %>%
add_header_above(c(" " = 2, "rows" = 2))
So I still need at least 2 more things:
rotate the label in the very first column
remove the spurious leftmost column separator in the second row.
Can this be achieved with kableExtra commands and parameters?
Here's a shot with huxtable (my package):
as_hux(mat, add_colnames = TRUE) %>%
insert_row(c("", "", "rows", "")) %>%
merge_cells(3:4, 1) %>%
merge_cells(1, 3:4) %>%
merge_cells(1:2, 1:2) %>%
set_rotation(3, 1, 90) %>%
set_bottom_border(0.4) %>%
set_bold(1:2, everywhere, TRUE) %>%
set_wrap(3, 1, TRUE) %>%
set_bottom_padding(4, -1, 48) %>%
set_bottom_padding(3, -1, 30) %>%
set_row_height(c("1em", "1em", "1.5em", "1.5em")) %>%
quick_pdf()
I have to admit, this took a lot of tweaking. TeX tables are hard to understand....

Adding a row spanning column header to a knitr kable table

kableExtra can add header rows with items spanning multiple columns in tables produces with kable
library(tidyverse)
library(knitr)
library(kableExtra)
mat <- matrix(1:4,2,dimnames=list(c("a","b"),c("x","y")))
mat %>% kable("html") %>% add_header_above(c(" " = 1,"row header" = 2))
I would like to have a column header also, like this:
Can it be done?
i don't think you can do it but i found a way to fix your issue
mat <- data.frame(a = c("row header","row header"),b = c("a","b"),c = c("x","y"))
mat %>% kable("html") %>% add_header_above(c(" " = 1,"row header" = 2))
kable(mat, align = "c",col.names = c("","","")) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left",font_size = 12)%>%
column_spec(1, bold = T) %>%
collapse_rows(columns = 1, valign = "middle")%>%
add_header_above(c(" " = 1, "row header" = 2))
i hope this helps you
Building on what you told me I was able to solve my problem completely:
mat <- data.frame(a = c("column header","column header"),b = c("a","b"),c = c("x","y"))
kable(mat, align = "c",col.names = c("","","")) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left",font_size = 12)%>%
column_spec(1, bold = T,width="3em",extra_css="transform: rotate(-90deg);") %>%
collapse_rows(columns = 1, valign = "middle")%>%
add_header_above(c(" " = 1, "row header" = 2))

Resources