I want to use the R package gt and have the table output ONE and TWO in bold. It looks like you can use markdown syntax inside gt but this doesn't quite work as I'd expect. Any tips?
dummy <- tibble(
`**ONE**, N = 1` = 1,
`**TWO**, N = 2` = 2
)
dummy %>%
gt()
Couldn't see anyway to do exactly what you want but this accomplishes it by having a list that maps column names to label name with formatting.
library(tibble)
library(gt)
dummy <- tibble(
"one" = 1,
"two" = 2
)
col_for_list <- list(one = md("**ONE**, N = 1"), two = md("**TWO**, N = 2"))
dummy %>%
gt::gt() %>%
cols_label(.list = col_for_list)
Related
I'm attempting to combine the use of R packages formattable and kableExtra to create a data-table. Using formattable, I'm adding a green thumbs up symbol to one particular column ("b") for numbers > 0, this displays correctly. I then pass my table to "kable" so that I can add the "hover" feature, widen column 1, and add grouped headers. However, whilst the produced data-table correctly displays the "hover" feature and correct grouped headers, the green thumbs up feature (derived from formattable) is missing.
Here is a minimal, reproducible example:
library(formattable)
library(kableExtra)
library(dplyr)
labels <- c("A", "B", "C")
a <- c(0.22, 0.28, 0.23)
b <- c(890.53, 346.84, 1119.63)
c <- c(6.56, 5.70, 4.59)
d <- c(0.0048, -0.3194, -0.2720)
e <- c(-0.3212, 0.1280, 0.0755)
f <- c("-", "-", "-")
df <- tibble(labels,a,b,c,d,e,f)
customGreen = "#71CA97"
# function to assign a thumbs up to numbers > 0
custom_thumb <- formatter("span", style = x ~ style(font.weight = "bold",
color = ifelse(x > 0, customGreen, ifelse(x < 0, customRed, "black"))),
x ~ icontext(ifelse(x > 0, "thumbs-up", ""), x)
)
# use formattable to add thumbs up symbols
df_frmt <- formattable(df, align =c("l","c","c","c","c","c","c"),
list(`labels` = formatter("span"),
`b` = custom_thumb))
# pass the resulting table to kable for further edits
df_kbl <- kbl(df_frmt, escape = T) %>%
kable_styling("hover", full_width = F) %>%
column_spec(1, width = "5cm") %>%
add_header_above(c(" "=2, "Group 1" = 2, "Group 2" = 2, " " = 1))
df_kbl
Given that the hover feature and grouped headers is working well, is the issue something to do with escaping html? I've tried both "escape=T" and "escape=F" in the kable edit though there's no change. I know that both of these packages can be used together from reading the "Integration with formattable" section of this website. I don't know if it's relevant or not, but I'm running this code in an RMarkdown file inside RStudio. Any helps is appreciated!
Following your mentioned link, combining formattable and kableExtra is not done by passing a formattable to the kbl function.
Instead you might use custom (your custom_thumb) or original functions (color_bar or color_tile) from formattable and integrate them into the kableExtra syntax.
df %>%
mutate(b = custom_thumb(b)) %>%
kable("html", escape = F, align = c("l","c","c","c","c","c","c")) %>%
kable_styling("hover", full_width = F) %>%
column_spec(1, width = "5cm") %>%
add_header_above(c(" " = 2, "Group 1" = 2, "Group 2" = 2, " " = 1))
I'm trying to color a text, based on a specific values for selected rows & columns. Since column names are dynamically changed I cannot use them as a reference, hence I'm struggling with a final code. I would like to mark all the values as red < 0 but only when Name = 'Row2'. For the rest I'd like to do the opposite, mark as red > 0 when Name != 'Row2'. I'm including only first part of the code which doesn't work. I'd like to ask for help about the logic in general. Thank you!
data %>% gt() %>%
tab_style(
locations = cells_body(
columns = 2:4,
rows = 'Name' == "Row2" & 4 < 0
),
style = list(cell_text(color = 'red')))
One option would be to use purrr::reduce (or base Reduce) to loop over the column names and apply the style to each column one by one like so:
data <- data.frame(
Name = paste0("Row", 1:3),
Col_june = c(1, -1, 0),
Col_june2 = c(2, 3, -2),
Col_june3 = c(3, -2, 2)
)
library(gt)
library(rlang)
data %>%
gt() %>%
purrr::reduce(names(data)[2:4], function(x, y) {
tab_style(x,
locations = cells_body(
columns = all_of(y),
rows = Name == "Row2" & !!sym(y) < 0
),
style = list(cell_text(color = 'red')))
}, .init = .)
I have a shiny app that renders a DT table that has formatted numeric values. The table contains data that is both percentages and data that represents currency. The data is not tidy in that the table is effectively transposed with each row representing a feature and each column being an observation. Ultimately, my goal is to encode logic that anytime a cell has a negative value (the first character of the string is a '-'), the cell is colored red. Here is my reproducible example:
library(tidyverse)
library(DT)
example_df <- data.frame(
x = c("$1", "-2%", "$3"),
y = c("$10", "10%", "$20")
)
determine_cell_color <- function(x) {
if (str_sub(x, 1, 1) == "-") {
return("red")
}
else {
return("white")
}
}
# how to get an individual cell to be a different color
# if first character in string value is '-'
example_df %>%
datatable() %>%
formatStyle(target = 'row', backgroundColor = styleEqual(~determine_cell_color))
This approach can be generalized to many more columns. The main idea is to style one column with another column, the only downside is that it doubles the number of cols in the data frame. Fortunately we can hide those columns.
library(tidyverse)
library(DT)
example_df <- data.frame(
x = c("$1", "-2%", "$3"),
y = c("$10", "10%", "$20"),
z = c("$10", "-10%", "$20"),
w = c("-$10", "-10%", "$20")
)
pattern <- names(example_df) %>% str_c(collapse = "|")
determine_cell_color <- function(vector) {
str_detect(vector, "-") %>% as.numeric()
}
example_df <- example_df %>% mutate(across(matches(pattern), determine_cell_color, .names = "cell_color_{.col}"))
DT <- datatable(example_df, options = list(
columnDefs = list(list(targets = (ncol(example_df) / 2 + 1):ncol(example_df), visible = FALSE))
))
walk(str_subset(names(example_df), "^.$"), ~ {
DT <<- DT %>% formatStyle(
.x, str_c("cell_color_", .x),
backgroundColor = styleEqual(c(1, 0), c("red", "white"))
)
})
DT
Created on 2022-01-07 by the reprex package (v2.0.1)
I am wanting to apply different color shading to a table based on different value sets. I am creating this table in Rmarkdown using kableExtra. I want values between 0 and <.10 to be left alone. Values >=.10 and <.20 to be shaded yellow. and values >=.20 to be shaded red.
df
name category 1 categry 2 category a category b
ab .01 .45 .19 .09
410 .12 .01 .05 .66
NW 5th .25 .22 .01 .16
This is what I have been making my existing table with:
library(knitr)
library(dplyr)
kable(df, caption = "warning values", digits = 2, format = "latex",
booktabs = T)%>%
kable_styling(latex_options = c("striped"))%>%
landscape()%>%
row_spec(0, angle = 45)
I'm not sure how to use the mutate and cel_spec functions to apply to the entire table. The table columns and row names change dynamically with every report fyi.
EDIT: Martin's answer works great. Until I tried to clean up my numbers. My actual input file has more digits, like Martin's answer. It also has file and row names that include an underscore. (That caused issues when using this answer, but I found a workaround.)
#replace any "_" with escaped "\\_" for magrittR/latex compatability
names(df) <- gsub(x = names(df), pattern = "\\_", replacement =
"\\\\_")
df$name <- gsub('\\_', '\\\\_', df$name)
#format numbers
df <- format(df, digits=0, nsmall=3, scientific = FALSE)
The replacement works fine, its the number formatting that breaks the answer. Everything still executes just fine, but I lose the colorized table.
Thoughts?
Here is way to do this. Notice that I used the compund assignment operator from magrittr.
---
title: test
output: pdf_document
---
```{r, echo = F, warning = F, message = F}
library(knitr)
library(dplyr)
library(kableExtra)
library(magrittr)
df <- data.frame(A = runif(4, 0, 1), B = runif(4, 0, 1), row.names = letters[1:4])
paint <- function(x) { # our painting function
ifelse(x < 0.1, "white", ifelse(x < 0.2, "yellow", "red"))
}
df %<>%. # compound assignment operator
mutate_if(is.numeric, function(x) { # conditional mutation, if the column type is numeric
cell_spec(x, background = paint(x), format = "latex")
})
kable(df, caption = "warning values", digits = 2, format = "latex",
booktabs = T, escape = F) %>%
landscape()%>%
row_spec(0, angle = 45)
```
I would like to render a table in R, with cells formatted according to some non-trivial logic. (e.g. if a value is odd, color the cell yellow; if it is also >5, make the text bold, etc.). This logic would be applied to each column of a dynamically created table, i.e. the column names are unknown so cannot be used in the code.
If found this JQuery approach helpful, but I'm not sure it completely solves my problem, plus I would prefer an R-based approach.
I also came close using the condformat package, but for some reason the following doesn't work:
library(condformat)
data(iris)
# Create a condformat object
cf <- condformat(iris)
# Add rules to it:
for (col in colnames(iris)[1:2]) {
cf <- cf %>% rule_css(!!col,
expression = ifelse(eval(parse(text=col)) < 3.3, "red", "black"),
css_field = 'color')
}
# Render it
cf
The first column of the resulting table doesn’t abide by the rule; instead, it is given the colors from column 2. But if I instead loop over just that first column, the coloring for it is correct.
Any help with the above code, or with the problem generally, would be greatly appreciated.
kableExtra is a very powerful tool for creating HTML tables in R.
library(kableExtra)
iris[1:10, 1:2] %>%
mutate(
Sepal.Length = cell_spec(
Sepal.Length,
"html",
background = ifelse(Sepal.Length %% 2 == 1, "yellow", "red"),
bold = ifelse(Sepal.Length > 5, T, F)
),
Sepal.Width = cell_spec(
Sepal.Width,
"html",
background = ifelse(Sepal.Width %% 2 == 1, "blue", "green"),
bold = ifelse(Sepal.Width > 10, T, F)
),
) %>%
kable(format = "html", escape = F) %>%
kable_styling("striped", full_width = F)
Please refer to the documentation for additional details:
Create Awesome HTML Table with knitr::kable and kableExtra
In order to do this on a dynamic table, you could loop over the columns of the data.frame like this (taking most of the code from Ozan147's answer):
library(kableExtra)
test <- iris[1:10, ]
for(i in 1:ncol(test)){
if(is.numeric(test[[i]])){
test[[i]] <- cell_spec(
test[[i]],
"html",
background = ifelse(test[[i]] %% 2 == 1, "yellow", "red"),
bold = ifelse(test[[i]] > 5, T, F)
)
}
}
test %>%
kable(format = "html", escape = F) %>%
kable_styling("striped", full_width = F)