Adding Headers to a table using formattable in R - r

I would like to add headers entitled "Category 1", "Category 2", "Category 3" and "Category 4" to a table, separated by a black line. I would like it to look like the picture attached. Please see the code for the table without the Categories/black lines between columns:
library(formattable)
data(mtcars)
df <- mtcars
formattable(df)
Desired plot

Here is one with kable where can use add_header_above by passing a vector of key/value pair with key suggesting the name and value for the number of columns to be expanded
library(kableExtra)
library(dplyr)
library(kableExtra)
mtcars %>%
kable() %>%
kable_styling(bootstrap_options = "bordered",
full_width = FALSE) %>%
add_header_above(c("", "Category1" = 3, "Category2" = 3,
"Category3" = 3, "Category4" = 2)) %>%
collapse_rows(columns = 1,
valign = "middle")
-output
Some of the styling can be changed as well
mtcars %>%
kable() %>%
kable_styling(bootstrap_options = "responsive",
full_width = FALSE) %>%
add_header_above(c("", "Category1" = 3, "Category2" = 3,
"Category3" = 3, "Category4" = 2)) %>%
collapse_rows(columns = 1,
valign = "middle")

Related

Allow duplicated names in binded tables

UPDATE for why I changed my votes.
This code has the table displayed but R doesn't knit pdf.
all_jt %>%
kbl(longtable = T, booktabs = T,
caption = "table") %>%
remove_column(7) %>%
add_header_above(c(" " = 2, "Year 1" = 4, "Year 2" = 4)) %>%
kable_styling(latex_options = c("repeat_header"))
Quitting from lines 13-37 (test_table.Rmd)
Error in remove_column(., 7) :
Removing columns was not implemented for latex kables yet
switching to select(-7) as in here Remove_Column from a kable table which will be output as latex/pdf doesn't work because R doesn't like duplicated column names.
I have two ANOVA tables, jt_1 and jt_2 below, that I want to merge and keep 1 column for the model term only. As I remove the duplicated column, R added .1 to the tail of columns' 7, 8, 9 and 10 names.
library(emmeans)
library(stringr)
warp.lm <- lm(breaks ~ wool * tension, data = warpbreaks)
jt_1 <- print(joint_tests(warp.lm), export = T) %>% as.data.frame()
jt_2 <- jt_1
all_jt <- cbind(jt_1, jt_2) %>%
setNames(gsub("summary.", "", colnames(.)))
all_jt[,-6]%>% #to remove the duplicated column for model term
data.frame(check.names = F) %>%
kbl(longtable = T, booktabs = T,
caption = "table") %>%
add_header_above(c(" " = 2, "Year 1" = 4, "Year 2" = 4)) %>%
kable_styling(latex_options = c("repeat_header"))
Here is a brief idea of what I need.
Many thanks in advance.
You can use remove_column function from kableExtra to remove a column instead of all_jt[,-6] which makes the column name unique.
library(knitr)
library(kableExtra)
all_jt %>%
kbl(longtable = T, booktabs = T,
caption = "table") %>%
remove_column(7) %>%
add_header_above(c(" " = 2, "Year 1" = 4, "Year 2" = 4)) %>%
kable_styling(latex_options = c("repeat_header"))
R does not like duplicate column names in data.frames. If you step through your last code block line by line you will notice that all_jt[, -6] makes column names unique by adding the ".1" suffix.
The/a solution is to provide column names to kbl directly, e.g.
all_jt[,-6] %>%
kbl(longtable = T, booktabs = T,
col.names = gsub("\\.\\d", "", names(.)),
caption = "table") %>%
add_header_above(c(" " = 2, "Year 1" = 4, "Year 2" = 4)) %>%
kable_styling(latex_options = c("repeat_header"))
This produces

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

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

Row indentation with add_indent() in 2nd column in kableExtra

I try to indent cells of the 2nd column of a dataframe using the kableExtra-package for RMarkdown. It seems add_indent() only works for the first column, therefore does not change anything in my table of the reprex below:
Reprex with dummy data:
---
output: pdf_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(kableExtra)
group <- c(1, NA, NA, 2, NA, NA)
quest <- c("How is your mood today?", "good or very good", "bad or very bad",
"What colour is your hair?", "brown", "other")
percent <- c(NA, 80, 20, NA, 50, 50)
df <- tibble(group, quest, percent)
```
## Reprex
```{r, echo=TRUE}
# output without add_indent()
kable(df, booktabs = T, escape = T) %>%
add_header_above(header = c("Group" = 1,
"Question & answer options" = 1,
" %Agreement" = 1)) %>%
gsub("NA", " ", .)
```
```{r with indent, echo=TRUE}
# output with add_indent()
kable(df, booktabs = T, escape = T) %>%
add_header_above(header = c("Group" = 1,
"Question & answer options" = 1,
" %Agreement" = 1)) %>%
gsub("NA", " ", .) %>%
add_indent(positions = c(2,3,5,6))
Desired output: I would like to indent the rows 2, 3, 5, 6 of the 2nd column (that the answer options are intended below the questions and ideally also in italics). Italics could also be covered with cell_spec() but that works just column wise I think.
Is my desired output possible? (I guess it does not make sense to mix questions & answer options, but to keep up the format of an earlier report we would like to try it that way?)
Here are two possible ways.
Use kableExtra::group_rows isntead of an extra group column.
Add the indentation (kableExtra adds 1em) manually using cell_spec.
Option 1
```{r, echo = F}
df <- data.frame(quest, percent)
df %>%
mutate(quest = cell_spec(quest, italic = ifelse(row_number() %in% c(2,3,5,6), T, F))) %>%
kable(booktabs = T, escape = F) %>%
add_indent(c(2,3,5,6)) %>%
group_rows("Group 1", 1, 3) %>%
group_rows("Group 2", 4, 6) %>%
gsub("NA", " ", .)
```
Option 2
```{r, echo = F}
df <- data.frame(group, quest, percent)
df %>%
mutate(quest = cell_spec(quest, italic = ifelse(row_number() %in% c(2,3,5,6), T, F)),
quest = ifelse(row_number() %in% c(2,3,5,6), paste0("\\hspace{1em}", quest), quest)) %>%
kable(booktabs = T, escape = F) %>%
gsub("NA", " ", .)
```

Resources