conditionally format dynamically created table in R - r

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)

Related

Missing symbols when combining formattable and kableExtra when creating a data-table in R

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

R: table1 output

Some days ago I found table1 library to get nice tables.
The only one problem (for me), its that output is a HTML table. I am using rtf library to export R table to word, but I dont know how export this output table (HTML) to word .
I wonder if exist some posibilty of get a different output. Or a different way to convert to R table. I am no using R-studio.
Thanks in advance.
library(table1)
table1(~mpg| carb*am,data = mtcars)
Thanks to #r2evans for the information, I could get a R table, maybe I lost a little bit the format but is ok when I export to word with rtf library:
library(rvest)
library(table1)
tbl_1=table1(~mpg| carb*am,data = mtcars)
as.data.frame(read_html(tbl_1) %>% html_table(fill=TRUE))
Note that you can get a lot more control over the output with some other packages. In the example below I'm using Tplyr and reporter. Tplyr generates the statistics and reporter will create the RTF. It takes a lot more work than table1. But you gain a lot more types of statistics and reports. You could basically produce any safety report.
library(Tplyr)
library(reporter)
dt <- tplyr_table(mtcars, am) %>%
add_layer(group_count(cyl)) %>%
add_layer(group_desc(mpg)) %>%
build()
tbl <- create_table(dt, show_cols = c("ord_layer_index", "row_label1",
"var1_0", "var1_1")) %>%
stub(c("ord_layer_index", "row_label1"), label = "Variables") %>%
define(ord_layer_index, label = "Variable", label_row = TRUE,
format = c("1" = "Cylinders",
"2" = "Miles Per Gallon"),
dedupe = TRUE, blank_after = TRUE) %>%
define(row_label1, label = "", indent = .25) %>%
define(var1_0, label = "Automatic", align = "center", n = 19) %>%
define(var1_1, label = "Manual", align = "center", n = 13)
pth <- file.path(tempdir(), "test1.rtf")
rpt <- create_report(pth,
output_type = "RTF",
orientation = "portrait") %>%
titles("Table 1.0",
"Characteristics of MTCars by Transmission Type",
"Population: All Cars") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl)
write_report(rpt)
file.show(pth)
Here is the RTF output:

Shade table with extraKable in RMarkdown for pdf using dplyr mutate?

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

Add a condition to one of the scores output in Rmarkdown

I am outputting some readability scores as a table using Rmarkdown and was wondering if there any way I could add a condition to one of the rows saying "if the score is greater or equal to 14 then output the colour as red otherwise green"
The following is the code to generate the sample data:
FGL <- 16
Readability_score <- data.frame(Type = c("SMOG","Flesch Reading Ease","Flesch-Kincaid Grade Level",
"Gunning Fog Score", "Automated Readability Index"),
Score = c(17,23,FGL,22, 19))
This is the code to output the table in html using Rmarkdown:
kable(Readability_score, "html") %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>%
row_spec(3, bold = T, color = "white", background = "grey")
I would like the 3rd element of the data frame to be highlighted in red (Flesch-Kincaid Grade level, 16) if the score is greater than 14.
So far I tried using cell_spec() with the below code but could not get it to work
FGL <- 16
Readability_score <- data.frame(Type = c("SMOG","Flesch Reading Ease","Flesch-Kincaid Grade Level",
"Gunning Fog Score", "Automated Readability Index"),
Score = c(17,23,cell_spec(FGL, "html", color = ifelse(FGL >= 14, "red", "green")),22, 19))
Maybe using cell_spec() here is not a good idea. Any other suggestions regarding ways to achieve what I am trying to achieve here or if anyone could point out any mistake in my code - would be really helpful, Thanks.
PS. To run the above code: the following packages would be required
library("dplyr")
library("knitr")
library("kableExtra")
You just need to set escape=F argument in the kable function
library("dplyr")
library("knitr")
library("kableExtra")
FGL <- 16
Readability_score <- data.frame(Type = c("SMOG",
"Flesch Reading Ease",
"Flesch-Kincaid Grade Level",
"Gunning Fog Score",
"Automated Readability Index"),
Score = c(17,23,
cell_spec(FGL, "html",
color = ifelse(FGL >= 14, "red", "green")),22, 19))
In the below line escape=F is added to the code you already wrote
kable(Readability_score, "html", escape = F) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

