bold entries in r data.frame RMarkdown - r

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

Related

Avoid repeating the same styling with kable_styling

Using Rmarkdown and kable, I need to repeat several tables with the same formatting but with different datasets.
For example, in the following two chunks, what is changing is the DF, the variable used to sort and the caption.
Is there any way to avoid repeating 90% of the same code for each chunk?
kable(Crib1 %>% arrange(-Z1) %>%
select(Ranking = TYP, SID, Statement, FA1:FA3), longtable = TRUE, booktabs = TRUE, caption = "Crib Sheet - Factor 1") %>%
collapse_rows(1, latex_hline = "major", valign = "top") %>%
kable_styling(full_width = FALSE, latex_options = c("hold_position", "condensed", "repeat_header"), font_size = 9) %>%
column_spec(1, bold=TRUE) %>%
column_spec(3, width = "18em", italic = TRUE) %>%
column_spec(4, bold = TRUE)
kable(Crib2 %>% arrange(-Z2) %>%
select(Ranking = TYP, SID, Statement, FA1:FA3), longtable = TRUE, booktabs = TRUE, caption = "Crib Sheet - Factor 2") %>%
collapse_rows(1, latex_hline = "major", valign = "top") %>%
kable_styling(full_width = FALSE, latex_options = c("hold_position", "condensed", "repeat_header"), font_size = 9) %>%
column_spec(1, bold=TRUE) %>%
column_spec(3, width = "18em", italic = TRUE) %>%
column_spec(4, bold = TRUE)
I am trying to build a function
createKableCrib <- function(factor){
Crib <- rlang::sym(paste("Crib", factor, sep=""))
Z <- rlang::sym(paste("Z", factor, sep=""))
cap <- paste("Crib Sheet - Factor", factor, sep=" ")
kable(!!Crib %>% arrange(!!(-Z)) %>%
select(Ranking = TYP, SID, Statement, FA1:FA3),
longtable = TRUE, booktabs = TRUE, caption = cap) %>%
collapse_rows(1, latex_hline = "major", valign = "top") %>%
kable_styling(full_width = FALSE, latex_options = c("hold_position", "condensed", "repeat_header"), font_size = 9) %>%
column_spec(1, bold=TRUE) %>%
column_spec(3, width = "18em", italic = TRUE) %>%
column_spec(4, bold = TRUE)
}
createKableCrib("1")
But I get the following error:
Error in UseMethod("arrange_") :
no applicable method for 'arrange_' applied to an object of class "name"
Best,
Damien
It looks like you may have gotten there already, but here is an example that seems to work with the use of Curly-Curly instead of the original Bang-Bang (https://www.brodrigues.co/blog/2019-06-20-tidy_eval_saga/).
Didn't have your data, but tried with mtcars and iris. If your columns are the same you could add the select statement after arrange.
library(dplyr)
library(knitr)
library(kableExtra)
create_kable <- function(data, column, title) {
kable({{data}} %>%
arrange({{column}}),
longtable = TRUE, booktabs = TRUE, caption = title) %>%
collapse_rows(1, latex_hline = "major", valign = "top") %>%
kable_styling(full_width = FALSE, latex_options = c("hold_position", "condensed", "repeat_header"), font_size = 9) %>%
column_spec(1, bold=TRUE) %>%
column_spec(3, width = "18em", italic = TRUE) %>%
column_spec(4, bold = TRUE)
}
create_kable(mtcars, mpg, "Crib Sheet - Factor 1")
create_kable(iris, Sepal.Length, "Crib Sheet - Factor 2")
Here is what I found so far.
Not completely satisfactory, as I wanted to be able to create the df name within the function, but I keep on getting errors.
createKableCrib <- function(df, factor){
Z <- paste("Z", factor, sep="")
cap <- paste("Crib Sheet - Factor", factor, sep=" ")
kable(df %>% arrange_at(.vars=desc(Z)) %>%
select(Ranking = TYP, SID, Statement, FA1:FA3),
longtable = TRUE, booktabs = TRUE, caption = cap) %>%
collapse_rows(1, latex_hline = "major", valign = "top") %>%
kable_styling(full_width = FALSE, latex_options = c("hold_position", "condensed", "repeat_header"), font_size = 9) %>%
column_spec(1, bold=TRUE) %>%
column_spec(3, width = "18em", italic = TRUE) %>%
column_spec(4, bold = TRUE)
}
createKableCrib(Crib1, "1")

how to specify dynamically last row number in row_spec kable()?

I am generating different tables of different row length, so I want to have all the text of certain color, but I have a question about the last row of my code in row_spec
library(kable)
library(kableExtra)
mtcars %>% filter(cyl=4) %>%
kable(align=c("l", rep("c", ncol(.)-1)),bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
kable_styling(c("striped", "hover", "condensed", "responsive"), full_width = TRUE) %>%
row_spec(0: nrow(.), color = "black")
0: nrow(.) is not valid and I am not sure why, while rep("c", ncol(.)-1)) works.
I think it doesn't work because nrow(.) returns NULL:
library(kable)
library(kableExtra)
mtcars %>%
kable(align=c("l", rep("c", ncol(.)-1)),bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
kable_styling(c("striped", "hover", "condensed", "responsive"), full_width = TRUE) %>% nrow(.)
#NULL
You could do this to color all rows:
mtcars %>%
kable(align=c("l", rep("c", ncol(.)-1)),bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
kable_styling(c("striped", "hover", "condensed", "responsive"), full_width = TRUE) %>%
row_spec(1:nrow(mtcars),color = "black")
Even though not elegant, I would do it in two steps:
library(knitr)
library(kableExtra)
library(dplyr)
# Step 1: Prepare data
temp <- mtcars %>%
filter(cyl == 4) %>%
sample_n(sample(2:nrow(.), 1)) %>%
select(1:3)
# Step 2: Produce table
temp %>%
kable(align=c("l", rep("c", ncol(temp)-1))) %>%
kable_styling(c("striped", "hover", "condensed"), full_width = FALSE) %>%
# Format last row:
row_spec(nrow(temp), color = "red", italic = TRUE, bold = TRUE)

How to color one cell with kableExtra

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

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....

how to combine R ifelse() and kable()

I have R Markdown scripts I run periodically which contain conditional tables with what I'll call violators. Here's an example data frame:
df <- data.frame(Person = c("Jack", "Jill"), Violator = c("F", "F"))
#> Person Violator
#> 1 Jack F
#> 2 Jill F
I only want to show violators (Violator == "T") and there aren't any this month. So my 'normal' kable code below gives me this error, "subscript out of bounds" which I'd expect.
How can I modify my kable code to 'do nothing' if violator does not equal "T". Is ifelse() the way to go? I'm open to kableExtra() solutions.
kable(df %>% filter(Violator == "T"), "html", align = "l") %>%
kable_styling("striped", "hover", full_width = F) %>%
column_spec(1, bold = T, background = "#FFFFFF") %>%
collapse_rows(columns = 1)
This simple approach should work, I think:
```{r}
temp <- df %>% filter(Violator == "T")
if(nrow(temp) != 0){
kable(temp, "html", align = "l") %>%
kable_styling("striped", "hover", full_width = F) %>%
column_spec(1, bold = T, background = "#FFFFFF") %>%
collapse_rows(columns = 1)
}
```

Resources