faaabyan faaabyan - 1 month ago 40
R Question

Equal column widths on R formattable

I am using the formattable package to make some reports directly from R and I need the columns using the normalize_bar "style" have the same width, so that can compare value between columns.

The following example shows two columns that have very similar values (minimum and maximum values are equal) but have a different width, losing the graphic detail of the bar ("Test.number.1.score" and "test2_score").

library(formattable)

df <- data.frame(
id = 1:10,
name = c("Bob", "Ashley", "James", "David", "Jenny",
"Hans", "Leo", "John", "Emily", "Lee"),
age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
Test.number.1.score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.9, 9.3, 9.1, 8.6),
final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
stringsAsFactors = FALSE)

formattable(df, list(
age = color_tile("white", "orange"),
grade = formatter("span", style = x ~ ifelse(x == "A",
style(color = "green", font.weight = "bold"), NA)),
area(col = c(Test.number.1.score, test2_score)) ~ normalize_bar("pink", 0.2),
final_score = formatter("span",
style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
registered = formatter("span",
style = x ~ style(color = ifelse(x, "green", "red")),
x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))


Thanks in advance.

Answer

Directly using the formatter solves this problem. You want the same width for both the columns.

When I looked at the code of color_bar function I found that their is a width attribute for the width of colored portion. Basically I am modifying that property to get the desired result.

first set a width say 150 px

fixedWidth = 150

and change your formattable function call to

formattable(df, list(
    age = color_tile("white", "orange"),
    grade = formatter("span", style = x ~ ifelse(x == "A", 
                                                 style(color = "green", font.weight = "bold"), NA)),
    test2_score = formatter(.tag = "span", style = function(x) style(display = "inline-block", 
                                                                     direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                                                     `background-color` = csscolor("pink"), width = paste(fixedWidth*proportion(x),"px",sep="") )),
    Test.number.1.score = formatter(.tag = "span", style = function(x) style(display = "inline-block", 
                                                                             direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                                                             `background-color` = csscolor("pink"), width = paste(fixedWidth*proportion(x),"px",sep="") )),


    final_score = formatter("span",
                            style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
                            x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
    registered = formatter("span",
                           style = x ~ style(color = ifelse(x, "green", "red")),
                           x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))

Note the width = paste(fixedWidth*proportion(x),"px",sep="") for changing to fixed width and csscolor("pink") to change the color to pink inside formatter.

The desired output looks like below The Final Report

UPDATE

Or more cleanly you can create your own color_bar function namely my_color_bar by changing its width argument as below

my_color_bar <- function (color = "lightgray", width=150,...) 
{
        formatter("span", style = function(x) style(display = "inline-block", 
                                                direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                                `background-color` = csscolor(color), width = paste(fixedWidth*proportion(x),"px",sep=""), 
                                                ...))
}

And use it in your formattable function call as

formattable(df, list(
    age = color_tile("white", "orange"),
    grade = formatter("span", style = x ~ ifelse(x == "A", 
                                                 style(color = "green", font.weight = "bold"), NA)),
    test2_score = my_color_bar(color="pink",width = 100),
    Test.number.1.score = my_color_bar(color="pink",width=100),


    final_score = formatter("span",
                            style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
                            x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
    registered = formatter("span",
                           style = x ~ style(color = ifelse(x, "green", "red")),
                           x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))