How to Format R Shiny DataTable Like Microsoft Excel Table

I have some tables in Microsoft Excel that I need to recreate in an R Shiny App. The formatting in R has to remain at least mostly the same as the original context.
Here are images of the original tables:
Table 1
Table 2
Notice the formatting: There are lines under table headers and above totals, headers and totals are bolded, numbers in the Monthly Bill column have thousands seperated by commas and have dollar symbols, and the final number in Table 2 is boxed in.
If the lines were not recreatable it would be fine, but I need to at least be able to bold the selected topics, headers, and totals, and be able to get the correct number format for the Monthly Bill column.
I have tried using the DT package but I can't figure out how to format rows instead of columns. I noticed DT uses wrappers for JavaScript functions but I don't personally know JavaScript myself. Is there a way to format this the way I that I need through R packages or Javascript?
Edit:
Although it would be simple, I cannot merely include an image of the tables because some of the numbers are going to be linked to user input and must have the ability to update.
pixiedust makes it easy to do cell-specific customizations.
T1 <- data.frame(Charge = c("Environmental", "Base Power Cost",
"Base Adjustment Cost", "Distribution Adder",
"Retail Rate Without Fuel", "Fuel Charge Adjustment",
"Retail Rate With Fuel"),
Summer = c(0.00303, 0.06018, 0.00492, 0.00501, 0.07314,
0.02252, 0.09566),
Winter = c(0.00303, 0.05707, 0.00468, 0.01264, 0.07742,
0.02252, 0.09994),
Transition = c(0.00303, 0.05585, 0.00459, 0.01264,
0.07611, 0.02252, 0.09863),
stringsAsFactors = FALSE)
T2 <- data.frame(Period = c("Summer", "Winter", "Transition", "Yearly Bill"),
Rate = c(0.09566, 0.09994, 0.09863, NA),
Monthly = c(118.16, 122.44, 121.13, 1446.92),
stringsAsFactors = FALSE)
library(shiny)
library(pixiedust)
library(dplyr)
options(pixiedust_print_method = "html")
shinyApp(
ui =
fluidPage(
uiOutput("table1"),
uiOutput("table2")
),
server =
shinyServer(function(input, output, session){
output$table1 <-
renderUI({
dust(T1) %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = c(5, 7),
cols = 2:4,
border = "top") %>%
sprinkle(rows = c(5, 7),
bold = TRUE) %>%
sprinkle(pad = 4) %>%
sprinkle_colnames(Charge = "") %>%
print(asis = FALSE) %>%
HTML()
})
output$table2 <-
renderUI({
T2 %>%
mutate(Monthly = paste0("$", trimws(format(Monthly, big.mark = ",")))) %>%
dust() %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = 4,
cols = 1,
bold = TRUE) %>%
sprinkle(rows = 4,
cols = 3,
border = "all") %>%
sprinkle(na_string = "",
pad = 4) %>%
sprinkle_colnames(Period = "",
Monthly = "Monthly Bill") %>%
print(asis = FALSE) %>%
HTML()
})
})
)
This would be easier if you provided an example of your data, but sticking with DT, you should be able to utilize formatStyle to change formatting of both rows and columns. For an example to bold the first row, see the following (assuming your data frame is called df):
df %>%
datatable() %>%
formatStyle(
0,
target = "row",
fontWeight = styleEqual(1, "bold")
)
The rstudio DT page offers more examples: http://rstudio.github.io/DT/010-style.html
Alternatively, I think you might be better off using the stargazer package.
The base plot would look very similar to your desired result.
stargazer::stargazer(df, type = "html", title = "Table 1")
That will get you started, but see here for a LOT more flexibility: https://www.jakeruss.com/cheatsheets/stargazer/

Resources